diff options
| author | Gaius Mulley <gaius.mulley@southwales.ac.uk> | 2022-05-15 23:44:16 +0100 |
|---|---|---|
| committer | Gaius Mulley <gaius.mulley@southwales.ac.uk> | 2022-05-15 23:44:16 +0100 |
| commit | f5a02fa669b790ab06868bbf6514d566464e69bb (patch) | |
| tree | a0d70c4e470099d7323e136fc6a2c833dfcedc83 | |
| parent | 22ba1fbccebecd08eadee1fd505ba27ebd0326a3 (diff) | |
| parent | c5397682aff4ae9ced15ddc74971b9b6e218b664 (diff) | |
| download | gcc-f5a02fa669b790ab06868bbf6514d566464e69bb.zip gcc-f5a02fa669b790ab06868bbf6514d566464e69bb.tar.gz gcc-f5a02fa669b790ab06868bbf6514d566464e69bb.tar.bz2 | |
Merge branch 'master' into devel/modula-2.
402 files changed, 8935 insertions, 3194 deletions
@@ -1,3 +1,7 @@ +2022-05-13 Surya Kumari Jangala <jskumari@linux.ibm.com> + + * MAINTAINERS: Add myself to write after approval. + 2022-05-11 Kewen Lin <linkw@linux.ibm.com> * MAINTAINERS: Remove myself from DCO section. diff --git a/MAINTAINERS b/MAINTAINERS index a1b84ac..8bca7a6 100644 --- a/MAINTAINERS +++ b/MAINTAINERS @@ -464,6 +464,7 @@ Daniel Jacobowitz <drow@false.org> Andreas Jaeger <aj@suse.de> Harsha Jagasia <harsha.jagasia@amd.com> Fariborz Jahanian <fjahanian@apple.com> +Surya Kumari Jangala <jskumari@linux.ibm.com> Qian Jianhua <qianjh@fujitsu.com> Janis Johnson <janis.marie.johnson@gmail.com> Teresa Johnson <tejohnson@google.com> diff --git a/gcc/ChangeLog b/gcc/ChangeLog index 7a8a24b..31c63f6 100644 --- a/gcc/ChangeLog +++ b/gcc/ChangeLog @@ -1,3 +1,294 @@ +2022-05-13 Roger Sayle <roger@nextmovesoftware.com> + UroÅ¡ Bizjak <ubizjak@gmail.com> + + * config/i386/sse.md (vec_cmpeqv2div2di): Enable for TARGET_SSE2. + For !TARGET_SSE4_1, expand as a V4SI vector comparison, followed + by a pshufd and pand. + (vec_cmpeqv1tiv1ti): New define_expand implementing V1TImode + vector equality as a V2DImode vector comparison (see above), + followed by a pshufd and pand. + +2022-05-13 Roger Sayle <roger@nextmovesoftware.com> + + PR tree-optimization/83907 + * tree-ssa-strlen.cc (handle_builtin_memset): Record a strinfo + for memset with an constant char value. + (handle_store): Improved handling of stores with a first byte + of zero, but not storing_all_zeros_p. + +2022-05-13 Philipp Tomsich <philipp.tomsich@vrull.eu> + Manolis Tsamis <manolis.tsamis@vrull.eu> + + * config/riscv/riscv.h (CLZ_DEFINED_VALUE_AT_ZERO): Implement. + (CTZ_DEFINED_VALUE_AT_ZERO): Same. + * doc/sourcebuild.texi: add documentation for RISC-V specific + test target keywords + +2022-05-13 Andrew MacLeod <amacleod@redhat.com> + + PR tree-optimization/105597 + * range-op.cc (operator_minus::lhs_op1_relation): Use op1 instead + of the lhs and make sure it is not undefined. + +2022-05-13 Sebastian Pop <spop@amazon.com> + + PR target/105162 + * config/aarch64/aarch64-protos.h (atomic_ool_names): Increase dimension + of str array. + * config/aarch64/aarch64.cc (aarch64_atomic_ool_func): Call + memmodel_from_int and handle MEMMODEL_SYNC_*. + (DEF0): Add __aarch64_*_sync functions. + +2022-05-13 Andrew MacLeod <amacleod@redhat.com> + + * gimple-range-fold.cc (fold_using_range::range_of_phi): Use new VREL_* + enumerated values. + * gimple-range-path.cc (maybe_register_phi_relation): Ditto. + * range-op.cc (*::lhs_op1_relation): Return relation_kind, and use + new VREL enumerated values. + (*::lhs_op2_relation): Ditto. + (*::op1_op2_relation): Ditto. + (*::fold_range): Use new VREL enumerated values. + (minus_op1_op2_relation_effect): Ditto. + (range_relational_tests): Ditto. + * range-op.h (fold_range, op1_range, op2_range): Use VREL_VARYING. + (lhs_op1_relation, lhs_op2_relation, op1_op2_relation): Return + relation_kind. + (*_op1_op2_relation): Return relation_kind. + (relop_early_resolve): Use VREL_UNDEFINED. + * value-query.cc (range_query::query_relation): Use VREL_VARYING. + * value-relation.cc (VREL_LAST): Change enumerated value. + (vrel_range_assert): Delete. + (print_relation): Remove range assert. + (rr_negate_table): Adjust table to use new enumerated values.. + (relation_negate): Remove range assert. + (rr_swap_table): Adjust. + (relation_swap): Remove range assert. + (rr_intersect_table): Adjust. + (relation_intersect): Remove range assert. + (rr_union_table): Adjust. + (relation_union): Remove range assert. + (rr_transitive_table): Adjust. + (relation_transitive): Remove range assert. + (equiv_oracle::query_relation): Use new VREL enumerated values. + (equiv_oracle::register_relation): Ditto. + (relation_oracle::register_stmt): Ditto. + (dom_oracle::set_one_relation): Ditto. + (dom_oracle::register_transitives): Ditto. + (dom_oracle::query_relation): Ditto. + (path_oracle::register_relation): Ditto. + (path_oracle::query_relation): Ditto. + * value-relation.h (enum relation_kind_t): New relation_kind. + (*_op1_op2_relation): Adjust prototypes. + +2022-05-13 Andrew MacLeod <amacleod@redhat.com> + + * gimple-range-edge.cc (calc_switch_ranges): Check union return value. + * value-range.cc (irange::legacy_verbose_union_): Add return value. + (irange::irange_single_pair_union): New. + (irange::irange_union): Add return value. + * value-range.h (class irange): Adjust prototypes. + +2022-05-13 Andrew MacLeod <amacleod@redhat.com> + + * value-range.cc (irange::legacy_verbose_intersect): Add return value. + (irange::irange_contains_p): New. + (irange::irange_intersect): Add return value. + * value-range.h (class irange): Adjust prototypes. + +2022-05-13 Andrew MacLeod <amacleod@redhat.com> + + * gimple-range-cache.cc (ranger_cache::get_global_range): Return the + had_global value instead. + +2022-05-13 Andrew MacLeod <amacleod@redhat.com> + + PR tree-optimization/104547 + * gimple-range-fold.cc (fold_using_range::range_of_range_op): Add + the op1/op2 relation to the relation call. + * range-op.cc (*::lhs_op1_relation): Add param. + (*::lhs_op2_relation): Ditto. + (operator_minus::lhs_op1_relation): New. + (range_relational_tests): Add relation param. + * range-op.h (lhs_op1_relation, lhs_op2_relation): Adjust prototype. + +2022-05-13 Andrew MacLeod <amacleod@redhat.com> + + * gimple-range.cc (gimple_ranger::register_side_effects): First check + if the DEF should be exported as a global. + * tree-vrp.cc (rvrp_folder::pre_fold_bb): Process PHI side effects, + which will export globals. + (execute_ranger_vrp): Remove call to export_global_ranges. + +2022-05-13 Andrew MacLeod <amacleod@redhat.com> + + * value-relation.cc (path_oracle::reset_path): Clear killing_defs. + +2022-05-13 Andrew MacLeod <amacleod@redhat.com> + + * gimple-range-cache.cc (ranger_cache::ranger_cache): Start with + worlist truncated. + (ranger_cache::entry_range): Add rfd_mode parameter. + (ranger_cache::exit_range): Ditto. + (ranger_cache::edge_range): New. Incorporate from range_on_edge. + (ranger_cache::range_of_expr): Adjust call to entry_range. + (ranger_cache::range_on_edge): Split to edge_range and call. + (ranger_cache::fill_block_cache): Always invoke range_from_dom. + (ranger_cache::range_from_dom): Make reentrant, add search mode, handle + mutiple predecessors. + (ranger_cache::update_to_nonnull): Adjust call to exit_range. + * gimple-range-cache.h (ranger_cache): Add enum rfd_mode. Adjust + prototypes. + +2022-05-13 Alexandre Oliva <oliva@adacore.com> + + * gimple-harden-conditionals.cc: Include sbitmap.h. + (pass_harden_conditional_branches::execute): Skip new blocks. + (pass_harden_compares::execute): Likewise. + +2022-05-13 Richard Earnshaw <rearnsha@arm.com> + + PR target/105463 + * config/arm/mve.md (*movmisalign<mode>_mve_store): Use + mve_memory_operand. + (*movmisalign<mode>_mve_load): Likewise. + * config/arm/vec-common.md (movmisalign<mode>): Convert to generator + form... + (@movmisalign<mode>): ... thus. Use generic predicates and then + rework operands if they are not valid. For MVE rework to a + narrower element size if the alignment is not high enough. + +2022-05-13 Richard Earnshaw <rearnsha@arm.com> + + * config/arm/arm.cc (mve_vector_mem_operand): Allow SP_REGNUM + when there is no write-back. Fix use when strict is true. + +2022-05-13 Takayuki 'January June' Suwa <jjsuwa_sys3175@yahoo.co.jp> + + * config/xtensa/xtensa.h (TARGET_HAS_NO_HW_DIVIDE): New macro + definition. + +2022-05-13 Takayuki 'January June' Suwa <jjsuwa_sys3175@yahoo.co.jp> + + * config/xtensa/xtensa.md (extvsi, extvsi_internal, extzvsi, + extzvsi_internal): Rename from extv, extv_internal, extzv and + extzv_internal, respectively. + +2022-05-13 Eric Botcazou <ebotcazou@adacore.com> + + * tree-sra.cc (sra_modify_assign): Check that scalar storage order + is the same on the LHS and RHS before rewriting one with the model + of the other. + +2022-05-13 Richard Biener <rguenther@suse.de> + + * gimple-fold.cc (gimple_build): Adjust for new + main API. + * gimple-fold.h (gimple_build): New main APIs with + iterator, insert direction and iterator update. + (gimple_build): New forwarder template. + (clear_padding_type_may_have_padding_p): Remove. + (clear_type_padding_in_mask): Likewise. + (arith_overflowed_p): Likewise. + * fold-const.h (clear_padding_type_may_have_padding_p): Declare. + (clear_type_padding_in_mask): Likewise. + (arith_overflowed_p): Likewise. + * tree-vect-generic.cc (gimplify_build3): Use main gimple_build API. + (gimplify_build2): Likewise. + (gimplify_build1): Likewise. + * ubsan.cc (ubsan_expand_ptr_ifn): Likewise, avoid extra + compare stmt. + * gengtype.cc (open_base_files): Re-order includes. + * builtins.cc: Re-order gimple-fold.h include. + * calls.cc: Likewise. + * cgraphbuild.cc: Likewise. + * cgraphunit.cc: Likewise. + * config/rs6000/rs6000-builtin.cc: Likewise. + * config/rs6000/rs6000-call.cc: Likewise. + * config/rs6000/rs6000.cc: Likewise. + * config/s390/s390.cc: Likewise. + * expr.cc: Likewise. + * fold-const.cc: Likewise. + * function-tests.cc: Likewise. + * gimple-match-head.cc: Likewise. + * gimple-range-fold.cc: Likewise. + * gimple-ssa-evrp-analyze.cc: Likewise. + * gimple-ssa-evrp.cc: Likewise. + * gimple-ssa-sprintf.cc: Likewise. + * gimple-ssa-warn-access.cc: Likewise. + * gimplify.cc: Likewise. + * graphite-isl-ast-to-gimple.cc: Likewise. + * ipa-cp.cc: Likewise. + * ipa-devirt.cc: Likewise. + * ipa-prop.cc: Likewise. + * omp-low.cc: Likewise. + * pointer-query.cc: Likewise. + * range-op.cc: Likewise. + * tree-cfg.cc: Likewise. + * tree-if-conv.cc: Likewise. + * tree-inline.cc: Likewise. + * tree-object-size.cc: Likewise. + * tree-ssa-ccp.cc: Likewise. + * tree-ssa-dom.cc: Likewise. + * tree-ssa-forwprop.cc: Likewise. + * tree-ssa-ifcombine.cc: Likewise. + * tree-ssa-loop-ivcanon.cc: Likewise. + * tree-ssa-math-opts.cc: Likewise. + * tree-ssa-pre.cc: Likewise. + * tree-ssa-propagate.cc: Likewise. + * tree-ssa-reassoc.cc: Likewise. + * tree-ssa-sccvn.cc: Likewise. + * tree-ssa-strlen.cc: Likewise. + * tree-ssa.cc: Likewise. + * value-pointer-equiv.cc: Likewise. + * vr-values.cc: Likewise. + +2022-05-13 Alexandre Oliva <oliva@adacore.com> + + PR rtl-optimization/105455 + * gimple-harden-conditionals.cc (insert_check_and_trap): Set + probabilities for newly-conditional edges. + +2022-05-13 liuhongt <hongtao.liu@intel.com> + + PR tree-optimization/102583 + * tree-ssa-forwprop.cc (simplify_bitfield_ref): Extended to a + contiguous stride in the VEC_PERM_EXPR. + +2022-05-12 Richard Biener <rguenther@suse.de> + + PR rtl-optimization/105577 + * dse.cc (rest_of_handle_dse): Make sure to purge dead EH + edges before running fast DCE via df_analyze. + +2022-05-12 Richard Biener <rguenther@suse.de> + + PR tree-optimization/105562 + * tree-ssa-sccvn.cc (vn_reference_lookup_3): Disambiguate + against all CLOBBER defs if there's not an obvious must-alias + and we are not doing redundant store elimination. + (vn_walk_cb_data::redundant_store_removal_p): New field. + (vn_reference_lookup_pieces): Initialize it. + (vn_reference_lookup): Add argument to specify if we are + doing redundant store removal. + (eliminate_dom_walker::eliminate_stmt): Specify we do. + * tree-ssa-sccvn.h (vn_reference_lookup): Adjust. + +2022-05-12 Haochen Jiang <haochen.jiang@intel.com> + + PR target/104371 + * config/i386/sse.md (vi1avx2const): New define_mode_attr. + (pxor/pcmpeqb/pmovmskb/cmp 0xffff to ptest splitter): + New define_split pattern. + +2022-05-12 Jakub Jelinek <jakub@redhat.com> + + * gimplify.cc (gimplify_omp_depend): Don't build_fold_addr_expr + if null_pointer_node. + (gimplify_scan_omp_clauses): Likewise. + * tree-pretty-print.cc (dump_omp_clause): Print null_pointer_node + as omp_all_memory. + 2022-05-11 Patrick Palka <ppalka@redhat.com> * tree.h (TREE_VEC_BEGIN): Define. diff --git a/gcc/DATESTAMP b/gcc/DATESTAMP index 2a18b64..df5469f 100644 --- a/gcc/DATESTAMP +++ b/gcc/DATESTAMP @@ -1 +1 @@ -20220512 +20220515 diff --git a/gcc/ada/ChangeLog b/gcc/ada/ChangeLog index 99fd922..d09eeb9 100644 --- a/gcc/ada/ChangeLog +++ b/gcc/ada/ChangeLog @@ -1,3 +1,605 @@ +2022-05-13 Alexandre Oliva <oliva@adacore.com> + + * gcc-interface/decl.cc (is_cplusplus_method): Build proper + String for Get_External_Name. + +2022-05-13 Eric Botcazou <ebotcazou@adacore.com> + + * sem_ch3.adb (Derive_Subprogram): For a function, also copy the + Returns_By_Ref flag from the parent. + +2022-05-13 Gary Dismukes <dismukes@adacore.com> + + * sem_ch13.adb (Check_Aspect_At_Freeze_Point): Analyze the + expression of the aspect at this point, like other aspects that + denote simple entities. Ensures that function + Storage_Model_Object will have an entity to retrieve from the + aspect expression. Also, move comment about aspects that don't + require delay analysis in front of last alternative of the case + statement, where it's supposed to be. + +2022-05-13 Javier Miranda <miranda@adacore.com> + + * contracts.adb (Build_Unique_Name): New subprogram. + (Make_Class_Precondition_Subps): Use Build_Unique_Name to + generate the names of the call helpers and the name of indirect + call wrappers. + * freeze.adb (Needs_Wrapper): Remove dead code. + (Check_Inherited_Conditions): Defer building helpers and ICW + until all the dispatch table wrappers have been built and + analyzed. Required to ensure uniqueness in their names because + when building these wrappers for overlapped subprograms their + homonym number is not definite until they have been analyzed. + +2022-05-13 Arnaud Charlet <charlet@adacore.com> + + * libgnarl/s-taprop__linux.adb (Initialize): Do not use an + alternate stack if no handler for SEGV is installed. + +2022-05-13 Alexandre Oliva <oliva@adacore.com> + + * doc/gnat_rm/security_hardening_features.rst (Control Flow + Redundancy): Drop mentions of noreturn and tail calls. + * gnat_rm.texi: Regenerate. + +2022-05-13 Ghjuvan Lacambre <lacambre@adacore.com> + + * ali.adb: Introduce new 'K' line in ALI files, used to + represent CUDA kernel entries. + * ali.ads: Create new CUDA_Kernels table, which contains entries + of type CUDA_Kernel_Record. Each CUDA_Kernel_Record corresponds + to a K line in an ali file. + * bindgen.adb: Introduce new Gen_CUDA_Init procedure in the + binder, which generates CUDA kernel registration code. + * gnat_cuda.adb: Move Get_CUDA_Kernels spec to package spec to + make it available to bindgen.adb. + * gnat_cuda.ads: Likewise. + * lib-writ.adb: Introduce new Output_CUDA_Symbols procedure, + which generates one 'K' line in the ALI file per visible CUDA + kernel. + * opt.ads: Introduce Enable_CUDA_Expansion option, triggered by + using the -gnatd_c flag. + * switch-b.adb: Likewise. + * switch-c.adb: Likewise. + +2022-05-13 Marc Poulhiès <poulhies@adacore.com> + + * exp_aggr.adb (Gen_Loop): Create scope for loop variable of + iterated components. + +2022-05-13 Yannick Moy <moy@adacore.com> + + * libgnat/a-chtgfk.adb (Checked_Equivalent_Keys, Checked_Index): + Remove useless functions. + (Delete_Key_Sans_Free, Find, Generic_Conditional_Insert): Adapt + to removal of wrapper functions. + * libgnat/a-chtgfk.ads (Checked_Equivalent_Keys, Checked_Index): + Remove useless functions. + * libgnat/a-chtgfo.adb (Checked_Index): Remove useless function. + (Clear): Delete code commented out regarding Busy and Lock + management. + (Delete_Node_At_Index): Delete unused procedure. + (Delete_Node_Sans_Free, Free, Generic_Read, Next): Adapt to + removal of wrapper functions. + * libgnat/a-chtgfo.ads (Checked_Index): Remove useless function. + (Delete_Node_At_Index): Delete unused procedure. + +2022-05-13 Yannick Moy <moy@adacore.com> + + * libgnat/a-cfhama.adb (Generic_Allocate): Retype to avoid + aliasing. + (Assign, Move): Remove address comparison. + (Include): Insert constants for subtype constraints. + (Insert): Rewrite to avoid aliasing and function with side-effects. + * libgnat/a-cfhase.adb (Generic_Allocate): Retype to avoid + aliasing. + (Assign, Move): Remove address comparison. + (Difference, Intersection, Is_Subset, Overlap, + Symmetric_Difference, Union): Remove address comparison. Insert + constants for subtype constraints. + (Insert): Rewrite to avoid aliasing and function with + side-effects. + * libgnat/a-chtgfk.adb (Checked_Equivalent_Keys, Checked_Index, + Delete_Key_Sans_Free, Find, Generic_Replace_Element, Index): + Type for hash tables not tagged anymore. + (Generic_Conditional_Insert): New_Node generic formal is a + procedure taking the hash table as first parameter now, to avoid + aliasing in the caller. + * libgnat/a-chtgfk.ads: Same. + * libgnat/a-chtgfo.adb (Checked_Index, Clear, + Delete_Node_At_Index, Delete_Node_Sans_Free, First, Free, + Generic_Allocate, Generic_Iteration, Generic_Read, + Generic_Write, Index, Next): Type for hash tables not tagged + anymore. + (Generic_Equal): Removed tagged. Remove address comparison. + * libgnat/a-chtgfo.ads: Same. + * libgnat/a-cohata.ads (Hash_Table_Type): Remove tagged. + +2022-05-13 Yannick Moy <moy@adacore.com> + + * Makefile.rtl: Add new files. + * libgnat/a-cfhama.adb: Use formal version of hash tables. + * libgnat/a-cfhama.ads: Same. + * libgnat/a-cfhase.adb: Same. + * libgnat/a-cfhase.ads: Same. + * libgnat/a-chtgfk.adb: New unit for formal containers, modified + version of Generic_Bounded_Keys. + * libgnat/a-chtgfk.ads: Same. + * libgnat/a-chtgfo.adb: New unit for formal containers, modified + version of Generic_Bounded_Operations. + * libgnat/a-chtgfo.ads: Same. + * libgnat/a-cohata.ads (Generic_Formal_Hash_Table_Types): Third + version of the type for hash tables, equivalent to the bounded + version without tampering checks. + +2022-05-13 Javier Miranda <miranda@adacore.com> + + * freeze.adb (Check_Inherited_Conditions): Dispatch table + wrappers must be placed in the list of entities of their scope + at the same place of their wrapped primitive. This is required + for private types since these wrappers are built when their full + tagged type declaration is frozen but they may override a + primitive defined in the public part of the package (and it is + important to maintain the wrapper in the list of public entities + of the package to ensure their correct visibility). + +2022-05-13 Johannes Kanig <kanig@adacore.com> + + * osint.ads, osint.adb (Relocate_Path): If the GNSA_ROOT + environment variable is set, we use that as the prefix, instead + of computing the prefix from the executable location. + +2022-05-13 Steve Baird <baird@adacore.com> + + * exp_ch3.ads (Build_Intialization_Call): Add new formal + parameter, Init_Control_Actual, with default value. Clients + outside of package Exp_Ch3 are unaffected. + * exp_ch3.adb (Initialization_Control): new package; support for + this 4-valued parameter. The existing Requires_Late_Init + function is moved into this new package. + (Build_Initialization_Call): Add new formal parameter for + subprogram body, use this new formal parameter in generating an + init proc call. + (Build_Record_Init_Proc): Replace Set_Tag Boolean formal + parameter with 4-valued Init_Control_Formal. Wrap if-statements + with appropriate conditions around tag initialization, early + initialization, and late initialization statements. + * exp_util.adb (Build_Task_Image_Decl): Avoid problem with + duplicate declarations when an init proc for a type extension + calls the parent type's init proc twice. + +2022-05-13 Ed Schonberg <schonberg@adacore.com> + + * sem_ch5.adb (Analyze_Iterator_Specification): Fix Typ in the + case of a class-wide derived iterator. + +2022-05-13 Yannick Moy <moy@adacore.com> + + * libgnat/a-strbou.ads (Overwrite): Switch to >= operator in + contracts. + * libgnat/a-strsup.adb (Super_Overwrite): Switch to >= operator + in code of procedure (function already uses it). + * libgnat/a-strsup.ads (Super_Overwrite): Switch to >= operator + in contracts. + +2022-05-13 Etienne Servais <servais@adacore.com> + + * doc/gnat_rm/representation_clauses_and_pragmas.rst: Fix code + snippet. + * gnat_rm.texi: Regenerate. + +2022-05-13 Eric Botcazou <ebotcazou@adacore.com> + + * aspects.adb (Find_Value_Of_Aspect): Add guard. + * sem_ch4.adb (Complete_Object_Operation): Remove obsolete code. + * sem_ch5.adb (Has_Sec_Stack_Default_Iterator): Add guard. + +2022-05-13 Javier Miranda <miranda@adacore.com> + + * exp_attr.adb (Expand_N_Attribute_Reference): The expansion of + 'Address in a call to an instantiation of the implicit + subprogram To_Pointer with a class-wide interface type target + requires adding an implicit type conversion to force + displacement of the "this" pointer. + +2022-05-13 Javier Miranda <miranda@adacore.com> + + * sem_attr.adb (Resolve_Attribute): Ensure that attribute + expressions are resolved at this stage; required for preanalyzed + references to discriminants since their resolution (and + expansion) will take care of updating their Entity attribute to + reference their discriminal. + +2022-05-13 Justin Squirek <squirek@adacore.com> + + * sem_util.adb (Wrong_Type): Avoid using the first subtype of + the expected type in error messages when the expected type is + not internally generated. + +2022-05-13 Alexandre Oliva <oliva@adacore.com> + + * doc/gnat_rm/security_hardening_features.rst: Add subsection on + Control Flow Redundancy. + * gnat_rm.texi: Regenerate. + +2022-05-13 Eric Botcazou <ebotcazou@adacore.com> + + * exp_util.adb (Insert_Actions) <N_Iteration_Scheme>: Check that + it is a WHILE iteration scheme before using Condition_Actions. + +2022-05-13 Piotr Trojanek <trojanek@adacore.com> + + * atree.adb, gen_il-gen.adb, osint.adb, set_targ.adb, + sinput.adb, table.adb, treepr.adb, types.ads: Replace uses of + Unchecked_Conversion in the compiler itself. + * libgnarl/a-reatim.adb, libgnarl/s-osinte__gnu.ads, + libgnarl/s-osinte__kfreebsd-gnu.ads, libgnat/a-coboho.adb, + libgnat/a-stuten.ads, libgnat/s-putima.adb: Likewise in the + runtime. + * doc/gnat_ugn/gnat_and_program_execution.rst: Likewise in + documentation. + * gnat_ugn.texi: Regenerate. + +2022-05-13 Piotr Trojanek <trojanek@adacore.com> + + * butil.adb, sem.adb, sinput.adb, types.ads, xref_lib.adb: + Replace uses of Unchecked_Deallocation with + Ada.Unchecked_Deallocation. + * doc/gnat_ugn/gnat_and_program_execution.rst: Likewise for the + documentation; fix casing of GNAT.IO. + * gnat_ugn.texi: Regenerate. + +2022-05-13 Marc Poulhiès <poulhies@adacore.com> + + * sem_aggr.adb (Resolve_Array_Aggregate): Fix ARM reference. + Remove useless loop. + +2022-05-13 Etienne Servais <servais@adacore.com> + + * sem_ch3.adb (Analyze_Subtype_Declaration): Fix typo in + comment. + +2022-05-13 Justin Squirek <squirek@adacore.com> + + * sem_ch6.adb (Check_Return_Construct_Accessibility): Modify + generation of run-time accessibility checks to account for cases + where Extra_Accessibility_Of_Result should be used versus the + level of the enclosing subprogram. Use original node to avoid + checking against expanded code. Disable check generation for + tagged type case. + (Is_Formal_Of_Current_Function): Added to encompass a predicate + used within Check_Return_Construct_Accessibility to test if an + associated expression is related to a relevant formal. + * sem_util.adb, sem_util.ads (Enclosing_Subprogram): Modified to + accept Node_Or_Entity_Id. + (Innermost_Master_Scope_Depth): Calculate level based on the + subprogram of a return statement instead of the one returned by + Current_Subprogram. + (Needs_Result_Accessibility_Level): Remove + Disable_Coextension_Cases constant, and disable the tagged type + case for performance reasons. + +2022-05-13 Piotr Trojanek <trojanek@adacore.com> + + * sem_res.adb (Flag_Effectively_Volatile_Objects): Ignore + component and discriminant identifiers. + +2022-05-13 Piotr Trojanek <trojanek@adacore.com> + + * sem_res.adb (Flag_Effectively_Volatile_Objects): Remove + redundant guard. + +2022-05-13 Justin Squirek <squirek@adacore.com> + + * sem_ch8.adb (Determine_Package_Scope): Created to centralize + the calculation of which package a given use clause belongs to. + (Most_Descendant_Use_Clause): Modified to call + Determine_Package_Scope. + * sem_util.adb, sem_util.ads (Enclosing_Package): Modified to + handle both entity and node ids. + +2022-05-12 Piotr Trojanek <trojanek@adacore.com> + + * gnat1drv.adb (Gnat1drv): Skip postponed checks when there are + errors. + +2022-05-12 Arnaud Charlet <charlet@adacore.com> + + * doc/gnat_ugn/the_gnat_compilation_model.rst: Fix URL. + * gnat_ugn.texi: Regenerate. + +2022-05-12 Bob Duff <duff@adacore.com> + + * namet.ads, namet.adb (Write_Name_For_Debug): Add Quote + parameter to allow conditional addition of quotes. Note that + some calls to Write_Name_For_Debug, for example for file names, + shouldn't have quotes, as in some_package.adb:123:45. + * treepr.adb (Print_Name): Add double quotes around the name + using the above Quote parameters. + +2022-05-12 Piotr Trojanek <trojanek@adacore.com> + + * sem_res.adb (Resolve_Actuals): Simplify with N_Op_Compare. + * sem_util.adb (Replace_Null_Operand, + Null_To_Null_Address_Convert_OK): Likewise. + +2022-05-12 Piotr Trojanek <trojanek@adacore.com> + + * sem_util.ads (Is_Selector_Name): Remove spec. + * sem_util.adb (Is_Selector_Name): Remove body. + +2022-05-12 Arnaud Charlet <charlet@adacore.com> + + * sem_warn.adb (Has_Junk_Name): Add more dummy names. + +2022-05-12 Piotr Trojanek <trojanek@adacore.com> + + * lib-xref.adb (Generate_Reference): Fix comment and implement + it precisely. + +2022-05-12 Piotr Trojanek <trojanek@adacore.com> + + * atree.adb, atree.ads: Move WITH clause from spec to body; to + prevent new warnings stopping the bootstrap. + * fmap.adb, fname-sf.adb, libgnat/a-direct.adb, + libgnat/s-bignum.adb: Remove unnecessary WITH clauses; to + prevent new warnings stopping the bootstrap. + * sem_ch12.adb (Analyze_Subprogram_Instantiation): Only set + Is_Instantiated flag when the instance is in the extended main + source unit. + +2022-05-12 Yannick Moy <moy@adacore.com> + + * libgnat/s-valuei.ads: Remove pragma Warnings Off. + * libgnat/s-valueu.ads: Same. + * libgnat/s-valuti.ads: Same. + +2022-05-12 Yannick Moy <moy@adacore.com> + + * sem_util.adb (Check_Result_And_Post_State): Exempt trivial + post. + +2022-05-12 Arnaud Charlet <charlet@adacore.com> + + * ali.adb, ali.ads, bcheck.adb, exp_ch11.adb, fe.h, + gnat1drv.adb, opt.adb, opt.ads, targparm.adb, targparm.ads, + lib-writ.adb: Get rid of Frontend_Exceptions processing. + * libgnat/system-aix.ads, libgnat/system-darwin-arm.ads, + libgnat/system-darwin-ppc.ads, libgnat/system-darwin-x86.ads, + libgnat/system-djgpp.ads, libgnat/system-dragonfly-x86_64.ads, + libgnat/system-freebsd.ads, libgnat/system-hpux-ia64.ads, + libgnat/system-hpux.ads, libgnat/system-linux-alpha.ads, + libgnat/system-linux-arm.ads, libgnat/system-linux-hppa.ads, + libgnat/system-linux-ia64.ads, libgnat/system-linux-m68k.ads, + libgnat/system-linux-mips.ads, libgnat/system-linux-ppc.ads, + libgnat/system-linux-riscv.ads, libgnat/system-linux-s390.ads, + libgnat/system-linux-sh4.ads, libgnat/system-linux-sparc.ads, + libgnat/system-linux-x86.ads, libgnat/system-lynxos178-ppc.ads, + libgnat/system-lynxos178-x86.ads, libgnat/system-mingw.ads, + libgnat/system-qnx-aarch64.ads, libgnat/system-rtems.ads, + libgnat/system-solaris-sparc.ads, + libgnat/system-solaris-x86.ads, + libgnat/system-vxworks-arm-rtp-smp.ads, + libgnat/system-vxworks-arm-rtp.ads, + libgnat/system-vxworks-arm.ads, + libgnat/system-vxworks-e500-kernel.ads, + libgnat/system-vxworks-e500-rtp-smp.ads, + libgnat/system-vxworks-e500-rtp.ads, + libgnat/system-vxworks-ppc-kernel.ads, + libgnat/system-vxworks-ppc-rtp-smp.ads, + libgnat/system-vxworks-ppc-rtp.ads, + libgnat/system-vxworks-x86-kernel.ads, + libgnat/system-vxworks-x86-rtp-smp.ads, + libgnat/system-vxworks-x86-rtp.ads, + libgnat/system-vxworks7-aarch64-rtp-smp.ads, + libgnat/system-vxworks7-aarch64.ads, + libgnat/system-vxworks7-arm-rtp-smp.ads, + libgnat/system-vxworks7-arm.ads, + libgnat/system-vxworks7-e500-kernel.ads, + libgnat/system-vxworks7-e500-rtp-smp.ads, + libgnat/system-vxworks7-e500-rtp.ads, + libgnat/system-vxworks7-ppc-kernel.ads, + libgnat/system-vxworks7-ppc-rtp-smp.ads, + libgnat/system-vxworks7-ppc-rtp.ads, + libgnat/system-vxworks7-ppc64-kernel.ads, + libgnat/system-vxworks7-ppc64-rtp-smp.ads, + libgnat/system-vxworks7-x86-kernel.ads, + libgnat/system-vxworks7-x86-rtp-smp.ads, + libgnat/system-vxworks7-x86-rtp.ads, + libgnat/system-vxworks7-x86_64-kernel.ads, + libgnat/system-vxworks7-x86_64-rtp-smp.ads: Remove + Frontend_Exceptions line. + * gcc-interface/decl.cc, gcc-interface/trans.cc + (gnat_to_gnu_entity, gnat_to_gnu_subprog_type, gigi, + gnat_to_gnu): Remove Front_End_SJLJ processing and always assume + Back_End_Exceptions. + +2022-05-12 Bob Duff <duff@adacore.com> + + * namet.ads, namet.adb (Write_Name_For_Debug): New more-robust + version of Write_Name. + (Destroy_Global_Name_Buffer): New procedure to help detect bugs + related to use of Global_Name_Buffer. Misc cleanup and comment + improvements. E.g. we don't need to document every detail of + debugging printouts, especially since they can change. + * uname.ads, uname.adb (Write_Unit_Name_For_Debug): New + more-robust version of Write_Unit_Name. + (Get_Unit_Name_String): Pass buffer in, instead of using the + global variable. Misc cleanup. Remove the "special fudge", which + is apparently not needed, and anyway the comment "the %s or %b + has already been eliminated" seems wrong. + (Write_Unit_Name): Call the new version of Get_Unit_Name_String. + * errout.adb (Set_Msg_Insertion_Unit_Name): Call the new version + of Get_Unit_Name_String. We pass the global variable here, + because it's too much trouble to disentangle such uses in + Errout. + * sem_util.ads, sem_util.adb, sem_dist.adb + (Get_Library_Unit_Name): New version of + Get_Library_Unit_Name_String that avoids usage of the global + variable. + * casing.ads, casing.adb, exp_prag.adb, exp_util.adb + (Set_All_Upper_Case): Remove. There is no need for a wrapper + here -- code is clearer without it. + * treepr.adb (Print_Name): Call Write_Name_For_Debug, which + deals with No_Name (etc), rather than duplicating that here. + Note that the call to Get_Name_String was superfluous. + (Tree_Dump): Call Write_Unit_Name_For_Debug instead of + Write_Unit_Name, which crashes if not Is_Valid_Name. + * erroutc.ads: Improve comments. + * erroutc.adb (Set_Msg_Name_Buffer): Call + Destroy_Global_Name_Buffer to detect potential bugs where it + incorrectly looks at the global variable. + * sinput.adb (Write_Location): Call Write_Name_For_Debug instead + of Write_Name, so it won't blow up on invalid data. + * sinput.ads: Improve comments; remove some verbosity. + * libgnat/s-imagef.adb: Fix typo in comment. + +2022-05-12 Yannick Moy <moy@adacore.com> + + * libgnat/s-imageu.adb (Set_Image_Unsigned): Add lemma. + * libgnat/s-valueu.adb (Scan_Raw_Unsigned): Add assertion. + +2022-05-12 Yannick Moy <moy@adacore.com> + + * libgnat/s-aridou.ads: Remove use-clause, add renames and + subtypes. + * libgnat/s-exponn.ads: Same. + * libgnat/s-expont.ads: Same. + * libgnat/s-widthu.ads: Same. + +2022-05-12 Etienne Servais <servais@adacore.com> + + * csets.adb (Fold_Latin_9): Fix y with diaeresis. + (Fold_IBM_PC_850): Fix o with stroke. + +2022-05-12 Piotr Trojanek <trojanek@adacore.com> + + * sem_type.adb (Valid_Boolean_Arg): Remove redundant guard. + +2022-05-12 Piotr Trojanek <trojanek@adacore.com> + + * sem_type.adb (Valid_Boolean_Arg): Operands of Raise_Type are + valid boolean arguments. + +2022-05-12 Eric Botcazou <ebotcazou@adacore.com> + + * sem_ch4.adb (Possible_Type_For_Conditional_Expression): Add + test for subtype conformance in the cases of + access-to-subprogram types. + +2022-05-12 Yannick Moy <moy@adacore.com> + + * libgnat/s-imagef.adb: Justify false message from CodePeer. + +2022-05-12 Eric Botcazou <ebotcazou@adacore.com> + + * sem_ch4.adb (Analyze_Case_Expression): Rewrite. + (Analyze_If_Expression): Likewise. + (Possible_Type_For_Conditional_Expression): New function. + * sem_type.adb (Specific_Type): Retur the base type in more + cases. + +2022-05-12 Yannick Moy <moy@adacore.com> + + * libgnat/s-imagef.adb: Adapt to new signature of Image_I, by + providing ghost imported subprograms. For now, no contract is + used on these subprograms, as System.Image_F is not proved. + * libgnat/s-imagef.ads: Add modular type Uns as formal + parameter, to use in defining Int_Params for instantiating + Image_I. + * libgnat/s-imagei.adb: Add contracts and ghost code. + * libgnat/s-imagei.ads: Replace Int formal parameter by package + Int_Params, which bundles type Int and Uns with ghost + subprograms. Add contracts. + * libgnat/s-imfi128.ads: Adapt to new formal of Image_F. + * libgnat/s-imfi32.ads: Adapt to new formal of Image_F. + * libgnat/s-imfi64.ads: Adapt to new formal of Image_F. + * libgnat/s-imgint.ads: Adapt to new formals of Image_I. + * libgnat/s-imglli.ads: Adapt to new formals of Image_I. + * libgnat/s-imgllli.ads: Adapt to new formals of Image_I. + * libgnat/s-valint.ads: Adapt to new formals of Value_I. + * libgnat/s-vallli.ads: Adapt to new formals of Value_I. + * libgnat/s-valllli.ads: Adapt to new formals of Value_I. + * libgnat/s-valuei.adb (Prove_Scan_Only_Decimal_Ghost): New + ghost lemma. + * libgnat/s-valuei.ads: New formal parameters to prove the new + lemma. + * libgnat/s-valuti.ads (Int_Params): Define a generic package to + be used as a trait-like formal parameter in Image_I and other + generics that need to instantiate Image_I. + * libgnat/s-widthu.ads (Big_10): Qualify the 10 literal. + +2022-05-12 Eric Botcazou <ebotcazou@adacore.com> + + * sem_ch4.adb (Find_Arithmetic_Types): Use local variables. + (Find_Boolean_Types): Rewrite modeled on Find_Arithmetic_Types. + +2022-05-12 Alexandre Oliva <oliva@adacore.com> + + * doc/gnat_rm/security_hardening_features.rst (Hardened + Booleans): New. + * exp_util.adb (Adjust_Condition): Perform validity checking on + hardbool-annotated types even with -gnatVT. + * gnat_rm.texi: Regenerate. + * gcc-interface/utils.cc (gnat_internal_attribute_table): Ignore + hardbool. + +2022-05-12 Piotr Trojanek <trojanek@adacore.com> + + * exp_ch9.adb (Build_Protected_Entry): Set scope of the nested + block to spec and not the body of the procedure created for a + protected entry. + +2022-05-12 Etienne Servais <servais@adacore.com> + + * sem_ch3.adb (Find_Type_Of_Object): Remove duplicate "i" in + comment. + +2022-05-12 Marc Poulhiès <poulhies@adacore.com> + + * csets.adb (Initialize): Only treat square bracket as valid + identifier character for Ada versions prior to Ada 2022. + * style.ads (Check_Left_Paren): Rename... + (Check_Left_Paren_Square_Bracket): ...to this. + * styleg.adb (Check_Left_Bracket): Rename... + (Check_Left_Paren_Square_Bracket): ...to this. + * styleg.ads (Check_Left_Paren): Rename... + (Check_Left_Paren_Square_Bracket): ...to this. + * scng.adb (Scan): Add check for spacing around left square + bracket and use new name for Check_Left_Paren_Square_Bracket. + * libgnat/a-szmzco.ads (Control_Ranges, Graphic_Ranges) + (Letter_Ranges, Decimal_Digit_Ranges, ISO_646_Ranges) + (Character_Ranges): Fix style (remove extra space). + * libgnat/a-swmwco.ads (Control_Ranges, Graphic_Ranges) + (Letter_Ranges, Decimal_Digit_Ranges, ISO_646_Ranges) + (Character_Ranges): Likewise. + * opt.adb (Set_Config_Switches): Remove [ from Identifier_Char + set. + +2022-05-12 Eric Botcazou <ebotcazou@adacore.com> + + * sem_type.adb (Specific_Type): Add swapped cases for interfaces. + +2022-05-12 Piotr Trojanek <trojanek@adacore.com> + + * doc/gnat_rm/implementation_defined_pragmas.rst: + (Export_Object, Import_Object, Short_Descriptors): Fix pragma + syntax specification. + * gnat_rm.texi: Regenerate. + +2022-05-12 Piotr Trojanek <trojanek@adacore.com> + + * ali.adb (Hash): Reuse GNAT.String_Hash.Hash and don't pollute + the Name_Id table. + +2022-05-12 Piotr Trojanek <trojanek@adacore.com> + + * doc/gnat_ugn/the_gnat_compilation_model.rst (Configuration + Pragmas): Add Aggregate_Individually_Assign; otherwise the list + is complete except for some obsoleted pragmas, which most likely + are intentionally omitted. + * gnat_ugn.texi: Regenerate. + 2022-05-11 Yannick Moy <moy@adacore.com> * libgnat/s-imaged.ads: Remove Pure. diff --git a/gcc/ada/Makefile.rtl b/gcc/ada/Makefile.rtl index aaf853e..0394d96 100644 --- a/gcc/ada/Makefile.rtl +++ b/gcc/ada/Makefile.rtl @@ -126,6 +126,8 @@ GNATRTL_NONTASKING_OBJS= \ a-chlat9$(objext) \ a-chtgbk$(objext) \ a-chtgbo$(objext) \ + a-chtgfk$(objext) \ + a-chtgfo$(objext) \ a-chtgke$(objext) \ a-chtgop$(objext) \ a-chzla1$(objext) \ diff --git a/gcc/ada/ali.adb b/gcc/ada/ali.adb index 1c3b5cc..a5fba5d 100644 --- a/gcc/ada/ali.adb +++ b/gcc/ada/ali.adb @@ -33,6 +33,7 @@ with Snames; use Snames; with GNAT; use GNAT; with GNAT.Dynamic_HTables; use GNAT.Dynamic_HTables; +with System.String_Hash; package body ALI is @@ -251,6 +252,7 @@ package body ALI is 'E' | -- external 'G' | -- invocation graph 'I' | -- interrupt + 'K' | -- CUDA kernels 'L' | -- linker option 'M' | -- main program 'N' | -- notes @@ -268,7 +270,7 @@ package body ALI is -- Still available: - 'B' | 'F' | 'H' | 'J' | 'K' | 'O' | 'Q' => False); + 'B' | 'F' | 'H' | 'J' | 'O' | 'Q' => False); ------------------------------ -- Add_Invocation_Construct -- @@ -578,20 +580,18 @@ package body ALI is function Hash (IS_Rec : Invocation_Signature_Record) return Bucket_Range_Type is + function String_Hash is new System.String_Hash.Hash + (Char_Type => Character, + Key_Type => String, + Hash_Type => Bucket_Range_Type); + Buffer : Bounded_String (2052); - IS_Nam : Name_Id; begin - -- The hash is obtained in the following manner: - -- - -- * A String signature based on the scope, name, line number, column - -- number, and locations, in the following format: + -- The hash is obtained from a signature based on the scope, name, line + -- number, column number, and locations, in the following format: -- -- scope__name__line_column__locations - -- - -- * The String is converted into a Name_Id - -- - -- * The absolute value of the Name_Id is used as the hash Append (Buffer, IS_Rec.Scope); Append (Buffer, "__"); @@ -606,8 +606,7 @@ package body ALI is Append (Buffer, IS_Rec.Locations); end if; - IS_Nam := Name_Find (Buffer); - return Bucket_Range_Type (abs IS_Nam); + return String_Hash (To_String (Buffer)); end Hash; -------------------- @@ -672,7 +671,6 @@ package body ALI is SSO_Default_Specified := False; Task_Dispatching_Policy_Specified := ' '; Unreserve_All_Interrupts_Specified := False; - Frontend_Exceptions_Specified := False; Zero_Cost_Exceptions_Specified := False; end Initialize_ALI; @@ -1746,12 +1744,14 @@ package body ALI is ALIs.Table (Id) := ( Afile => F, Compile_Errors => False, + First_CUDA_Kernel => CUDA_Kernels.Last + 1, First_Interrupt_State => Interrupt_States.Last + 1, First_Sdep => No_Sdep_Id, First_Specific_Dispatching => Specific_Dispatching.Last + 1, First_Unit => No_Unit_Id, GNATprove_Mode => False, Invocation_Graph_Encoding => No_Encoding, + Last_CUDA_Kernel => CUDA_Kernels.Last, Last_Interrupt_State => Interrupt_States.Last, Last_Sdep => No_Sdep_Id, Last_Specific_Dispatching => Specific_Dispatching.Last, @@ -1776,7 +1776,6 @@ package body ALI is Unit_Exception_Table => False, Ver => (others => ' '), Ver_Len => 0, - Frontend_Exceptions => False, Zero_Cost_Exceptions => False); -- Now we acquire the input lines from the ALI file. Note that the @@ -1919,6 +1918,24 @@ package body ALI is C := Getc; end loop A_Loop; + -- Acquire 'K' lines if present + + Check_Unknown_Line; + + while C = 'K' loop + if Ignore ('K') then + Skip_Line; + + else + Skip_Space; + CUDA_Kernels.Append ((Kernel_Name => Get_Name)); + ALIs.Table (Id).Last_CUDA_Kernel := CUDA_Kernels.Last; + Skip_Eol; + end if; + + C := Getc; + end loop; + -- Acquire P line Check_Unknown_Line; @@ -1973,9 +1990,10 @@ package body ALI is elsif C = 'F' then C := Getc; + -- Old front-end exceptions marker, ignore + if C = 'X' then - ALIs.Table (Id).Frontend_Exceptions := True; - Frontend_Exceptions_Specified := True; + null; else Fatal_Error_Ignore; end if; diff --git a/gcc/ada/ali.ads b/gcc/ada/ali.ads index 8d6dd90..a5af75e 100644 --- a/gcc/ada/ali.ads +++ b/gcc/ada/ali.ads @@ -46,6 +46,9 @@ package ALI is type ALI_Id is range 0 .. 99_999_999; -- Id values used for ALIs table entries + type CUDA_Kernel_Id is range 0 .. 99_999_999; + -- Id values used for CUDA_Kernel table entries + type Unit_Id is range 0 .. 99_999_999; -- Id values used for Unit table entries @@ -247,10 +250,6 @@ package ALI is -- Set to True if unit exception table pointer generated. Not set if 'P' -- appears in Ignore_Lines. - Frontend_Exceptions : Boolean; - -- Set to True if file was compiled with front-end exceptions. Not set - -- if 'P' appears in Ignore_Lines. - Zero_Cost_Exceptions : Boolean; -- Set to True if file was compiled with zero cost exceptions. Not set -- if 'P' appears in Ignore_Lines. @@ -258,6 +257,12 @@ package ALI is Restrictions : Restrictions_Info; -- Restrictions information reconstructed from R lines + First_CUDA_Kernel : CUDA_Kernel_Id; + Last_CUDA_Kernel : CUDA_Kernel_Id'Base; + -- These point to the first and last entries in the CUDA_Kernels table + -- for this unit. If there are no entries, First_CUDA_Kernel = + -- Last_CUDA_Kernel + 1. + First_Interrupt_State : Interrupt_State_Id; Last_Interrupt_State : Interrupt_State_Id'Base; -- These point to the first and last entries in the interrupt state @@ -294,6 +299,27 @@ package ALI is Table_Increment => 200, Table_Name => "ALIs"); + --------------------------- + -- CUDA Kernels Table -- + --------------------------- + + -- An entry is made in this table for each K (CUDA Kernel) line + -- encountered in the input ALI file. The First/Last_CUDA_Kernel_Id + -- fields of the ALI file entry show the range of entries defined + -- within a particular ALI file. + + type CUDA_Kernel_Record is record + Kernel_Name : Name_Id; + end record; + + package CUDA_Kernels is new Table.Table ( + Table_Component_Type => CUDA_Kernel_Record, + Table_Index_Type => CUDA_Kernel_Id'Base, + Table_Low_Bound => CUDA_Kernel_Id'First, + Table_Initial => 100, + Table_Increment => 200, + Table_Name => "Cuda_Kernels"); + ---------------- -- Unit Table -- ---------------- @@ -559,10 +585,6 @@ package ALI is -- Set to False by Initialize_ALI. Set to True if Scan_ALI reads -- a unit for which dynamic elaboration checking is enabled. - Frontend_Exceptions_Specified : Boolean := False; - -- Set to False by Initialize_ALI. Set to True if an ali file is read that - -- has a P line specifying the generation of front-end exceptions. - GNATprove_Mode_Specified : Boolean := False; -- Set to True if an ali file was produced in GNATprove mode. diff --git a/gcc/ada/aspects.adb b/gcc/ada/aspects.adb index 62603d6..3471a81 100644 --- a/gcc/ada/aspects.adb +++ b/gcc/ada/aspects.adb @@ -285,7 +285,9 @@ package body Aspects is begin if Present (Spec) then - if A = Aspect_Default_Iterator then + if A = Aspect_Default_Iterator + and then Present (Aspect_Rep_Item (Spec)) + then return Expression (Aspect_Rep_Item (Spec)); else return Expression (Spec); diff --git a/gcc/ada/atree.adb b/gcc/ada/atree.adb index bb4c3b4..a949761 100644 --- a/gcc/ada/atree.adb +++ b/gcc/ada/atree.adb @@ -23,6 +23,7 @@ -- -- ------------------------------------------------------------------------------ +with Ada.Unchecked_Conversion; with Aspects; use Aspects; with Debug; use Debug; with Namet; use Namet; @@ -504,7 +505,7 @@ package body Atree is pragma Assert (Field_Type'Size = 1); function Cast is new - Unchecked_Conversion (Field_Size_1_Bit, Field_Type); + Ada.Unchecked_Conversion (Field_Size_1_Bit, Field_Type); Val : constant Field_Size_1_Bit := Get_1_Bit_Val (N, Offset); begin return Cast (Val); @@ -516,7 +517,7 @@ package body Atree is pragma Assert (Field_Type'Size = 2); function Cast is new - Unchecked_Conversion (Field_Size_2_Bit, Field_Type); + Ada.Unchecked_Conversion (Field_Size_2_Bit, Field_Type); Val : constant Field_Size_2_Bit := Get_2_Bit_Val (N, Offset); begin return Cast (Val); @@ -528,7 +529,7 @@ package body Atree is pragma Assert (Field_Type'Size = 4); function Cast is new - Unchecked_Conversion (Field_Size_4_Bit, Field_Type); + Ada.Unchecked_Conversion (Field_Size_4_Bit, Field_Type); Val : constant Field_Size_4_Bit := Get_4_Bit_Val (N, Offset); begin return Cast (Val); @@ -540,7 +541,7 @@ package body Atree is pragma Assert (Field_Type'Size = 8); function Cast is new - Unchecked_Conversion (Field_Size_8_Bit, Field_Type); + Ada.Unchecked_Conversion (Field_Size_8_Bit, Field_Type); Val : constant Field_Size_8_Bit := Get_8_Bit_Val (N, Offset); begin return Cast (Val); @@ -552,7 +553,7 @@ package body Atree is pragma Assert (Field_Type'Size = 32); function Cast is new - Unchecked_Conversion (Field_Size_32_Bit, Field_Type); + Ada.Unchecked_Conversion (Field_Size_32_Bit, Field_Type); Val : constant Field_Size_32_Bit := Get_32_Bit_Val (N, Offset); Result : constant Field_Type := Cast (Val); @@ -604,7 +605,7 @@ package body Atree is pragma Assert (Field_Type'Size = 1); function Cast is new - Unchecked_Conversion (Field_Type, Field_Size_1_Bit); + Ada.Unchecked_Conversion (Field_Type, Field_Size_1_Bit); begin Set_1_Bit_Val (N, Offset, Cast (Val)); end Set_1_Bit_Field; @@ -615,7 +616,7 @@ package body Atree is pragma Assert (Field_Type'Size = 2); function Cast is new - Unchecked_Conversion (Field_Type, Field_Size_2_Bit); + Ada.Unchecked_Conversion (Field_Type, Field_Size_2_Bit); begin Set_2_Bit_Val (N, Offset, Cast (Val)); end Set_2_Bit_Field; @@ -626,7 +627,7 @@ package body Atree is pragma Assert (Field_Type'Size = 4); function Cast is new - Unchecked_Conversion (Field_Type, Field_Size_4_Bit); + Ada.Unchecked_Conversion (Field_Type, Field_Size_4_Bit); begin Set_4_Bit_Val (N, Offset, Cast (Val)); end Set_4_Bit_Field; @@ -637,7 +638,7 @@ package body Atree is pragma Assert (Field_Type'Size = 8); function Cast is new - Unchecked_Conversion (Field_Type, Field_Size_8_Bit); + Ada.Unchecked_Conversion (Field_Type, Field_Size_8_Bit); begin Set_8_Bit_Val (N, Offset, Cast (Val)); end Set_8_Bit_Field; @@ -648,7 +649,7 @@ package body Atree is pragma Assert (Field_Type'Size = 32); function Cast is new - Unchecked_Conversion (Field_Type, Field_Size_32_Bit); + Ada.Unchecked_Conversion (Field_Type, Field_Size_32_Bit); begin Set_32_Bit_Val (N, Offset, Cast (Val)); end Set_32_Bit_Field; @@ -853,7 +854,7 @@ package body Atree is ---------------------- procedure Print_Atree_Info (N : Node_Or_Entity_Id) is - function Cast is new Unchecked_Conversion (Slot, Int); + function Cast is new Ada.Unchecked_Conversion (Slot, Int); begin Write_Int (Int (Size_In_Slots (N))); Write_Str (" slots ("); diff --git a/gcc/ada/atree.ads b/gcc/ada/atree.ads index 417a7ab..9d01cfc 100644 --- a/gcc/ada/atree.ads +++ b/gcc/ada/atree.ads @@ -52,7 +52,6 @@ with Types; use Types; with Seinfo; use Seinfo; with System; use System; with Table; -with Unchecked_Conversion; package Atree is diff --git a/gcc/ada/bcheck.adb b/gcc/ada/bcheck.adb index f773778..edab985 100644 --- a/gcc/ada/bcheck.adb +++ b/gcc/ada/bcheck.adb @@ -94,9 +94,7 @@ package body Bcheck is Check_Consistent_SSO_Default; end if; - if Zero_Cost_Exceptions_Specified - or else Frontend_Exceptions_Specified - then + if Zero_Cost_Exceptions_Specified then Check_Consistent_Exception_Handling; end if; @@ -1245,11 +1243,8 @@ package body Bcheck is procedure Check_Consistent_Exception_Handling is begin Check_Mechanism : for A1 in ALIs.First + 1 .. ALIs.Last loop - if (ALIs.Table (A1).Zero_Cost_Exceptions /= - ALIs.Table (ALIs.First).Zero_Cost_Exceptions) - or else - (ALIs.Table (A1).Frontend_Exceptions /= - ALIs.Table (ALIs.First).Frontend_Exceptions) + if ALIs.Table (A1).Zero_Cost_Exceptions /= + ALIs.Table (ALIs.First).Zero_Cost_Exceptions then Error_Msg_File_1 := ALIs.Table (A1).Sfile; Error_Msg_File_2 := ALIs.Table (ALIs.First).Sfile; diff --git a/gcc/ada/bindgen.adb b/gcc/ada/bindgen.adb index d7ba267..3558708 100644 --- a/gcc/ada/bindgen.adb +++ b/gcc/ada/bindgen.adb @@ -317,6 +317,9 @@ package body Bindgen is procedure Gen_CodePeer_Wrapper; -- For CodePeer, generate wrapper which calls user-defined main subprogram + procedure Gen_CUDA_Init; + -- When CUDA registration code is needed. + procedure Gen_Elab_Calls (Elab_Order : Unit_Id_Array); -- Generate sequence of elaboration calls @@ -1239,6 +1242,137 @@ package body Bindgen is Bind_Env_String_Built := True; end Gen_Bind_Env_String; + ------------------- + -- Gen_CUDA_Init -- + ------------------- + + procedure Gen_CUDA_Init is + Unit_Name : constant String := + Get_Name_String (Units.Table (First_Unit_Entry).Uname); + Unit : constant String := + Unit_Name (Unit_Name'First .. Unit_Name'Last - 2); + begin + if not Enable_CUDA_Expansion then + return; + end if; + + WBI (""); + WBI (" "); + + WBI (" function CUDA_Register_Function"); + WBI (" (Fat_Binary_Handle : System.Address;"); + WBI (" Func : System.Address;"); + WBI (" Kernel_Name : Interfaces.C.Strings.chars_ptr;"); + WBI (" Kernel_Name_2 : Interfaces.C.Strings.chars_ptr;"); + WBI (" Minus_One : Integer;"); + WBI (" Nullptr1 : System.Address;"); + WBI (" Nullptr2 : System.Address;"); + WBI (" Nullptr3 : System.Address;"); + WBI (" Nullptr4 : System.Address;"); + WBI (" Nullptr5 : System.Address) return Boolean;"); + WBI (" pragma Import"); + WBI (" (Convention => C,"); + WBI (" Entity => CUDA_Register_Function,"); + WBI (" External_Name => ""__cudaRegisterFunction"");"); + WBI (""); + WBI (" function CUDA_Register_Fat_Binary"); + WBI (" (Fat_Binary : System.Address)"); + WBI (" return System.Address;"); + WBI (" pragma Import"); + WBI (" (Convention => C,"); + WBI (" Entity => CUDA_Register_Fat_Binary,"); + WBI (" External_Name => ""__cudaRegisterFatBinary"");"); + WBI (""); + WBI (" function CUDA_Register_Fat_Binary_End"); + WBI (" (Fat_Binary : System.Address) return Boolean;"); + WBI (" pragma Import"); + WBI (" (Convention => C,"); + WBI (" Entity => CUDA_Register_Fat_Binary_End,"); + WBI (" External_Name => ""__cudaRegisterFatBinaryEnd"");"); + WBI (""); + WBI (" type Fatbin_Wrapper is record"); + WBI (" Magic : Interfaces.C.int;"); + WBI (" Version : Interfaces.C.int;"); + WBI (" Data : System.Address;"); + WBI (" Filename_Or_Fatbins : System.Address;"); + WBI (" end record;"); + WBI (""); + WBI (" Fat_Binary : System.Address;"); + WBI (" pragma Import"); + WBI (" (Convention => C,"); + WBI (" Entity => Fat_Binary,"); + WBI (" External_Name => ""_binary_" & Unit & "_fatbin_start"");"); + WBI (""); + WBI (" Wrapper : Fatbin_Wrapper :="); + WBI (" (16#466243b1#,"); + WBI (" 1,"); + WBI (" Fat_Binary'Address,"); + WBI (" System.Null_Address);"); + WBI (""); + WBI (" Fat_Binary_Handle : System.Address :="); + WBI (" CUDA_Register_Fat_Binary (Wrapper'Address);"); + WBI (""); + + for K in CUDA_Kernels.First .. CUDA_Kernels.Last loop + declare + K_String : constant String := CUDA_Kernel_Id'Image (K); + N : constant String := + K_String (K_String'First + 1 .. K_String'Last); + Kernel_Symbol : constant String := "Kernel_" & N; + -- K_Symbol is a unique identifier used to derive all symbol names + -- related to kernel K. + + Kernel_Addr : constant String := Kernel_Symbol & "_Addr"; + -- Kernel_Addr is the name of the symbol representing the address + -- of the host-side procedure of the kernel. The address is + -- pragma-imported and then used while registering the kernel with + -- the CUDA runtime. + Kernel_String : constant String := Kernel_Symbol & "_String"; + -- Kernel_String is the name of the C-string containing the name + -- of the kernel. It is used for registering the kernel with the + -- CUDA runtime. + Kernel_Name : constant String := + Get_Name_String (CUDA_Kernels.Table (K).Kernel_Name); + -- Kernel_Name is the name of the kernel, after package expansion. + + begin + -- Import host-side kernel address. + WBI (" " & Kernel_Addr & " : constant System.Address;"); + WBI (" pragma Import"); + WBI (" (Convention => C,"); + WBI (" Entity => " & Kernel_Addr & ","); + WBI (" External_Name => """ & Kernel_Name & """);"); + WBI (""); + + -- Generate C-string containing name of kernel. + WBI + (" " & Kernel_String & " : Interfaces.C.Strings.Chars_Ptr :="); + WBI (" Interfaces.C.Strings.New_Char_Array (""" + & Kernel_Name + & """);"); + WBI (""); + + -- Generate call to CUDA runtime to register function. + WBI (" CUDA_Register" & N & " : Boolean :="); + WBI (" CUDA_Register_Function ("); + WBI (" Fat_Binary_Handle, "); + WBI (" " & Kernel_Addr & ","); + WBI (" " & Kernel_String & ","); + WBI (" " & Kernel_String & ","); + WBI (" -1,"); + WBI (" System.Null_Address,"); + WBI (" System.Null_Address,"); + WBI (" System.Null_Address,"); + WBI (" System.Null_Address,"); + WBI (" System.Null_Address);"); + WBI (""); + end; + end loop; + + WBI (" CUDA_End : Boolean := "); + WBI (" CUDA_Register_Fat_Binary_End(Fat_Binary_Handle);"); + end Gen_CUDA_Init; + -------------------------- -- Gen_CodePeer_Wrapper -- -------------------------- @@ -2353,6 +2487,11 @@ package body Bindgen is WBI ("with System.Secondary_Stack;"); end if; + if Enable_CUDA_Expansion then + WBI ("with Interfaces.C;"); + WBI ("with Interfaces.C.Strings;"); + end if; + Resolve_Binder_Options (Elab_Order); -- Generate standard with's @@ -2502,6 +2641,8 @@ package body Bindgen is Get_Main_Name & """);"); end if; + Gen_CUDA_Init; + -- Generate version numbers for units, only if needed. Be very safe on -- the condition. diff --git a/gcc/ada/butil.adb b/gcc/ada/butil.adb index d6e21df..9536c10 100644 --- a/gcc/ada/butil.adb +++ b/gcc/ada/butil.adb @@ -23,9 +23,9 @@ -- -- ------------------------------------------------------------------------------ +with Ada.Unchecked_Deallocation; with Opt; use Opt; with Output; use Output; -with Unchecked_Deallocation; with GNAT; use GNAT; @@ -540,7 +540,7 @@ package body Butil is --------------------------------- function Read_Forced_Elab_Order_File return String_Ptr is - procedure Free is new Unchecked_Deallocation (String, String_Ptr); + procedure Free is new Ada.Unchecked_Deallocation (String, String_Ptr); Descr : File_Descriptor; Len : Natural; diff --git a/gcc/ada/casing.adb b/gcc/ada/casing.adb index 1df5877..6d2f2f4 100644 --- a/gcc/ada/casing.adb +++ b/gcc/ada/casing.adb @@ -105,15 +105,6 @@ package body Casing is end if; end Determine_Casing; - ------------------------ - -- Set_All_Upper_Case -- - ------------------------ - - procedure Set_All_Upper_Case is - begin - Set_Casing (All_Upper_Case); - end Set_All_Upper_Case; - ---------------- -- Set_Casing -- ---------------- diff --git a/gcc/ada/casing.ads b/gcc/ada/casing.ads index 24e3ef6..df042db 100644 --- a/gcc/ada/casing.ads +++ b/gcc/ada/casing.ads @@ -78,12 +78,6 @@ package Casing is procedure Set_Casing (C : Casing_Type; D : Casing_Type := Mixed_Case); -- Uses Buf => Global_Name_Buffer - procedure Set_All_Upper_Case; - pragma Inline (Set_All_Upper_Case); - -- This procedure is called with an identifier name stored in Name_Buffer. - -- On return, the identifier is converted to all upper case. The call is - -- equivalent to Set_Casing (All_Upper_Case). - function Determine_Casing (Ident : Text_Buffer) return Casing_Type; -- Determines the casing of the identifier/keyword string Ident. A special -- test is made for SPARK_Mode which is considered to be mixed case, since diff --git a/gcc/ada/contracts.adb b/gcc/ada/contracts.adb index 3cda36a..7ce3cfa 100644 --- a/gcc/ada/contracts.adb +++ b/gcc/ada/contracts.adb @@ -3630,6 +3630,10 @@ package body Contracts is -- and append it to the freezing actions of Tagged_Type. Is_Dynamic -- controls building the static or dynamic version of the helper. + function Build_Unique_Name (Suffix : String) return Name_Id; + -- Build an unique new name adding suffix to Subp_Id name (plus its + -- homonym number for values bigger than 1). + ------------------------------- -- Add_Indirect_Call_Wrapper -- ------------------------------- @@ -3710,9 +3714,7 @@ package body Contracts is function Build_ICW_Decl return Node_Id is ICW_Id : constant Entity_Id := Make_Defining_Identifier (Loc, - New_External_Name (Chars (Subp_Id), - Suffix => "ICW", - Suffix_Index => Source_Offset (Loc))); + Build_Unique_Name (Suffix => "ICW")); Decl : Node_Id; Spec : Node_Id; @@ -4049,6 +4051,29 @@ package body Contracts is end if; end Add_Call_Helper; + ----------------------- + -- Build_Unique_Name -- + ----------------------- + + function Build_Unique_Name (Suffix : String) return Name_Id is + begin + -- Append the homonym number. Strip the leading space character in + -- the image of natural numbers. Also do not add the homonym value + -- of 1. + + if Has_Homonym (Subp_Id) and then Homonym_Number (Subp_Id) > 1 then + declare + S : constant String := Homonym_Number (Subp_Id)'Img; + + begin + return New_External_Name (Chars (Subp_Id), + Suffix => Suffix & "_" & S (2 .. S'Last)); + end; + end if; + + return New_External_Name (Chars (Subp_Id), Suffix); + end Build_Unique_Name; + -- Local variables Helper_Id : Entity_Id; @@ -4070,9 +4095,7 @@ package body Contracts is Helper_Id := Make_Defining_Identifier (Loc, - New_External_Name (Chars (Subp_Id), - Suffix => "DP", - Suffix_Index => Source_Offset (Loc))); + Build_Unique_Name (Suffix => "DP")); Add_Call_Helper (Helper_Id, Is_Dynamic => True); -- Link original subprogram to helper and vice versa @@ -4089,9 +4112,7 @@ package body Contracts is Helper_Id := Make_Defining_Identifier (Loc, - New_External_Name (Chars (Subp_Id), - Suffix => "SP", - Suffix_Index => Source_Offset (Loc))); + Build_Unique_Name (Suffix => "SP")); Add_Call_Helper (Helper_Id, Is_Dynamic => False); diff --git a/gcc/ada/csets.adb b/gcc/ada/csets.adb index d36b815..5feb3ee 100644 --- a/gcc/ada/csets.adb +++ b/gcc/ada/csets.adb @@ -558,7 +558,7 @@ package body Csets is 'q' => 'Q', X_A8 => X_A6, 'r' => 'R', X_B8 => X_B4, 's' => 'S', X_BD => X_BC, - 't' => 'T', X_BE => X_FF, + 't' => 'T', X_BE => X_BE, 'u' => 'U', 'v' => 'V', 'w' => 'W', @@ -581,7 +581,7 @@ package body Csets is 'M' => 'M', X_CC => X_CC, X_DC => X_DC, 'N' => 'N', X_CD => X_CD, X_DD => X_DD, 'O' => 'O', X_CE => X_CE, X_DE => X_DE, - 'P' => 'P', X_CF => X_CF, X_DF => X_DF, X_FF => X_FF, + 'P' => 'P', X_CF => X_CF, X_DF => X_DF, X_FF => X_BE, 'Q' => 'Q', X_A6 => X_A6, 'R' => 'R', X_B4 => X_B4, 'S' => 'S', X_BC => X_BC, @@ -835,6 +835,8 @@ package body Csets is X_98 => X_98, -- y umlaut X_99 => X_99, -- O umlaut X_9A => X_9A, -- U umlaut + X_9B => X_9D, -- o with stroke + X_9D => X_9D, -- O with stroke X_A0 => X_B5, -- a acute X_A1 => X_D6, -- i acute @@ -1145,12 +1147,13 @@ package body Csets is Identifier_Char (J) := (Fold_Upper (J) /= ' '); end loop; - -- Always add [ as an identifier character to deal with the brackets - -- notation for wide characters used in identifiers. Note that if - -- we are not allowing wide characters in identifiers, then any use - -- of this notation will be flagged as an error in Scan_Identifier. + -- Add [ as an identifier character to deal with the brackets notation + -- for wide characters used in identifiers for versions up to Ada 2012. + -- Note that if we are not allowing wide characters in identifiers, then + -- any use of this notation will be flagged as an error in + -- Scan_Identifier. - Identifier_Char ('[') := True; + Identifier_Char ('[') := Ada_Version < Ada_2022; -- Add entry for ESC if wide characters in use with a wide character -- encoding method active that uses the ESC code for encoding. diff --git a/gcc/ada/doc/gnat_rm/implementation_defined_pragmas.rst b/gcc/ada/doc/gnat_rm/implementation_defined_pragmas.rst index 823db1c..af85600 100644 --- a/gcc/ada/doc/gnat_rm/implementation_defined_pragmas.rst +++ b/gcc/ada/doc/gnat_rm/implementation_defined_pragmas.rst @@ -1985,10 +1985,10 @@ Syntax: :: - pragma Export_Object + pragma Export_Object ( [Internal =>] LOCAL_NAME [, [External =>] EXTERNAL_SYMBOL] - [, [Size =>] EXTERNAL_SYMBOL] + [, [Size =>] EXTERNAL_SYMBOL]); EXTERNAL_SYMBOL ::= IDENTIFIER @@ -2911,7 +2911,7 @@ Syntax: :: - pragma Import_Object + pragma Import_Object ( [Internal =>] LOCAL_NAME [, [External =>] EXTERNAL_SYMBOL] [, [Size =>] EXTERNAL_SYMBOL]); @@ -6031,7 +6031,7 @@ Syntax: .. code-block:: ada - pragma Short_Descriptors + pragma Short_Descriptors; This pragma is provided for compatibility with other Ada implementations. It diff --git a/gcc/ada/doc/gnat_rm/representation_clauses_and_pragmas.rst b/gcc/ada/doc/gnat_rm/representation_clauses_and_pragmas.rst index a30ad5f..b0e131f 100644 --- a/gcc/ada/doc/gnat_rm/representation_clauses_and_pragmas.rst +++ b/gcc/ada/doc/gnat_rm/representation_clauses_and_pragmas.rst @@ -457,14 +457,14 @@ from Ada 83 to Ada 95 or Ada 2005. For example, consider: .. code-block:: ada - type Rec is record; + type Rec is record A : Natural; B : Natural; end record; for Rec use record - at 0 range 0 .. Natural'Size - 1; - at 0 range Natural'Size .. 2 * Natural'Size - 1; + A at 0 range 0 .. Natural'Size - 1; + B at 0 range Natural'Size .. 2 * Natural'Size - 1; end record; In the above code, since the typical size of ``Natural`` objects diff --git a/gcc/ada/doc/gnat_rm/security_hardening_features.rst b/gcc/ada/doc/gnat_rm/security_hardening_features.rst index bdcfd99..8c4c1f6 100644 --- a/gcc/ada/doc/gnat_rm/security_hardening_features.rst +++ b/gcc/ada/doc/gnat_rm/security_hardening_features.rst @@ -15,7 +15,7 @@ Register Scrubbing GNAT can generate code to zero-out hardware registers before returning from a subprogram. -It can be enabled with the *-fzero-call-used-regs* command line +It can be enabled with the :switch:`-fzero-call-used-regs` command-line option, to affect all subprograms in a compilation, and with a :samp:`Machine_Attribute` pragma, to affect only specific subprograms. @@ -31,7 +31,7 @@ option, to affect all subprograms in a compilation, and with a -- Before returning, Bar scrubs all call-clobbered registers. -For usage and more details on the command line option, and on the +For usage and more details on the command-line option, and on the ``zero_call_used_regs`` attribute, see :title:`Using the GNU Compiler Collection (GCC)`. @@ -64,10 +64,10 @@ specific subprograms and variables. -- of the stack space used by the subprogram. -There are also *-fstrub* command line options to control default -settings. For usage and more details on the command line option, and -on the ``strub`` attribute, see :title:`Using the GNU Compiler -Collection (GCC)`. +There are also :switch:`-fstrub` command-line options to control +default settings. For usage and more details on the command-line +option, and on the ``strub`` attribute, see :title:`Using the GNU +Compiler Collection (GCC)`. Note that Ada secondary stacks are not scrubbed. The restriction ``No_Secondary_Stack`` avoids their use, and thus their accidental @@ -126,18 +126,18 @@ Bar_Callable_Ptr. Hardened Conditionals ===================== -GNAT can harden conditionals to protect against control flow attacks. +GNAT can harden conditionals to protect against control-flow attacks. This is accomplished by two complementary transformations, each activated by a separate command-line option. -The option *-fharden-compares* enables hardening of compares that -compute results stored in variables, adding verification that the +The option :switch:`-fharden-compares` enables hardening of compares +that compute results stored in variables, adding verification that the reversed compare yields the opposite result. -The option *-fharden-conditional-branches* enables hardening of -compares that guard conditional branches, adding verification of the -reversed compare to both execution paths. +The option :switch:`-fharden-conditional-branches` enables hardening +of compares that guard conditional branches, adding verification of +the reversed compare to both execution paths. These transformations are introduced late in the compilation pipeline, long after boolean expressions are decomposed into separate compares, @@ -155,8 +155,91 @@ options ensures that every compare that is neither optimized out nor optimized into implied conditionals will be hardened. The addition of reversed compares can be observed by enabling the dump -files of the corresponding passes, through command line options -*-fdump-tree-hardcmp* and *-fdump-tree-hardcbr*, respectively. +files of the corresponding passes, through command-line options +:switch:`-fdump-tree-hardcmp` and :switch:`-fdump-tree-hardcbr`, +respectively. They are separate options, however, because of the significantly different performance impact of the hardening transformations. + + +.. Hardened Booleans: + +Hardened Booleans +================= + +Ada has built-in support for introducing boolean types with +alternative representations, using representation clauses: + +.. code-block:: ada + + type HBool is new Boolean; + for HBool use (16#5a#, 16#a5#); + for HBool'Size use 8; + +When validity checking is enabled, the compiler will check that +variables of such types hold values corresponding to the selected +representations. + +There are multiple strategies for where to introduce validity checking +(see :switch:`-gnatV` options). Their goal is to guard against +various kinds of programming errors, and GNAT strives to omit checks +when program logic rules out an invalid value, and optimizers may +further remove checks found to be redundant. + +For additional hardening, the ``hardbool`` :samp:`Machine_Attribute` +pragma can be used to annotate boolean types with representation +clauses, so that expressions of such types used as conditions are +checked even when compiling with :switch:`-gnatVT`. + +.. code-block:: ada + + pragma Machine_Attribute (HBool, "hardbool"); + +Note that :switch:`-gnatVn` will disable even ``hardbool`` testing. + + +.. Control Flow Redundancy: + +Control Flow Redundancy +======================= + +GNAT can guard against unexpected execution flows, such as branching +into the middle of subprograms, as in Return Oriented Programming +exploits. + +In units compiled with :switch:`-fharden-control-flow-redundancy`, +subprograms are instrumented so that, every time they are called, +basic blocks take note as control flows through them, and, before +returning, subprograms verify that the taken notes are consistent with +the control-flow graph. + +Functions with too many basic blocks, or with multiple return points, +call a run-time function to perform the verification. Other functions +perform the verification inline before returning. + +Optimizing the inlined verification can be quite time consuming, so +the default upper limit for the inline mode is set at 16 blocks. +Command-line option :switch:`--param hardcfr-max-inline-blocks=` can +override it. + +Even though typically sparse control-flow graphs exhibit run-time +verification time nearly proportional to the block count of a +subprogram, it may become very significant for generated subprograms +with thousands of blocks. Command-line option +:switch:`--param hardcfr-max-blocks=` can set an upper limit for +instrumentation. + +For each block that is marked as visited, the mechanism checks that at +least one of its predecessors, and at least one of its successors, are +also marked as visited. + +Verification is performed just before returning. Subprogram +executions that complete by raising or propagating an exception bypass +verification-and-return points. A subprogram that can only complete +by raising or propagating an exception may have instrumentation +disabled altogether. + +The instrumentation for hardening with control flow redundancy can be +observed in dump files generated by the command-line option +:switch:`-fdump-tree-hardcfr`. 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 6104152..c514678 100644 --- a/gcc/ada/doc/gnat_ugn/gnat_and_program_execution.rst +++ b/gcc/ada/doc/gnat_ugn/gnat_and_program_execution.rst @@ -2101,11 +2101,11 @@ the typing system. Consider the following complete program example: function to_a2 (Input : a1) return a2; end p2; - with Unchecked_Conversion; + with Ada.Unchecked_Conversion; package body p2 is function to_a2 (Input : a1) return a2 is function to_a2u is - new Unchecked_Conversion (a1, a2); + new Ada.Unchecked_Conversion (a1, a2); begin return to_a2u (Input); end to_a2; @@ -2198,7 +2198,7 @@ the warning off: pragma Warnings (Off); function to_a2u is - new Unchecked_Conversion (a1, a2); + new Ada.Unchecked_Conversion (a1, a2); pragma Warnings (On); Of course that approach is not appropriate for this particular @@ -3590,9 +3590,9 @@ properly allocated memory location. Here is a complete example of use of .. code-block:: ada - with Gnat.Io; use Gnat.Io; - with Unchecked_Deallocation; - with Unchecked_Conversion; + with GNAT.IO; use GNAT.IO; + with Ada.Unchecked_Deallocation; + with Ada.Unchecked_Conversion; with GNAT.Debug_Pools; with System.Storage_Elements; with Ada.Exceptions; use Ada.Exceptions; @@ -3604,8 +3604,8 @@ properly allocated memory location. Here is a complete example of use of P : GNAT.Debug_Pools.Debug_Pool; for T'Storage_Pool use P; - procedure Free is new Unchecked_Deallocation (Integer, T); - function UC is new Unchecked_Conversion (U, T); + procedure Free is new Ada.Unchecked_Deallocation (Integer, T); + function UC is new Ada.Unchecked_Conversion (U, T); A, B : aliased T; procedure Info is new GNAT.Debug_Pools.Print_Info(Put_Line); @@ -3864,12 +3864,12 @@ execution of this erroneous program: .. code-block:: ada - with Unchecked_Deallocation; + with Ada.Unchecked_Deallocation; procedure Test_Gm is type T is array (1..1000) of Integer; type Ptr is access T; - procedure Free is new Unchecked_Deallocation (T, Ptr); + procedure Free is new Ada.Unchecked_Deallocation (T, Ptr); A : Ptr; procedure My_Alloc is diff --git a/gcc/ada/doc/gnat_ugn/the_gnat_compilation_model.rst b/gcc/ada/doc/gnat_ugn/the_gnat_compilation_model.rst index 5974973..68209bf 100644 --- a/gcc/ada/doc/gnat_ugn/the_gnat_compilation_model.rst +++ b/gcc/ada/doc/gnat_ugn/the_gnat_compilation_model.rst @@ -1402,6 +1402,7 @@ recognized by GNAT:: Ada_12 Ada_2012 Ada_2022 + Aggregate_Individually_Assign Allow_Integer_Address Annotate Assertion_Policy @@ -3810,7 +3811,7 @@ Interfacing to C++ GNAT supports interfacing with the G++ compiler (or any C++ compiler generating code that is compatible with the G++ Application Binary -Interface ---see http://www.codesourcery.com/archives/cxx-abi). +Interface ---see http://itanium-cxx-abi.github.io/cxx-abi/abi.html). Interfacing can be done at 3 levels: simple data, subprograms, and classes. In the first two cases, GNAT offers a specific ``Convention C_Plus_Plus`` diff --git a/gcc/ada/errout.adb b/gcc/ada/errout.adb index 44d461f..bc7c7d3 100644 --- a/gcc/ada/errout.adb +++ b/gcc/ada/errout.adb @@ -3760,7 +3760,7 @@ package body Errout is Set_Msg_Str ("<error>"); else - Get_Unit_Name_String (Error_Msg_Unit_1, Suffix); + Get_Unit_Name_String (Global_Name_Buffer, Error_Msg_Unit_1, Suffix); Set_Msg_Blank; Set_Msg_Quote; Set_Msg_Name_Buffer; diff --git a/gcc/ada/erroutc.adb b/gcc/ada/erroutc.adb index d92ca33..866294e 100644 --- a/gcc/ada/erroutc.adb +++ b/gcc/ada/erroutc.adb @@ -1468,6 +1468,7 @@ package body Erroutc is procedure Set_Msg_Name_Buffer is begin Set_Msg_Str (Name_Buffer (1 .. Name_Len)); + Destroy_Global_Name_Buffer; end Set_Msg_Name_Buffer; ------------------- diff --git a/gcc/ada/erroutc.ads b/gcc/ada/erroutc.ads index d4d4443..eaac7dc 100644 --- a/gcc/ada/erroutc.ads +++ b/gcc/ada/erroutc.ads @@ -23,7 +23,7 @@ -- -- ------------------------------------------------------------------------------ --- This packages contains global variables and routines common to error +-- This package contains global variables and routines common to error -- reporting packages, including Errout and Prj.Err. with Table; @@ -617,8 +617,8 @@ package Erroutc is -- buffer with no leading zeroes output. procedure Set_Msg_Name_Buffer; - -- Output name from Name_Buffer, with surrounding quotes unless manual - -- quotation mode is in effect. + -- Output name from Namet.Global_Name_Buffer, with surrounding quotes + -- unless manual quotation mode is in effect. procedure Set_Msg_Quote; -- Set quote if in normal quote mode, nothing if in manual quote mode diff --git a/gcc/ada/exp_aggr.adb b/gcc/ada/exp_aggr.adb index 939d091..72f6555 100644 --- a/gcc/ada/exp_aggr.adb +++ b/gcc/ada/exp_aggr.adb @@ -1916,6 +1916,8 @@ package body Exp_Aggr is Is_Iterated_Component : constant Boolean := Parent_Kind (Expr) = N_Iterated_Component_Association; + Ent : Entity_Id; + L_J : Node_Id; L_L : Node_Id; @@ -2025,10 +2027,28 @@ package body Exp_Aggr is -- Otherwise construct the loop, starting with the loop index L_J if Is_Iterated_Component then + + -- Create a new scope for the loop variable so that the + -- following Gen_Assign (that ends up calling + -- Preanalyze_And_Resolve) can correctly find it. + + Ent := New_Internal_Entity (E_Loop, + Current_Scope, Loc, 'L'); + Set_Etype (Ent, Standard_Void_Type); + Set_Parent (Ent, Parent (Parent (Expr))); + Push_Scope (Ent); + L_J := Make_Defining_Identifier (Loc, Chars => (Chars (Defining_Identifier (Parent (Expr))))); + Enter_Name (L_J); + + -- The Etype will be set by a later Analyze call. + Set_Etype (L_J, Any_Type); + + Mutate_Ekind (L_J, E_Variable); + Set_Scope (L_J, Ent); else L_J := Make_Temporary (Loc, 'J', L); end if; @@ -2083,6 +2103,10 @@ package body Exp_Aggr is Iteration_Scheme => L_Iteration_Scheme, Statements => L_Body)); + if Is_Iterated_Component then + End_Scope; + end if; + -- A small optimization: if the aggregate is initialized with a box -- and the component type has no initialization procedure, remove the -- useless empty loop. diff --git a/gcc/ada/exp_attr.adb b/gcc/ada/exp_attr.adb index cc04351..e6d3e74 100644 --- a/gcc/ada/exp_attr.adb +++ b/gcc/ada/exp_attr.adb @@ -2543,6 +2543,28 @@ package body Exp_Attr is Analyze_And_Resolve (N, Addr); end; + -- 'Address is an actual parameter of the call to the implicit + -- subprogram To_Pointer instantiated with a class-wide interface + -- type; its expansion requires adding an implicit type conversion + -- to force displacement of the "this" pointer. + + elsif Tagged_Type_Expansion + and then Nkind (Parent (N)) = N_Function_Call + and then Nkind (Name (Parent (N))) in N_Has_Entity + and then Is_Intrinsic_Subprogram (Entity (Name (Parent (N)))) + and then Chars (Entity (Name (Parent (N)))) = Name_To_Pointer + and then Is_Interface (Designated_Type (Etype (Parent (N)))) + and then Is_Class_Wide_Type (Designated_Type (Etype (Parent (N)))) + then + declare + Iface_Typ : constant Entity_Id := + Designated_Type (Etype (Parent (N))); + begin + Rewrite (Pref, Convert_To (Iface_Typ, Relocate_Node (Pref))); + Analyze_And_Resolve (Pref, Iface_Typ); + return; + end; + -- Ada 2005 (AI-251): Class-wide interface objects are always -- "displaced" to reference the tag associated with the interface -- type. In order to obtain the real address of such objects we @@ -2554,9 +2576,9 @@ package body Exp_Attr is -- of nested subprograms), since the address needs to be assigned -- as-is to such components. - elsif Is_Class_Wide_Type (Ptyp) + elsif Tagged_Type_Expansion + and then Is_Class_Wide_Type (Ptyp) and then Is_Interface (Underlying_Type (Ptyp)) - and then Tagged_Type_Expansion and then not (Nkind (Pref) in N_Has_Entity and then Is_Subprogram (Entity (Pref))) and then not Is_Unnested_Component_Init (N) @@ -2564,8 +2586,7 @@ package body Exp_Attr is Rewrite (N, Make_Function_Call (Loc, Name => New_Occurrence_Of (RTE (RE_Base_Address), Loc), - Parameter_Associations => New_List ( - Relocate_Node (N)))); + Parameter_Associations => New_List (Relocate_Node (N)))); Analyze (N); return; end if; diff --git a/gcc/ada/exp_ch11.adb b/gcc/ada/exp_ch11.adb index 00b7745..1867469 100644 --- a/gcc/ada/exp_ch11.adb +++ b/gcc/ada/exp_ch11.adb @@ -41,7 +41,6 @@ with Restrict; use Restrict; with Rident; use Rident; with Rtsfind; use Rtsfind; with Sem; use Sem; -with Sem_Ch8; use Sem_Ch8; with Sem_Res; use Sem_Res; with Sem_Util; use Sem_Util; with Sinfo; use Sinfo; @@ -76,113 +75,18 @@ package body Exp_Ch11 is --------------------------- -- For a handled statement sequence that has a cleanup (At_End_Proc - -- field set), an exception handler of the following form is required: + -- field set), perform any needed expansion. - -- exception - -- when all others => - -- cleanup call - -- raise; - - -- Note: this exception handler is treated rather specially by - -- subsequent expansion in two respects: - - -- The normal call to Undefer_Abort is omitted - -- The raise call does not do Defer_Abort - - -- This is because the current tasking code seems to assume that - -- the call to the cleanup routine that is made from an exception - -- handler for the abort signal is called with aborts deferred. - - -- This expansion is only done if we have front end exception handling. - -- If we have back end exception handling, then the AT END handler is - -- left alone, and cleanups (including the exceptional case) are handled - -- by the back end. - - -- In the front end case, the exception handler described above handles - -- the exceptional case. The AT END handler is left in the generated tree - -- and the code generator (e.g. gigi) must still handle proper generation - -- of cleanup calls for the non-exceptional case. + -- Do nothing by default. We used to perform a special expansion for + -- front-end SJLJ, and we may want to customize this processing in + -- the future for new back-ends. procedure Expand_At_End_Handler (HSS : Node_Id; Blk_Id : Entity_Id) is - Clean : constant Entity_Id := Entity (At_End_Proc (HSS)); - Ohandle : Node_Id; - Stmnts : List_Id; - - Loc : constant Source_Ptr := No_Location; - -- Location used for expansion. We quite deliberately do not set a - -- specific source location for the expanded handler. This makes - -- sense since really the handler is not associated with specific - -- source. We used to set this to Sloc (Clean), but that caused - -- useless and annoying bouncing around of line numbers in the - -- debugger in some circumstances. - + pragma Unreferenced (Blk_Id); begin - pragma Assert (Present (Clean)); + pragma Assert (Present (Entity (At_End_Proc (HSS)))); pragma Assert (No (Exception_Handlers (HSS))); - - -- Back end exception schemes don't need explicit handlers to - -- trigger AT-END actions on exceptional paths. - - if Back_End_Exceptions then - return; - end if; - - -- Don't expand an At End handler if we have already had configurable - -- run-time violations, since likely this will just be a matter of - -- generating useless cascaded messages - - if Configurable_Run_Time_Violations > 0 then - return; - end if; - - -- Don't expand an At End handler if we are not allowing exceptions - -- or if exceptions are transformed into local gotos, and never - -- propagated (No_Exception_Propagation). - - if No_Exception_Handlers_Set then - return; - end if; - - if Present (Blk_Id) then - Push_Scope (Blk_Id); - end if; - - Ohandle := - Make_Others_Choice (Loc); - Set_All_Others (Ohandle); - - Stmnts := New_List ( - Make_Procedure_Call_Statement (Loc, - Name => New_Occurrence_Of (Clean, Loc))); - - -- Generate reraise statement as last statement of AT-END handler, - -- unless we are under control of No_Exception_Propagation, in which - -- case no exception propagation is possible anyway, so we do not need - -- a reraise (the AT END handler in this case is only for normal exits - -- not for exceptional exits). Also, we flag the Reraise statement as - -- being part of an AT END handler to prevent signalling this reraise - -- as a violation of the restriction when it is not set. - - if not Restriction_Active (No_Exception_Propagation) then - declare - Rstm : constant Node_Id := Make_Raise_Statement (Loc); - begin - Set_From_At_End (Rstm); - Append_To (Stmnts, Rstm); - end; - end if; - - Set_Exception_Handlers (HSS, New_List ( - Make_Implicit_Exception_Handler (Loc, - Exception_Choices => New_List (Ohandle), - Statements => Stmnts))); - - Analyze_List (Stmnts, Suppress => All_Checks); - Expand_Exception_Handlers (HSS); - - if Present (Blk_Id) then - Pop_Scope; - end if; + return; end Expand_At_End_Handler; ------------------------------- @@ -987,13 +891,11 @@ package body Exp_Ch11 is -- ... -- end; - -- This expansion is only performed when using front-end - -- exceptions. Gigi will insert a call to initialize the - -- choice parameter. + -- This expansion is only performed when using CodePeer. + -- Gigi will insert a call to initialize the choice parameter. if Present (Choice_Parameter (Handler)) - and then (Front_End_Exceptions - or else CodePeer_Mode) + and then CodePeer_Mode then declare Cparm : constant Entity_Id := Choice_Parameter (Handler); @@ -1717,9 +1619,7 @@ package body Exp_Ch11 is -- GNATprove all code with exceptions falls outside the subset of -- code which can be formally analyzed. - if not CodePeer_Mode - and then Back_End_Exceptions - then + if not CodePeer_Mode then return; end if; diff --git a/gcc/ada/exp_ch3.adb b/gcc/ada/exp_ch3.adb index c5ed468..d1b3388 100644 --- a/gcc/ada/exp_ch3.adb +++ b/gcc/ada/exp_ch3.adb @@ -184,6 +184,63 @@ package body Exp_Ch3 is -- Treat user-defined stream operations as renaming_as_body if the -- subprogram they rename is not frozen when the type is frozen. + package Initialization_Control is + + function Requires_Late_Init + (Decl : Node_Id; Rec_Type : Entity_Id) return Boolean; + -- Return True iff the given component declaration requires late + -- initialization, as defined by 3.3.1 (8.1/5). + + function Has_Late_Init_Component + (Tagged_Rec_Type : Entity_Id) return Boolean; + -- Return True iff the given tagged record type has at least one + -- component that requires late initialization; this includes + -- components of ancestor types. + + type Initialization_Mode is + (Full_Init, Full_Init_Except_Tag, Early_Init_Only, Late_Init_Only); + -- The initialization routine for a tagged type is passed in a + -- formal parameter of this type, indicating what initialization + -- is to be performed. This parameter defaults to Full_Init in all + -- cases except when the init proc of a type extension (let's call + -- that type T2) calls the init proc of its parent (let's call that + -- type T1). In that case, one of the other 3 values will + -- be passed in. In all three of those cases, the Tag component has + -- already been initialized before the call and is therefore not to be + -- modified. T2's init proc will either call T1's init proc + -- once (with Full_Init_Except_Tag as the parameter value) or twice + -- (first with Early_Init_Only, then later with Late_Init_Only), + -- depending on the result returned by Has_Late_Init_Component (T1). + -- In the latter case, the first call does not initialize any + -- components that require late initialization and the second call + -- then performs that deferred initialization. + -- Strictly speaking, the formal parameter subtype is actually Natural + -- but calls will only pass in values corresponding to literals + -- of this enumeration type. + + function Make_Mode_Literal + (Loc : Source_Ptr; Mode : Initialization_Mode) return Node_Id + is (Make_Integer_Literal (Loc, Initialization_Mode'Pos (Mode))); + -- Generate an integer literal for a given mode value. + + function Tag_Init_Condition + (Loc : Source_Ptr; + Init_Control_Formal : Entity_Id) return Node_Id; + function Early_Init_Condition + (Loc : Source_Ptr; + Init_Control_Formal : Entity_Id) return Node_Id; + function Late_Init_Condition + (Loc : Source_Ptr; + Init_Control_Formal : Entity_Id) return Node_Id; + -- These three functions each return a Boolean expression that + -- can be used to determine whether a given call to the initialization + -- expression for a tagged type should initialize (respectively) + -- the Tag component, the non-Tag components that do not require late + -- initialization, and the components that do require late + -- initialization. + + end Initialization_Control; + procedure Initialization_Warning (E : Entity_Id); -- If static elaboration of the package is requested, indicate -- when a type does meet the conditions for static initialization. If @@ -1447,14 +1504,15 @@ package body Exp_Ch3 is -- end; function Build_Initialization_Call - (Loc : Source_Ptr; - Id_Ref : Node_Id; - Typ : Entity_Id; - In_Init_Proc : Boolean := False; - Enclos_Type : Entity_Id := Empty; - Discr_Map : Elist_Id := New_Elmt_List; - With_Default_Init : Boolean := False; - Constructor_Ref : Node_Id := Empty) return List_Id + (Loc : Source_Ptr; + Id_Ref : Node_Id; + Typ : Entity_Id; + In_Init_Proc : Boolean := False; + Enclos_Type : Entity_Id := Empty; + Discr_Map : Elist_Id := New_Elmt_List; + With_Default_Init : Boolean := False; + Constructor_Ref : Node_Id := Empty; + Init_Control_Actual : Entity_Id := Empty) return List_Id is Res : constant List_Id := New_List; @@ -1838,14 +1896,26 @@ package body Exp_Ch3 is -- If this is a call to initialize the parent component of a derived -- tagged type, indicate that the tag should not be set in the parent. + -- This is done via the actual parameter value for the Init_Control + -- formal parameter, which is also used to deal with late initialization + -- requirements. + -- + -- We pass in Full_Init_Except_Tag unless the caller tells us to do + -- otherwise (by passing in a nonempty Init_Control_Actual parameter). if Is_Tagged_Type (Full_Init_Type) and then not Is_CPP_Class (Full_Init_Type) and then Nkind (Id_Ref) = N_Selected_Component and then Chars (Selector_Name (Id_Ref)) = Name_uParent then - Append_To (Args, New_Occurrence_Of (Standard_False, Loc)); - + declare + use Initialization_Control; + begin + Append_To (Args, + (if Present (Init_Control_Actual) + then Init_Control_Actual + else Make_Mode_Literal (Loc, Full_Init_Except_Tag))); + end; elsif Present (Constructor_Ref) then Append_List_To (Args, New_Copy_List (Parameter_Associations (Constructor_Ref))); @@ -1906,8 +1976,9 @@ package body Exp_Ch3 is Counter : Nat := 0; Proc_Id : Entity_Id; Rec_Type : Entity_Id; - Set_Tag : Entity_Id := Empty; - Has_Late_Init_Comp : Boolean := False; -- set in Build_Init_Statements + + Init_Control_Formal : Entity_Id := Empty; -- set in Build_Init_Statements + Has_Late_Init_Comp : Boolean := False; -- set in Build_Init_Statements function Build_Assignment (Id : Entity_Id; @@ -2532,6 +2603,7 @@ package body Exp_Ch3 is Proc_Spec_Node : Node_Id; Record_Extension_Node : Node_Id; + use Initialization_Control; begin Body_Stmts := New_List; Body_Node := New_Node (N_Subprogram_Body, Loc); @@ -2544,21 +2616,27 @@ package body Exp_Ch3 is Append_List_To (Parameters, Build_Discriminant_Formals (Rec_Type, True)); - -- For tagged types, we add a flag to indicate whether the routine - -- is called to initialize a parent component in the init_proc of - -- a type extension. If the flag is false, we do not set the tag - -- because it has been set already in the extension. + -- For tagged types, we add a parameter to indicate what + -- portion of the object's initialization is to be performed. + -- This is used for two purposes: + -- 1) When a type extension's initialization procedure calls + -- the initialization procedure of the parent type, we do + -- not want the parent to initialize the Tag component; + -- it has been set already. + -- 2) If an ancestor type has at least one component that requires + -- late initialization, then we need to be able to initialize + -- those components separately after initializing any other + -- components. if Is_Tagged_Type (Rec_Type) then - Set_Tag := Make_Temporary (Loc, 'P'); + Init_Control_Formal := Make_Temporary (Loc, 'P'); Append_To (Parameters, Make_Parameter_Specification (Loc, - Defining_Identifier => Set_Tag, + Defining_Identifier => Init_Control_Formal, Parameter_Type => - New_Occurrence_Of (Standard_Boolean, Loc), - Expression => - New_Occurrence_Of (Standard_True, Loc))); + New_Occurrence_Of (Standard_Natural, Loc), + Expression => Make_Mode_Literal (Loc, Full_Init))); end if; -- Create an extra accessibility parameter to capture the level of @@ -2622,22 +2700,45 @@ package body Exp_Ch3 is declare Parent_IP : constant Name_Id := Make_Init_Proc_Name (Etype (Rec_Ent)); - Stmt : Node_Id; - IP_Call : Node_Id; - IP_Stmts : List_Id; - + Stmt : Node_Id := First (Stmts); + IP_Call : Node_Id := Empty; begin - -- Look for a call to the parent IP at the beginning - -- of Stmts associated with the record extension + -- Look for a call to the parent IP associated with + -- the record extension. + -- The call will be inside not one but two + -- if-statements (with the same condition). Testing + -- the same Early_Init condition twice might seem + -- redundant. However, as soon as we exit this loop, + -- we are going to hoist the inner if-statement out + -- of the outer one; the "redundant" test was built + -- in anticipation of this hoisting. - Stmt := First (Stmts); - IP_Call := Empty; while Present (Stmt) loop - if Nkind (Stmt) = N_Procedure_Call_Statement - and then Chars (Name (Stmt)) = Parent_IP - then - IP_Call := Stmt; - exit; + if Nkind (Stmt) = N_If_Statement then + declare + Then_Stmt1 : Node_Id := + First (Then_Statements (Stmt)); + Then_Stmt2 : Node_Id; + begin + while Present (Then_Stmt1) loop + if Nkind (Then_Stmt1) = N_If_Statement then + Then_Stmt2 := + First (Then_Statements (Then_Stmt1)); + + if Nkind (Then_Stmt2) = + N_Procedure_Call_Statement + and then Chars (Name (Then_Stmt2)) = + Parent_IP + then + -- IP_Call is a call wrapped in an + -- if statement. + IP_Call := Then_Stmt1; + exit; + end if; + end if; + Next (Then_Stmt1); + end loop; + end; end if; Next (Stmt); @@ -2647,14 +2748,8 @@ package body Exp_Ch3 is -- statements of this IP routine if Present (IP_Call) then - IP_Stmts := New_List; - loop - Stmt := Remove_Head (Stmts); - Append_To (IP_Stmts, Stmt); - exit when Stmt = IP_Call; - end loop; - - Prepend_List_To (Body_Stmts, IP_Stmts); + Remove (IP_Call); + Prepend_List_To (Body_Stmts, New_List (IP_Call)); end if; end; end if; @@ -2729,7 +2824,8 @@ package body Exp_Ch3 is Elab_List := New_List ( Make_If_Statement (Loc, - Condition => New_Occurrence_Of (Set_Tag, Loc), + Condition => + Tag_Init_Condition (Loc, Init_Control_Formal), Then_Statements => Init_Tags_List)); if Elab_Flag_Needed (Rec_Type) then @@ -2755,7 +2851,8 @@ package body Exp_Ch3 is else Prepend_To (Body_Stmts, Make_If_Statement (Loc, - Condition => New_Occurrence_Of (Set_Tag, Loc), + Condition => + Tag_Init_Condition (Loc, Init_Control_Formal), Then_Statements => Init_Tags_List)); end if; @@ -2823,11 +2920,18 @@ package body Exp_Ch3 is begin -- Search for the call to the IP of the parent. We assume -- that the first init_proc call is for the parent. + -- It is wrapped in an "if Early_Init_Condition" + -- if-statement. Ins_Nod := First (Body_Stmts); while Present (Next (Ins_Nod)) - and then (Nkind (Ins_Nod) /= N_Procedure_Call_Statement - or else not Is_Init_Proc (Name (Ins_Nod))) + and then + (Nkind (Ins_Nod) /= N_If_Statement + or else (Nkind (First (Then_Statements (Ins_Nod))) + /= N_Procedure_Call_Statement) + or else not Is_Init_Proc + (Name (First (Then_Statements + (Ins_Nod))))) loop Next (Ins_Nod); end loop; @@ -2974,34 +3078,31 @@ package body Exp_Ch3 is Decl : Node_Id; Id : Entity_Id; Parent_Stmts : List_Id; - Stmts : List_Id; + Parent_Id : Entity_Id := Empty; + Stmts, Late_Stmts : List_Id := Empty_List; Typ : Entity_Id; - procedure Increment_Counter (Loc : Source_Ptr); + procedure Increment_Counter + (Loc : Source_Ptr; Late : Boolean := False); -- Generate an "increment by one" statement for the current counter - -- and append it to the list Stmts. + -- and append it to the appropriate statement list. procedure Make_Counter (Loc : Source_Ptr); -- Create a new counter for the current component list. The routine -- creates a new defining Id, adds an object declaration and sets -- the Id generator for the next variant. - function Requires_Late_Initialization - (Decl : Node_Id; - Rec_Type : Entity_Id) return Boolean; - -- Return whether the given Decl requires late initialization, as - -- defined by 3.3.1 (8.1/5). - ----------------------- -- Increment_Counter -- ----------------------- - procedure Increment_Counter (Loc : Source_Ptr) is + procedure Increment_Counter + (Loc : Source_Ptr; Late : Boolean := False) is begin -- Generate: -- Counter := Counter + 1; - Append_To (Stmts, + Append_To ((if Late then Late_Stmts else Stmts), Make_Assignment_Statement (Loc, Name => New_Occurrence_Of (Counter_Id, Loc), Expression => @@ -3038,157 +3139,6 @@ package body Exp_Ch3 is Make_Integer_Literal (Loc, 0))); end Make_Counter; - ---------------------------------- - -- Requires_Late_Initialization -- - ---------------------------------- - - function Requires_Late_Initialization - (Decl : Node_Id; - Rec_Type : Entity_Id) return Boolean - is - References_Current_Instance : Boolean := False; - Has_Access_Discriminant : Boolean := False; - Has_Internal_Call : Boolean := False; - - function Find_Access_Discriminant - (N : Node_Id) return Traverse_Result; - -- Look for a name denoting an access discriminant - - function Find_Current_Instance - (N : Node_Id) return Traverse_Result; - -- Look for a reference to the current instance of the type - - function Find_Internal_Call - (N : Node_Id) return Traverse_Result; - -- Look for an internal protected function call - - ------------------------------ - -- Find_Access_Discriminant -- - ------------------------------ - - function Find_Access_Discriminant - (N : Node_Id) return Traverse_Result is - begin - if Is_Entity_Name (N) - and then Denotes_Discriminant (N) - and then Is_Access_Type (Etype (N)) - then - Has_Access_Discriminant := True; - return Abandon; - else - return OK; - end if; - end Find_Access_Discriminant; - - --------------------------- - -- Find_Current_Instance -- - --------------------------- - - function Find_Current_Instance - (N : Node_Id) return Traverse_Result is - begin - if Is_Entity_Name (N) - and then Present (Entity (N)) - and then Is_Current_Instance (N) - then - References_Current_Instance := True; - return Abandon; - else - return OK; - end if; - end Find_Current_Instance; - - ------------------------ - -- Find_Internal_Call -- - ------------------------ - - function Find_Internal_Call (N : Node_Id) return Traverse_Result is - - function Call_Scope (N : Node_Id) return Entity_Id; - -- Return the scope enclosing a given call node N - - ---------------- - -- Call_Scope -- - ---------------- - - function Call_Scope (N : Node_Id) return Entity_Id is - Nam : constant Node_Id := Name (N); - begin - if Nkind (Nam) = N_Selected_Component then - return Scope (Entity (Prefix (Nam))); - else - return Scope (Entity (Nam)); - end if; - end Call_Scope; - - begin - if Nkind (N) = N_Function_Call - and then Call_Scope (N) - = Corresponding_Concurrent_Type (Rec_Type) - then - Has_Internal_Call := True; - return Abandon; - else - return OK; - end if; - end Find_Internal_Call; - - procedure Search_Access_Discriminant is new - Traverse_Proc (Find_Access_Discriminant); - - procedure Search_Current_Instance is new - Traverse_Proc (Find_Current_Instance); - - procedure Search_Internal_Call is new - Traverse_Proc (Find_Internal_Call); - - begin - -- A component of an object is said to require late initialization - -- if: - - -- it has an access discriminant value constrained by a per-object - -- expression; - - if Has_Access_Constraint (Defining_Identifier (Decl)) - and then No (Expression (Decl)) - then - return True; - - elsif Present (Expression (Decl)) then - - -- it has an initialization expression that includes a name - -- denoting an access discriminant; - - Search_Access_Discriminant (Expression (Decl)); - - if Has_Access_Discriminant then - return True; - end if; - - -- or it has an initialization expression that includes a - -- reference to the current instance of the type either by - -- name... - - Search_Current_Instance (Expression (Decl)); - - if References_Current_Instance then - return True; - end if; - - -- ...or implicitly as the target object of a call. - - if Is_Protected_Record_Type (Rec_Type) then - Search_Internal_Call (Expression (Decl)); - - if Has_Internal_Call then - return True; - end if; - end if; - end if; - - return False; - end Requires_Late_Initialization; - -- Start of processing for Build_Init_Statements begin @@ -3256,7 +3206,10 @@ package body Exp_Ch3 is -- Leave any processing of component requiring late initialization -- for the second pass. - if Requires_Late_Initialization (Decl, Rec_Type) then + if Initialization_Control.Requires_Late_Init (Decl, Rec_Type) then + if not Has_Late_Init_Comp then + Late_Stmts := New_List; + end if; Has_Late_Init_Comp := True; -- Regular component cases @@ -3403,17 +3356,56 @@ package body Exp_Ch3 is elsif not Is_Interface (Typ) and then Has_Non_Null_Base_Init_Proc (Typ) then - Actions := - Build_Initialization_Call - (Comp_Loc, - Make_Selected_Component (Comp_Loc, - Prefix => - Make_Identifier (Comp_Loc, Name_uInit), - Selector_Name => New_Occurrence_Of (Id, Comp_Loc)), - Typ, - In_Init_Proc => True, - Enclos_Type => Rec_Type, - Discr_Map => Discr_Map); + declare + use Initialization_Control; + Init_Control_Actual : Node_Id := Empty; + Is_Parent : constant Boolean := Chars (Id) = Name_uParent; + Init_Call_Stmts : List_Id; + begin + if Is_Parent and then Has_Late_Init_Component (Etype (Id)) + then + Init_Control_Actual := + Make_Mode_Literal (Comp_Loc, Early_Init_Only); + -- Parent_Id used later in second call to parent's + -- init proc to initialize late-init components. + Parent_Id := Id; + end if; + + Init_Call_Stmts := + Build_Initialization_Call + (Comp_Loc, + Make_Selected_Component (Comp_Loc, + Prefix => + Make_Identifier (Comp_Loc, Name_uInit), + Selector_Name => New_Occurrence_Of (Id, Comp_Loc)), + Typ, + In_Init_Proc => True, + Enclos_Type => Rec_Type, + Discr_Map => Discr_Map, + Init_Control_Actual => Init_Control_Actual); + + if Is_Parent then + -- This is tricky. At first it looks like + -- we are going to end up with nested + -- if-statements with the same condition: + -- if Early_Init_Condition then + -- if Early_Init_Condition then + -- Parent_TypeIP (...); + -- end if; + -- end if; + -- But later we will hoist the inner if-statement + -- out of the outer one; we do this because the + -- init-proc call for the _Parent component of a type + -- extension has to precede any other initialization. + Actions := + New_List (Make_If_Statement (Loc, + Condition => + Early_Init_Condition (Loc, Init_Control_Formal), + Then_Statements => Init_Call_Stmts)); + else + Actions := Init_Call_Stmts; + end if; + end; Clean_Task_Names (Typ, Proc_Id); @@ -3443,7 +3435,7 @@ package body Exp_Ch3 is -- DIC here. if Has_DIC (Typ) - and then not Present (Expression (Decl)) + and then No (Expression (Decl)) and then Present (DIC_Procedure (Typ)) and then not Has_Null_Body (DIC_Procedure (Typ)) @@ -3481,7 +3473,6 @@ package body Exp_Ch3 is if Present (Actions) then if Chars (Id) = Name_uParent then Append_List_To (Parent_Stmts, Actions); - else Append_List_To (Stmts, Actions); @@ -3595,6 +3586,34 @@ package body Exp_Ch3 is -- Second pass: components that require late initialization + if Present (Parent_Id) then + declare + Parent_Loc : constant Source_Ptr := Sloc (Parent (Parent_Id)); + use Initialization_Control; + begin + -- We are building the init proc for a type extension. + -- Call the parent type's init proc a second time, this + -- time to initialize the parent's components that require + -- late initialization. + + Append_List_To (Late_Stmts, + Build_Initialization_Call + (Loc => Parent_Loc, + Id_Ref => + Make_Selected_Component (Parent_Loc, + Prefix => Make_Identifier + (Parent_Loc, Name_uInit), + Selector_Name => New_Occurrence_Of (Parent_Id, + Parent_Loc)), + Typ => Etype (Parent_Id), + In_Init_Proc => True, + Enclos_Type => Rec_Type, + Discr_Map => Discr_Map, + Init_Control_Actual => Make_Mode_Literal + (Parent_Loc, Late_Init_Only))); + end; + end if; + if Has_Late_Init_Comp then Decl := First_Non_Pragma (Component_Items (Comp_List)); while Present (Decl) loop @@ -3602,13 +3621,14 @@ package body Exp_Ch3 is Id := Defining_Identifier (Decl); Typ := Etype (Id); - if Requires_Late_Initialization (Decl, Rec_Type) then + if Initialization_Control.Requires_Late_Init (Decl, Rec_Type) + then if Present (Expression (Decl)) then - Append_List_To (Stmts, + Append_List_To (Late_Stmts, Build_Assignment (Id, Expression (Decl))); elsif Has_Non_Null_Base_Init_Proc (Typ) then - Append_List_To (Stmts, + Append_List_To (Late_Stmts, Build_Initialization_Call (Comp_Loc, Make_Selected_Component (Comp_Loc, Prefix => @@ -3628,10 +3648,10 @@ package body Exp_Ch3 is Make_Counter (Comp_Loc); end if; - Increment_Counter (Comp_Loc); + Increment_Counter (Comp_Loc, Late => True); end if; elsif Component_Needs_Simple_Initialization (Typ) then - Append_List_To (Stmts, + Append_List_To (Late_Stmts, Build_Assignment (Id => Id, Default => @@ -3646,7 +3666,8 @@ package body Exp_Ch3 is end loop; end if; - -- Process the variant part + -- Process the variant part (incorrectly ignoring late + -- initialization requirements for components therein). if Present (Variant_Part (Comp_List)) then declare @@ -3681,16 +3702,42 @@ package body Exp_Ch3 is end; end if; - -- If no initializations when generated for component declarations - -- corresponding to this Stmts, append a null statement to Stmts to - -- to make it a valid Ada tree. + if No (Init_Control_Formal) then + Append_List_To (Stmts, Late_Stmts); - if Is_Empty_List (Stmts) then - Append (Make_Null_Statement (Loc), Stmts); - end if; + -- If no initializations were generated for component declarations + -- and included in Stmts, then append a null statement to Stmts + -- to make it a valid Ada tree. - return Stmts; + if Is_Empty_List (Stmts) then + Append (Make_Null_Statement (Loc), Stmts); + end if; + return Stmts; + else + declare + use Initialization_Control; + + If_Early : constant Node_Id := + (if Is_Empty_List (Stmts) then + Make_Null_Statement (Loc) + else + Make_If_Statement (Loc, + Condition => + Early_Init_Condition (Loc, Init_Control_Formal), + Then_Statements => Stmts)); + If_Late : constant Node_Id := + (if Is_Empty_List (Late_Stmts) then + Make_Null_Statement (Loc) + else + Make_If_Statement (Loc, + Condition => + Late_Init_Condition (Loc, Init_Control_Formal), + Then_Statements => Late_Stmts)); + begin + return New_List (If_Early, If_Late); + end; + end if; exception when RE_Not_Available => return Empty_List; @@ -9048,6 +9095,230 @@ package body Exp_Ch3 is return Is_RTU (S1, System) or else Is_RTU (S1, Ada); end In_Runtime; + package body Initialization_Control is + + ------------------------ + -- Requires_Late_Init -- + ------------------------ + + function Requires_Late_Init + (Decl : Node_Id; + Rec_Type : Entity_Id) return Boolean + is + References_Current_Instance : Boolean := False; + Has_Access_Discriminant : Boolean := False; + Has_Internal_Call : Boolean := False; + + function Find_Access_Discriminant + (N : Node_Id) return Traverse_Result; + -- Look for a name denoting an access discriminant + + function Find_Current_Instance + (N : Node_Id) return Traverse_Result; + -- Look for a reference to the current instance of the type + + function Find_Internal_Call + (N : Node_Id) return Traverse_Result; + -- Look for an internal protected function call + + ------------------------------ + -- Find_Access_Discriminant -- + ------------------------------ + + function Find_Access_Discriminant + (N : Node_Id) return Traverse_Result is + begin + if Is_Entity_Name (N) + and then Denotes_Discriminant (N) + and then Is_Access_Type (Etype (N)) + then + Has_Access_Discriminant := True; + return Abandon; + else + return OK; + end if; + end Find_Access_Discriminant; + + --------------------------- + -- Find_Current_Instance -- + --------------------------- + + function Find_Current_Instance + (N : Node_Id) return Traverse_Result is + begin + if Is_Entity_Name (N) + and then Present (Entity (N)) + and then Is_Current_Instance (N) + then + References_Current_Instance := True; + return Abandon; + else + return OK; + end if; + end Find_Current_Instance; + + ------------------------ + -- Find_Internal_Call -- + ------------------------ + + function Find_Internal_Call (N : Node_Id) return Traverse_Result is + + function Call_Scope (N : Node_Id) return Entity_Id; + -- Return the scope enclosing a given call node N + + ---------------- + -- Call_Scope -- + ---------------- + + function Call_Scope (N : Node_Id) return Entity_Id is + Nam : constant Node_Id := Name (N); + begin + if Nkind (Nam) = N_Selected_Component then + return Scope (Entity (Prefix (Nam))); + else + return Scope (Entity (Nam)); + end if; + end Call_Scope; + + begin + if Nkind (N) = N_Function_Call + and then Call_Scope (N) + = Corresponding_Concurrent_Type (Rec_Type) + then + Has_Internal_Call := True; + return Abandon; + else + return OK; + end if; + end Find_Internal_Call; + + procedure Search_Access_Discriminant is new + Traverse_Proc (Find_Access_Discriminant); + + procedure Search_Current_Instance is new + Traverse_Proc (Find_Current_Instance); + + procedure Search_Internal_Call is new + Traverse_Proc (Find_Internal_Call); + + -- Start of processing for Requires_Late_Init + + begin + -- A component of an object is said to require late initialization + -- if: + + -- it has an access discriminant value constrained by a per-object + -- expression; + + if Has_Access_Constraint (Defining_Identifier (Decl)) + and then No (Expression (Decl)) + then + return True; + + elsif Present (Expression (Decl)) then + + -- it has an initialization expression that includes a name + -- denoting an access discriminant; + + Search_Access_Discriminant (Expression (Decl)); + + if Has_Access_Discriminant then + return True; + end if; + + -- or it has an initialization expression that includes a + -- reference to the current instance of the type either by + -- name... + + Search_Current_Instance (Expression (Decl)); + + if References_Current_Instance then + return True; + end if; + + -- ...or implicitly as the target object of a call. + + if Is_Protected_Record_Type (Rec_Type) then + Search_Internal_Call (Expression (Decl)); + + if Has_Internal_Call then + return True; + end if; + end if; + end if; + + return False; + end Requires_Late_Init; + + ----------------------------- + -- Has_Late_Init_Component -- + ----------------------------- + + function Has_Late_Init_Component + (Tagged_Rec_Type : Entity_Id) return Boolean + is + Comp_Id : Entity_Id := + First_Component (Implementation_Base_Type (Tagged_Rec_Type)); + begin + while Present (Comp_Id) loop + if Requires_Late_Init (Decl => Parent (Comp_Id), + Rec_Type => Tagged_Rec_Type) + then + return True; -- found a component that requires late init + + elsif Chars (Comp_Id) = Name_uParent + and then Has_Late_Init_Component (Etype (Comp_Id)) + then + return True; -- an ancestor type has a late init component + end if; + + Next_Component (Comp_Id); + end loop; + + return False; + end Has_Late_Init_Component; + + ------------------------ + -- Tag_Init_Condition -- + ------------------------ + + function Tag_Init_Condition + (Loc : Source_Ptr; + Init_Control_Formal : Entity_Id) return Node_Id is + begin + return Make_Op_Eq (Loc, + New_Occurrence_Of (Init_Control_Formal, Loc), + Make_Mode_Literal (Loc, Full_Init)); + end Tag_Init_Condition; + + -------------------------- + -- Early_Init_Condition -- + -------------------------- + + function Early_Init_Condition + (Loc : Source_Ptr; + Init_Control_Formal : Entity_Id) return Node_Id is + begin + return Make_Op_Ne (Loc, + New_Occurrence_Of (Init_Control_Formal, Loc), + Make_Mode_Literal (Loc, Late_Init_Only)); + end Early_Init_Condition; + + ------------------------- + -- Late_Init_Condition -- + ------------------------- + + function Late_Init_Condition + (Loc : Source_Ptr; + Init_Control_Formal : Entity_Id) return Node_Id is + begin + return Make_Op_Ne (Loc, + New_Occurrence_Of (Init_Control_Formal, Loc), + Make_Mode_Literal (Loc, Early_Init_Only)); + end Late_Init_Condition; + + end Initialization_Control; + ---------------------------- -- Initialization_Warning -- ---------------------------- diff --git a/gcc/ada/exp_ch3.ads b/gcc/ada/exp_ch3.ads index 8b2c306..23fecfd 100644 --- a/gcc/ada/exp_ch3.ads +++ b/gcc/ada/exp_ch3.ads @@ -62,14 +62,15 @@ package Exp_Ch3 is -- and the discriminant checking functions are inserted after this node. function Build_Initialization_Call - (Loc : Source_Ptr; - Id_Ref : Node_Id; - Typ : Entity_Id; - In_Init_Proc : Boolean := False; - Enclos_Type : Entity_Id := Empty; - Discr_Map : Elist_Id := New_Elmt_List; - With_Default_Init : Boolean := False; - Constructor_Ref : Node_Id := Empty) return List_Id; + (Loc : Source_Ptr; + Id_Ref : Node_Id; + Typ : Entity_Id; + In_Init_Proc : Boolean := False; + Enclos_Type : Entity_Id := Empty; + Discr_Map : Elist_Id := New_Elmt_List; + With_Default_Init : Boolean := False; + Constructor_Ref : Node_Id := Empty; + Init_Control_Actual : Entity_Id := Empty) return List_Id; -- Builds a call to the initialization procedure for the base type of Typ, -- passing it the object denoted by Id_Ref, plus additional parameters as -- appropriate for the type (the _Master, for task types, for example). @@ -93,6 +94,12 @@ package Exp_Ch3 is -- -- Constructor_Ref is a call to a constructor subprogram. It is currently -- used only to support C++ constructors. + -- + -- Init_Control_Actual is Empty except in the case where the init proc + -- for a tagged type calls the init proc for its parent type in order + -- to initialize its _Parent component. In that case, it is the + -- actual parameter value corresponding to the Init_Control formal + -- parameter to be used in the call of the parent type's init proc. function Build_Variant_Record_Equality (Typ : Entity_Id; diff --git a/gcc/ada/exp_ch9.adb b/gcc/ada/exp_ch9.adb index 04a87fb..f706780 100644 --- a/gcc/ada/exp_ch9.adb +++ b/gcc/ada/exp_ch9.adb @@ -3707,7 +3707,8 @@ package body Exp_Ch9 is Analyze_Statements (Bod_Stmts); - Set_Scope (Entity (Identifier (First (Bod_Stmts))), Bod_Id); + Set_Scope (Entity (Identifier (First (Bod_Stmts))), + Protected_Body_Subprogram (Ent)); Reset_Scopes_To (First (Bod_Stmts), Entity (Identifier (First (Bod_Stmts)))); diff --git a/gcc/ada/exp_prag.adb b/gcc/ada/exp_prag.adb index 70b16c8..27ea708 100644 --- a/gcc/ada/exp_prag.adb +++ b/gcc/ada/exp_prag.adb @@ -605,14 +605,14 @@ package body Exp_Prag is Get_Name_String (Chars (External)); end if; - Set_All_Upper_Case; + Set_Casing (All_Upper_Case); Psect := Make_String_Literal (Eloc, Strval => String_From_Name_Buffer); else Get_Name_String (Chars (Internal)); - Set_All_Upper_Case; + Set_Casing (All_Upper_Case); Psect := Make_String_Literal (Iloc, Strval => String_From_Name_Buffer); end if; diff --git a/gcc/ada/exp_util.adb b/gcc/ada/exp_util.adb index 795c1b0..4198cea 100644 --- a/gcc/ada/exp_util.adb +++ b/gcc/ada/exp_util.adb @@ -328,6 +328,72 @@ package body Exp_Util is ---------------------- procedure Adjust_Condition (N : Node_Id) is + + function Is_Hardbool_Type (T : Entity_Id) return Boolean; + -- Return True iff T is a type annotated with the + -- Machine_Attribute pragma "hardbool". + + ---------------------- + -- Is_Hardbool_Type -- + ---------------------- + + function Is_Hardbool_Type (T : Entity_Id) return Boolean is + + function Find_Hardbool_Pragma + (Id : Entity_Id) return Node_Id; + -- Return a Rep_Item associated with entity Id that + -- corresponds to the Hardbool Machine_Attribute pragma, if + -- any, or Empty otherwise. + + function Pragma_Arg_To_String (Item : Node_Id) return String is + (To_String (Strval (Expr_Value_S (Item)))); + -- Return the pragma argument Item as a String + + function Hardbool_Pragma_P (Item : Node_Id) return Boolean is + (Nkind (Item) = N_Pragma + and then + Pragma_Name (Item) = Name_Machine_Attribute + and then + Pragma_Arg_To_String + (Get_Pragma_Arg + (Next (First (Pragma_Argument_Associations (Item))))) + = "hardbool"); + -- Return True iff representation Item is a "hardbool" + -- Machine_Attribute pragma. + + -------------------------- + -- Find_Hardbool_Pragma -- + -------------------------- + + function Find_Hardbool_Pragma + (Id : Entity_Id) return Node_Id + is + Item : Node_Id; + + begin + if not Has_Gigi_Rep_Item (Id) then + return Empty; + end if; + + Item := First_Rep_Item (Id); + while Present (Item) loop + if Hardbool_Pragma_P (Item) then + return Item; + end if; + Item := Next_Rep_Item (Item); + end loop; + + return Empty; + end Find_Hardbool_Pragma; + + -- Start of processing for Is_Hardbool_Type + + begin + return Present (Find_Hardbool_Pragma (T)); + end Is_Hardbool_Type; + + -- Start of processing for Adjust_Condition + begin if No (N) then return; @@ -347,7 +413,10 @@ package body Exp_Util is -- Apply validity checking if needed - if Validity_Checks_On and Validity_Check_Tests then + if Validity_Checks_On + and then + (Validity_Check_Tests or else Is_Hardbool_Type (T)) + then Ensure_Valid (N); end if; @@ -4308,6 +4377,12 @@ package body Exp_Util is and then Nkind (Expression (Parent (Id_Ref))) = N_Allocator; + Component_Suffix_Index : constant Int := + (if In_Init_Proc then -1 else 0); + -- If an init proc calls Build_Task_Image_Decls twice for its + -- _Parent component (to split early/late initialization), we don't + -- want two decls with the same name. Hence, the -1 suffix. + begin -- If Discard_Names or No_Implicit_Heap_Allocations are in effect, -- generate a dummy declaration only. @@ -4349,7 +4424,8 @@ package body Exp_Util is elsif Nkind (Id_Ref) = N_Selected_Component then T_Id := Make_Defining_Identifier (Loc, - New_External_Name (Chars (Selector_Name (Id_Ref)), 'T')); + New_External_Name (Chars (Selector_Name (Id_Ref)), 'T', + Suffix_Index => Component_Suffix_Index)); Fun := Build_Task_Record_Image (Loc, Id_Ref, Is_Dyn); elsif Nkind (Id_Ref) = N_Indexed_Component then @@ -6630,7 +6706,7 @@ package body Exp_Util is -- Generates the entity name in upper case Get_Decoded_Name_String (Chars (Ent)); - Set_All_Upper_Case; + Set_Casing (All_Upper_Case); Store_String_Chars (Name_Buffer (1 .. Name_Len)); return; end Internal_Full_Qualified_Name; @@ -7476,7 +7552,7 @@ package body Exp_Util is when N_Elsif_Part | N_Iteration_Scheme => - if N = Condition (P) then + if Present (Condition (P)) and then N = Condition (P) then if Present (Condition_Actions (P)) then Insert_List_After_And_Analyze (Last (Condition_Actions (P)), Ins_Actions); diff --git a/gcc/ada/fe.h b/gcc/ada/fe.h index 4bdc023..dc3a1af 100644 --- a/gcc/ada/fe.h +++ b/gcc/ada/fe.h @@ -219,7 +219,7 @@ typedef enum { } Ada_Version_Type; typedef enum { - Front_End_SJLJ, Back_End_ZCX, Back_End_SJLJ + Back_End_ZCX, Back_End_SJLJ } Exception_Mechanism_Type; extern Ada_Version_Type Ada_Version; @@ -238,13 +238,9 @@ extern Boolean Suppress_Checks; #define ZCX_Exceptions opt__zcx_exceptions #define SJLJ_Exceptions opt__sjlj_exceptions -#define Front_End_Exceptions opt__front_end_exceptions -#define Back_End_Exceptions opt__back_end_exceptions extern Boolean ZCX_Exceptions (void); extern Boolean SJLJ_Exceptions (void); -extern Boolean Front_End_Exceptions (void); -extern Boolean Back_End_Exceptions (void); /* restrict: */ diff --git a/gcc/ada/fmap.adb b/gcc/ada/fmap.adb index afa9ee4..0fa4649 100644 --- a/gcc/ada/fmap.adb +++ b/gcc/ada/fmap.adb @@ -34,8 +34,6 @@ pragma Warnings (Off); with System.OS_Lib; use System.OS_Lib; pragma Warnings (On); -with Unchecked_Conversion; - with GNAT.HTable; package body Fmap is diff --git a/gcc/ada/fname-sf.adb b/gcc/ada/fname-sf.adb index 39ce267..bb72b30 100644 --- a/gcc/ada/fname-sf.adb +++ b/gcc/ada/fname-sf.adb @@ -30,8 +30,6 @@ with Osint; use Osint; with Types; use Types; with System.OS_Lib; use System.OS_Lib; -with Unchecked_Conversion; - package body Fname.SF is ---------------------- diff --git a/gcc/ada/freeze.adb b/gcc/ada/freeze.adb index 25bad46..7d90f51 100644 --- a/gcc/ada/freeze.adb +++ b/gcc/ada/freeze.adb @@ -1741,17 +1741,6 @@ package body Freeze is (Nkind (Parent (N)) /= N_Attribute_Reference or else Attribute_Name (Parent (N)) /= Name_Class) then - -- The check does not apply to dispatching calls within the - -- condition, but only to calls whose static tag is that of - -- the parent type. - - if Is_Subprogram (Entity (N)) - and then Nkind (Parent (N)) = N_Function_Call - and then Present (Controlling_Argument (Parent (N))) - then - return OK; - end if; - -- Determine whether entity has a renaming New_E := Get_Mapped_Entity (Entity (N)); @@ -1795,6 +1784,10 @@ package body Freeze is Ifaces_Listed : Boolean := False; -- Cache the list of interface operations inherited by R + Wrappers_List : Elist_Id := No_Elist; + -- List containing identifiers of built wrappers. Used to defer building + -- and analyzing their class-wide precondition subprograms. + -- Start of processing for Check_Inherited_Conditions begin @@ -1981,17 +1974,25 @@ package body Freeze is DTW_Id : Entity_Id; DTW_Spec : Node_Id; - begin - -- The wrapper must be analyzed in the scope of its wrapped - -- primitive (to ensure its correct decoration). - - Push_Scope (Scope (Prim)); + Prim_Next_E : constant Entity_Id := Next_Entity (Prim); + Prim_Prev_E : constant Entity_Id := Prev_Entity (Prim); + begin DTW_Spec := Build_DTW_Spec (Par_Prim); DTW_Id := Defining_Entity (DTW_Spec); DTW_Decl := Make_Subprogram_Declaration (Loc, Specification => DTW_Spec); + -- The spec of the wrapper has been built using the source + -- location of its parent primitive; we must update it now + -- (with the source location of the internal primitive built + -- by Derive_Subprogram that will override this wrapper) to + -- avoid inlining conflicts between internally built helpers + -- for class-wide pre/postconditions of the parent and the + -- helpers built for this wrapper. + + Set_Sloc (DTW_Id, Sloc (Prim)); + -- For inherited class-wide preconditions the DTW wrapper -- reuses the ICW of the parent (which checks the parent -- interpretation of the class-wide preconditions); the @@ -2049,9 +2050,46 @@ package body Freeze is Insert_Before_And_Analyze (Freeze_Node (R), DTW_Decl); else Append_Freeze_Action (R, DTW_Decl); + Analyze (DTW_Decl); end if; - Analyze (DTW_Decl); + -- The analyis of DTW_Decl has removed Prim from its scope + -- chain and added DTW_Id at the end of the scope chain. Move + -- DTW_Id to its correct place in the scope chain: the analysis + -- of the wrapper declaration has just added DTW_Id at the end + -- of the list of entities of its scope. However, given that + -- this wrapper overrides Prim, we must move DTW_Id to the + -- original place of Prim in its scope chain. This is required + -- for wrappers of private type primitives to ensure their + -- correct visibility since wrappers are built when the full + -- tagged type declaration is frozen (in the private part of + -- the package) but they may override primitives defined in the + -- public part of the package. + + declare + DTW_Prev_E : constant Entity_Id := Prev_Entity (DTW_Id); + + begin + pragma Assert (Last_Entity (Current_Scope) = DTW_Id); + pragma Assert + (Ekind (Current_Scope) not in E_Package | E_Generic_Package + or else No (First_Private_Entity (Current_Scope)) + or else First_Private_Entity (Current_Scope) /= DTW_Id); + + -- Remove DTW_Id from the end of the doubly-linked list of + -- entities of this scope; no need to handle removing it + -- from the beginning of the chain since such case can never + -- occur for this entity. + + Set_Last_Entity (Current_Scope, DTW_Prev_E); + Set_Next_Entity (DTW_Prev_E, Empty); + + -- Place DTW_Id back in the original place of its wrapped + -- primitive in the list of entities of this scope. + + Link_Entities (Prim_Prev_E, DTW_Id); + Link_Entities (DTW_Id, Prim_Next_E); + end; -- Insert the body of the wrapper in the freeze actions of -- its record type declaration to ensure that it is placed @@ -2081,42 +2119,58 @@ package body Freeze is Register_Primitive (Loc, DTW_Id)); end if; - -- Build the helper and ICW for the DTW + -- Defer building helpers and ICW for the DTW. Required to + -- ensure uniqueness in their names because when building + -- these wrappers for overlapped subprograms their homonym + -- number is not definite until all these dispatch table + -- wrappers of tagged type R have been analyzed. if Present (Indirect_Call_Wrapper (Par_Prim)) then - declare - CW_Subp : Entity_Id; - Decl_N : Node_Id; - Body_N : Node_Id; - - begin - Merge_Class_Conditions (DTW_Id); - Make_Class_Precondition_Subps (DTW_Id, - Late_Overriding => Late_Overriding); - - CW_Subp := Static_Call_Helper (DTW_Id); - Decl_N := Unit_Declaration_Node (CW_Subp); - Analyze (Decl_N); - - -- If the DTW was built for a late-overriding primitive - -- its body must be analyzed now (since the tagged type - -- is already frozen). - - if Late_Overriding then - Body_N := - Unit_Declaration_Node - (Corresponding_Body (Decl_N)); - Analyze (Body_N); - end if; - end; + Append_New_Elmt (DTW_Id, Wrappers_List); end if; - - Pop_Scope; end; end if; Next_Elmt (Op_Node); end loop; + + -- Build and analyze deferred class-wide precondition subprograms of + -- built wrappers. + + if Present (Wrappers_List) then + declare + Body_N : Node_Id; + CW_Subp : Entity_Id; + Decl_N : Node_Id; + DTW_Id : Entity_Id; + Elmt : Elmt_Id; + + begin + Elmt := First_Elmt (Wrappers_List); + + while Present (Elmt) loop + DTW_Id := Node (Elmt); + Next_Elmt (Elmt); + + Merge_Class_Conditions (DTW_Id); + Make_Class_Precondition_Subps (DTW_Id, Late_Overriding); + + CW_Subp := Static_Call_Helper (DTW_Id); + Decl_N := Unit_Declaration_Node (CW_Subp); + Analyze (Decl_N); + + -- If the DTW was built for a late-overriding primitive + -- its body must be analyzed now (since the tagged type + -- is already frozen). + + if Late_Overriding then + Body_N := + Unit_Declaration_Node (Corresponding_Body (Decl_N)); + Analyze (Body_N); + end if; + end loop; + end; + end if; end Check_Inherited_Conditions; ---------------------------- diff --git a/gcc/ada/gcc-interface/decl.cc b/gcc/ada/gcc-interface/decl.cc index d52c4fb..28e1ab7 100644 --- a/gcc/ada/gcc-interface/decl.cc +++ b/gcc/ada/gcc-interface/decl.cc @@ -1597,14 +1597,6 @@ gnat_to_gnu_entity (Entity_Id gnat_entity, tree gnu_expr, bool definition) if (TREE_CODE (gnu_decl) == CONST_DECL) DECL_CONST_ADDRESS_P (gnu_decl) = constructor_address_p (gnu_expr); - /* If this object is declared in a block that contains a block with an - exception handler, and we aren't using the GCC exception mechanism, - we must force this variable in memory in order to avoid an invalid - optimization. */ - if (Front_End_Exceptions () - && Has_Nested_Block_With_Handler (Scope (gnat_entity))) - TREE_ADDRESSABLE (gnu_decl) = 1; - /* If this is a local variable with non-BLKmode and aggregate type, and optimization isn't enabled, then force it in memory so that a register won't be allocated to it with possible subparts left @@ -1618,24 +1610,6 @@ gnat_to_gnu_entity (Entity_Id gnat_entity, tree gnu_expr, bool definition) && !optimize) TREE_ADDRESSABLE (gnu_decl) = 1; - /* If we are defining an object with variable size or an object with - fixed size that will be dynamically allocated, and we are using the - front-end setjmp/longjmp exception mechanism, update the setjmp - buffer. */ - if (definition - && Exception_Mechanism == Front_End_SJLJ - && get_block_jmpbuf_decl () - && DECL_SIZE_UNIT (gnu_decl) - && (TREE_CODE (DECL_SIZE_UNIT (gnu_decl)) != INTEGER_CST - || (flag_stack_check == GENERIC_STACK_CHECK - && compare_tree_int (DECL_SIZE_UNIT (gnu_decl), - STACK_CHECK_MAX_VAR_SIZE) > 0))) - add_stmt_with_node (build_call_n_expr - (update_setjmp_buf_decl, 1, - build_unary_op (ADDR_EXPR, NULL_TREE, - get_block_jmpbuf_decl ())), - gnat_entity); - /* Back-annotate Esize and Alignment of the object if not already known. Note that we pick the values of the type, not those of the object, to shield ourselves from low-level platform-dependent @@ -4982,7 +4956,8 @@ is_cplusplus_method (Entity_Id gnat_entity) 'this' parameter is not encoded in the mangled name of a method. */ if (Is_Subprogram (gnat_entity) && Present (Interface_Name (gnat_entity))) { - String_Pointer sp = { NULL, NULL }; + String_Template temp = { 0, 0 }; + String_Pointer sp = { "", &temp }; Get_External_Name (gnat_entity, false, sp); void *mem; @@ -5801,7 +5776,7 @@ gnat_to_gnu_subprog_type (Entity_Id gnat_subprog, bool definition, circuitry from it, we need to declare that calls to pure Ada subprograms that can throw have side effects, since they can trigger an "abnormal" transfer of control; therefore they cannot be "pure" in the GCC sense. */ - bool pure_flag = Is_Pure (gnat_subprog) && Back_End_Exceptions (); + bool pure_flag = Is_Pure (gnat_subprog); bool return_by_direct_ref_p = false; bool return_by_invisi_ref_p = false; bool return_unconstrained_p = false; diff --git a/gcc/ada/gcc-interface/trans.cc b/gcc/ada/gcc-interface/trans.cc index 39059cb..5741986 100644 --- a/gcc/ada/gcc-interface/trans.cc +++ b/gcc/ada/gcc-interface/trans.cc @@ -666,9 +666,7 @@ gigi (Node_Id gnat_root, main_identifier_node = get_identifier ("main"); - /* If we are using the GCC exception mechanism, let GCC know. */ - if (Back_End_Exceptions ()) - gnat_init_gcc_eh (); + gnat_init_gcc_eh (); /* Initialize the GCC support for FP operations. */ gnat_init_gcc_fp (); @@ -5361,26 +5359,16 @@ Handled_Sequence_Of_Statements_to_gnu (Node_Id gnat_node) { /* If just annotating, ignore all EH and cleanups. */ const bool gcc_eh - = (!type_annotate_only - && Present (Exception_Handlers (gnat_node)) - && Back_End_Exceptions ()); - const bool fe_sjlj_eh - = (!type_annotate_only - && Present (Exception_Handlers (gnat_node)) - && Exception_Mechanism == Front_End_SJLJ); + = !type_annotate_only && Present (Exception_Handlers (gnat_node)); const bool at_end = !type_annotate_only && Present (At_End_Proc (gnat_node)); - const bool binding_for_block = (at_end || gcc_eh || fe_sjlj_eh); - tree gnu_jmpsave_decl = NULL_TREE; - tree gnu_jmpbuf_decl = NULL_TREE; + const bool binding_for_block = (at_end || gcc_eh); tree gnu_inner_block; /* The statement(s) for the block itself. */ tree gnu_result; - tree gnu_expr; Node_Id gnat_temp; - /* The GCC exception handling mechanism can handle both ZCX and SJLJ schemes - and the front-end has its own SJLJ mechanism. To call the GCC mechanism, - we call add_cleanup, and when we leave the binding, end_stmt_group will - create the TRY_FINALLY_EXPR construct. + /* The GCC exception handling mechanism can handle both ZCX and SJLJ schemes. + To call the GCC mechanism, we call add_cleanup, and when we leave the + binding, end_stmt_group will create the TRY_FINALLY_EXPR construct. ??? The region level calls down there have been specifically put in place for a ZCX context and currently the order in which things are emitted @@ -5390,45 +5378,13 @@ Handled_Sequence_Of_Statements_to_gnu (Node_Id gnat_node) condition to make it not ZCX specific. If there are any exceptions or cleanup processing involved, we need an - outer statement group (for front-end SJLJ) and binding level. */ + outer statement group and binding level. */ if (binding_for_block) { start_stmt_group (); gnat_pushlevel (); } - /* If using fe_sjlj_eh, make the variables for the setjmp buffer and save - area for address of previous buffer. Do this first since we need to have - the setjmp buf known for any decls in this block. */ - if (fe_sjlj_eh) - { - gnu_jmpsave_decl - = create_var_decl (get_identifier ("JMPBUF_SAVE"), NULL_TREE, - jmpbuf_ptr_type, - build_call_n_expr (get_jmpbuf_decl, 0), - false, false, false, false, false, true, false, - NULL, gnat_node); - - /* The __builtin_setjmp receivers will immediately reinstall it. Now - because of the unstructured form of EH used by fe_sjlj_eh, there - might be forward edges going to __builtin_setjmp receivers on which - it is uninitialized, although they will never be actually taken. */ - suppress_warning (gnu_jmpsave_decl, OPT_Wuninitialized); - gnu_jmpbuf_decl - = create_var_decl (get_identifier ("JMP_BUF"), NULL_TREE, - jmpbuf_type, - NULL_TREE, - false, false, false, false, false, true, false, - NULL, gnat_node); - - set_block_jmpbuf_decl (gnu_jmpbuf_decl); - - /* When we exit this block, restore the saved value. */ - add_cleanup (build_call_n_expr (set_jmpbuf_decl, 1, gnu_jmpsave_decl), - Present (End_Label (gnat_node)) - ? End_Label (gnat_node) : gnat_node); - } - /* If we are to call a function when exiting this block, add a cleanup to the binding level we made above. Note that add_cleanup is FIFO so we must register this cleanup after the EH cleanup just above. */ @@ -5449,19 +5405,10 @@ Handled_Sequence_Of_Statements_to_gnu (Node_Id gnat_node) ? End_Label (gnat_node) : At_End_Proc (gnat_node)); } - /* Now build the tree for the declarations and statements inside this block. - If this is SJLJ, set our jmp_buf as the current buffer. */ + /* Now build the tree for the declarations and statements inside this + block. */ start_stmt_group (); - if (fe_sjlj_eh) - { - gnu_expr = build_call_n_expr (set_jmpbuf_decl, 1, - build_unary_op (ADDR_EXPR, NULL_TREE, - gnu_jmpbuf_decl)); - set_expr_location_from_node (gnu_expr, gnat_node); - add_stmt (gnu_expr); - } - if (Present (First_Real_Statement (gnat_node))) process_decls (Statements (gnat_node), Empty, First_Real_Statement (gnat_node), true, true); @@ -5475,81 +5422,7 @@ Handled_Sequence_Of_Statements_to_gnu (Node_Id gnat_node) gnu_inner_block = end_stmt_group (); - /* Now generate code for the two exception models, if either is relevant for - this block. */ - if (fe_sjlj_eh) - { - tree *gnu_else_ptr = 0; - tree gnu_handler; - - /* Make a binding level for the exception handling declarations and code - and set up gnu_except_ptr_stack for the handlers to use. */ - start_stmt_group (); - gnat_pushlevel (); - - vec_safe_push (gnu_except_ptr_stack, - create_var_decl (get_identifier ("EXCEPT_PTR"), NULL_TREE, - build_pointer_type (except_type_node), - build_call_n_expr (get_excptr_decl, 0), - false, false, false, false, false, - true, false, NULL, gnat_node)); - - /* Generate code for each handler. The N_Exception_Handler case does the - real work and returns a COND_EXPR for each handler, which we chain - together here. */ - for (gnat_temp = First_Non_Pragma (Exception_Handlers (gnat_node)); - Present (gnat_temp); gnat_temp = Next_Non_Pragma (gnat_temp)) - { - gnu_expr = gnat_to_gnu (gnat_temp); - - /* If this is the first one, set it as the outer one. Otherwise, - point the "else" part of the previous handler to us. Then point - to our "else" part. */ - if (!gnu_else_ptr) - add_stmt (gnu_expr); - else - *gnu_else_ptr = gnu_expr; - - gnu_else_ptr = &COND_EXPR_ELSE (gnu_expr); - } - - /* If none of the exception handlers did anything, re-raise but do not - defer abortion. */ - gnu_expr = build_call_n_expr (raise_nodefer_decl, 1, - gnu_except_ptr_stack->last ()); - set_expr_location_from_node - (gnu_expr, - Present (End_Label (gnat_node)) ? End_Label (gnat_node) : gnat_node); - - if (gnu_else_ptr) - *gnu_else_ptr = gnu_expr; - else - add_stmt (gnu_expr); - - /* End the binding level dedicated to the exception handlers and get the - whole statement group. */ - gnu_except_ptr_stack->pop (); - gnat_poplevel (); - gnu_handler = end_stmt_group (); - - /* If the setjmp returns 1, we restore our incoming longjmp value and - then check the handlers. */ - start_stmt_group (); - add_stmt_with_node (build_call_n_expr (set_jmpbuf_decl, 1, - gnu_jmpsave_decl), - gnat_node); - add_stmt (gnu_handler); - gnu_handler = end_stmt_group (); - - /* This block is now "if (setjmp) ... <handlers> else <block>". */ - gnu_result = build3 (COND_EXPR, void_type_node, - (build_call_n_expr - (setjmp_decl, 1, - build_unary_op (ADDR_EXPR, NULL_TREE, - gnu_jmpbuf_decl))), - gnu_handler, gnu_inner_block); - } - else if (gcc_eh) + if (gcc_eh) { tree gnu_handlers; location_t locus; @@ -5592,75 +5465,6 @@ Handled_Sequence_Of_Statements_to_gnu (Node_Id gnat_node) return gnu_result; } -/* Subroutine of gnat_to_gnu to translate gnat_node, an N_Exception_Handler, - to a GCC tree, which is returned. This is the variant for front-end sjlj - exception handling. */ - -static tree -Exception_Handler_to_gnu_fe_sjlj (Node_Id gnat_node) -{ - /* Unless this is "Others" or the special "Non-Ada" exception for Ada, make - an "if" statement to select the proper exceptions. For "Others", exclude - exceptions where Handled_By_Others is nonzero unless the All_Others flag - is set. For "Non-ada", accept an exception if "Lang" is 'V'. */ - tree gnu_choice = boolean_false_node; - tree gnu_body = build_stmt_group (Statements (gnat_node), false); - Node_Id gnat_temp; - - for (gnat_temp = First (Exception_Choices (gnat_node)); - gnat_temp; gnat_temp = Next (gnat_temp)) - { - tree this_choice; - - if (Nkind (gnat_temp) == N_Others_Choice) - { - if (All_Others (gnat_temp)) - this_choice = boolean_true_node; - else - this_choice - = build_binary_op - (EQ_EXPR, boolean_type_node, - convert - (integer_type_node, - build_component_ref - (build_unary_op - (INDIRECT_REF, NULL_TREE, - gnu_except_ptr_stack->last ()), - not_handled_by_others_decl, - false)), - integer_zero_node); - } - - else if (Nkind (gnat_temp) == N_Identifier - || Nkind (gnat_temp) == N_Expanded_Name) - { - Entity_Id gnat_ex_id = Entity (gnat_temp); - tree gnu_expr; - - /* Exception may be a renaming. Recover original exception which is - the one elaborated and registered. */ - if (Present (Renamed_Object (gnat_ex_id))) - gnat_ex_id = Renamed_Object (gnat_ex_id); - - gnu_expr = gnat_to_gnu_entity (gnat_ex_id, NULL_TREE, false); - - this_choice - = build_binary_op - (EQ_EXPR, boolean_type_node, - gnu_except_ptr_stack->last (), - convert (TREE_TYPE (gnu_except_ptr_stack->last ()), - build_unary_op (ADDR_EXPR, NULL_TREE, gnu_expr))); - } - else - gcc_unreachable (); - - gnu_choice = build_binary_op (TRUTH_ORIF_EXPR, boolean_type_node, - gnu_choice, this_choice); - } - - return build3 (COND_EXPR, void_type_node, gnu_choice, gnu_body, NULL_TREE); -} - /* Return true if no statement in GNAT_LIST can alter the control flow. */ static bool @@ -7871,30 +7675,16 @@ gnat_to_gnu (Node_Id gnat_node) /***************************/ case N_Handled_Sequence_Of_Statements: - /* If there is an At_End procedure attached to this node, and the EH - mechanism is front-end, we must have at least a corresponding At_End - handler, unless the No_Exception_Handlers restriction is set. */ - gcc_assert (type_annotate_only - || !Front_End_Exceptions () - || No (At_End_Proc (gnat_node)) - || Present (Exception_Handlers (gnat_node)) - || No_Exception_Handlers_Set ()); - gnu_result = Handled_Sequence_Of_Statements_to_gnu (gnat_node); break; case N_Exception_Handler: - if (Back_End_Exceptions ()) - gnu_result = Exception_Handler_to_gnu_gcc (gnat_node); - else if (Exception_Mechanism == Front_End_SJLJ) - gnu_result = Exception_Handler_to_gnu_fe_sjlj (gnat_node); - else - gcc_unreachable (); + gnu_result = Exception_Handler_to_gnu_gcc (gnat_node); break; case N_Raise_Statement: /* Only for reraise in back-end exceptions mode. */ - gcc_assert (No (Name (gnat_node)) && Back_End_Exceptions ()); + gcc_assert (No (Name (gnat_node))); start_stmt_group (); diff --git a/gcc/ada/gcc-interface/utils.cc b/gcc/ada/gcc-interface/utils.cc index 049cf74..5722ed2 100644 --- a/gcc/ada/gcc-interface/utils.cc +++ b/gcc/ada/gcc-interface/utils.cc @@ -208,6 +208,10 @@ const struct attribute_spec gnat_internal_attribute_table[] = { "format_arg", 1, 1, false, true, true, false, fake_attribute_handler, NULL }, + /* This is handled entirely in the front end. */ + { "hardbool", 0, 0, false, true, false, true, + fake_attribute_handler, NULL }, + { NULL, 0, 0, false, false, false, false, NULL, NULL } }; diff --git a/gcc/ada/gen_il-gen.adb b/gcc/ada/gen_il-gen.adb index adf363b..0ecc696 100644 --- a/gcc/ada/gen_il-gen.adb +++ b/gcc/ada/gen_il-gen.adb @@ -1425,7 +1425,7 @@ package body Gen_IL.Gen is (S : in out Sink; T : Type_Enum) is Pre : constant String := - "function Cast is new Unchecked_Conversion ("; + "function Cast is new Ada.Unchecked_Conversion ("; Lo_Type : constant String := "Field_Size_" & Image (Field_Size (T)) & "_Bit"; Hi_Type : constant String := Get_Set_Id_Image (T); begin @@ -2338,7 +2338,7 @@ package body Gen_IL.Gen is Decrease_Indent (S, 3); Put (S, LF & "end Sinfo.Nodes;" & LF); - Put (B, "with Unchecked_Conversion;" & LF); + Put (B, "with Ada.Unchecked_Conversion;" & LF); Put (B, "with Atree; use Atree; use Atree.Atree_Private_Part;" & LF); Put (B, "with Nlists; use Nlists;" & LF); Put (B, "pragma Warnings (Off);" & LF); @@ -2394,7 +2394,7 @@ package body Gen_IL.Gen is Decrease_Indent (S, 3); Put (S, LF & "end Einfo.Entities;" & LF); - Put (B, "with Unchecked_Conversion;" & LF); + Put (B, "with Ada.Unchecked_Conversion;" & LF); Put (B, "with Atree; use Atree; use Atree.Atree_Private_Part;" & LF); Put (B, "with Einfo.Utils; use Einfo.Utils;" & LF); -- This forms a cycle between packages (via bodies, which is OK) diff --git a/gcc/ada/gnat1drv.adb b/gcc/ada/gnat1drv.adb index 0a11619..79d5847 100644 --- a/gcc/ada/gnat1drv.adb +++ b/gcc/ada/gnat1drv.adb @@ -631,28 +631,11 @@ procedure Gnat1drv is -- generating code. if Operating_Mode = Generate_Code then - case Targparm.Frontend_Exceptions_On_Target is - when True => - case Targparm.ZCX_By_Default_On_Target is - when True => - Write_Line - ("Run-time library configured incorrectly"); - Write_Line - ("(requesting support for Frontend ZCX exceptions)"); - raise Unrecoverable_Error; - - when False => - Exception_Mechanism := Front_End_SJLJ; - end case; - - when False => - case Targparm.ZCX_By_Default_On_Target is - when True => - Exception_Mechanism := Back_End_ZCX; - when False => - Exception_Mechanism := Back_End_SJLJ; - end case; - end case; + if Targparm.ZCX_By_Default_On_Target then + Exception_Mechanism := Back_End_ZCX; + else + Exception_Mechanism := Back_End_SJLJ; + end if; end if; -- Set proper status for overflow check mechanism @@ -1273,7 +1256,6 @@ begin if Compilation_Errors then Treepr.Tree_Dump; - Post_Compilation_Validation_Checks; Errout.Finalize (Last_Call => True); Errout.Output_Messages; Namet.Finalize; diff --git a/gcc/ada/gnat_cuda.adb b/gcc/ada/gnat_cuda.adb index 2a0a450..4bb8c5a 100644 --- a/gcc/ada/gnat_cuda.adb +++ b/gcc/ada/gnat_cuda.adb @@ -118,11 +118,6 @@ package body GNAT_CUDA is -- are declared within package body Pack_Body. Returns No_Elist if Pack_Id -- does not contain such entities. - function Get_CUDA_Kernels (Pack_Id : Entity_Id) return Elist_Id; - -- Returns an Elist of all procedures marked with pragma CUDA_Global that - -- are declared within package body Pack_Body. Returns No_Elist if Pack_Id - -- does not contain such procedures. - procedure Remove_CUDA_Device_Entities (Pack_Id : Entity_Id); -- Removes all entities marked with the CUDA_Device pragma from package -- Pack_Id. Must only be called when compiling for the host. diff --git a/gcc/ada/gnat_cuda.ads b/gcc/ada/gnat_cuda.ads index b5fcf8f..e756162 100644 --- a/gcc/ada/gnat_cuda.ads +++ b/gcc/ada/gnat_cuda.ads @@ -92,4 +92,9 @@ package GNAT_CUDA is -- - Empty content of CUDA_Global procedures. -- - Remove declarations of CUDA_Device entities. + function Get_CUDA_Kernels (Pack_Id : Entity_Id) return Elist_Id; + -- Returns an Elist of all procedures marked with pragma CUDA_Global that + -- are declared within package body Pack_Body. Returns No_Elist if Pack_Id + -- does not contain such procedures. + end GNAT_CUDA; diff --git a/gcc/ada/gnat_rm.texi b/gcc/ada/gnat_rm.texi index a002498..c5a8779 100644 --- a/gcc/ada/gnat_rm.texi +++ b/gcc/ada/gnat_rm.texi @@ -885,6 +885,8 @@ Security Hardening Features * Register Scrubbing:: * Stack Scrubbing:: * Hardened Conditionals:: +* Hardened Booleans:: +* Control Flow Redundancy:: Obsolescent Features @@ -3426,10 +3428,10 @@ still allows the specification of parameter mechanisms. Syntax: @example -pragma Export_Object +pragma Export_Object ( [Internal =>] LOCAL_NAME [, [External =>] EXTERNAL_SYMBOL] - [, [Size =>] EXTERNAL_SYMBOL] + [, [Size =>] EXTERNAL_SYMBOL]); EXTERNAL_SYMBOL ::= IDENTIFIER @@ -4385,7 +4387,7 @@ is used. Syntax: @example -pragma Import_Object +pragma Import_Object ( [Internal =>] LOCAL_NAME [, [External =>] EXTERNAL_SYMBOL] [, [Size =>] EXTERNAL_SYMBOL]); @@ -7597,7 +7599,7 @@ There is no requirement that all units in a partition use this option. Syntax: @example -pragma Short_Descriptors +pragma Short_Descriptors; @end example This pragma is provided for compatibility with other Ada implementations. It @@ -18911,14 +18913,14 @@ typically 31. This means that code may change in behavior when moving from Ada 83 to Ada 95 or Ada 2005. For example, consider: @example -type Rec is record; +type Rec is record A : Natural; B : Natural; end record; for Rec use record - at 0 range 0 .. Natural'Size - 1; - at 0 range Natural'Size .. 2 * Natural'Size - 1; + A at 0 range 0 .. Natural'Size - 1; + B at 0 range Natural'Size .. 2 * Natural'Size - 1; end record; @end example @@ -28853,6 +28855,8 @@ are provided by GNAT. * Register Scrubbing:: * Stack Scrubbing:: * Hardened Conditionals:: +* Hardened Booleans:: +* Control Flow Redundancy:: @end menu @@ -28864,7 +28868,7 @@ are provided by GNAT. GNAT can generate code to zero-out hardware registers before returning from a subprogram. -It can be enabled with the @emph{-fzero-call-used-regs} command line +It can be enabled with the @code{-fzero-call-used-regs} command-line option, to affect all subprograms in a compilation, and with a @code{Machine_Attribute} pragma, to affect only specific subprograms. @@ -28879,7 +28883,7 @@ pragma Machine_Attribute (Bar, "zero_call_used_regs", "all"); -- Before returning, Bar scrubs all call-clobbered registers. @end example -For usage and more details on the command line option, and on the +For usage and more details on the command-line option, and on the @code{zero_call_used_regs} attribute, see @cite{Using the GNU Compiler Collection (GCC)}. @c Stack Scrubbing: @@ -28911,9 +28915,9 @@ pragma Machine_Attribute (Var, "strub"); -- of the stack space used by the subprogram. @end example -There are also @emph{-fstrub} command line options to control default -settings. For usage and more details on the command line option, and -on the @code{strub} attribute, see @cite{Using the GNU Compiler Collection (GCC)}. +There are also @code{-fstrub} command-line options to control +default settings. For usage and more details on the command-line +option, and on the @code{strub} attribute, see @cite{Using the GNU Compiler Collection (GCC)}. Note that Ada secondary stacks are not scrubbed. The restriction @code{No_Secondary_Stack} avoids their use, and thus their accidental @@ -28967,23 +28971,23 @@ Bar_Callable_Ptr. @c Hardened Conditionals: -@node Hardened Conditionals,,Stack Scrubbing,Security Hardening Features +@node Hardened Conditionals,Hardened Booleans,Stack Scrubbing,Security Hardening Features @anchor{gnat_rm/security_hardening_features hardened-conditionals}@anchor{440} @section Hardened Conditionals -GNAT can harden conditionals to protect against control flow attacks. +GNAT can harden conditionals to protect against control-flow attacks. This is accomplished by two complementary transformations, each activated by a separate command-line option. -The option @emph{-fharden-compares} enables hardening of compares that -compute results stored in variables, adding verification that the +The option @code{-fharden-compares} enables hardening of compares +that compute results stored in variables, adding verification that the reversed compare yields the opposite result. -The option @emph{-fharden-conditional-branches} enables hardening of -compares that guard conditional branches, adding verification of the -reversed compare to both execution paths. +The option @code{-fharden-conditional-branches} enables hardening +of compares that guard conditional branches, adding verification of +the reversed compare to both execution paths. These transformations are introduced late in the compilation pipeline, long after boolean expressions are decomposed into separate compares, @@ -29001,14 +29005,99 @@ options ensures that every compare that is neither optimized out nor optimized into implied conditionals will be hardened. The addition of reversed compares can be observed by enabling the dump -files of the corresponding passes, through command line options -@emph{-fdump-tree-hardcmp} and @emph{-fdump-tree-hardcbr}, respectively. +files of the corresponding passes, through command-line options +@code{-fdump-tree-hardcmp} and @code{-fdump-tree-hardcbr}, +respectively. They are separate options, however, because of the significantly different performance impact of the hardening transformations. +@c Hardened Booleans: + +@node Hardened Booleans,Control Flow Redundancy,Hardened Conditionals,Security Hardening Features +@anchor{gnat_rm/security_hardening_features hardened-booleans}@anchor{441} +@section Hardened Booleans + + +Ada has built-in support for introducing boolean types with +alternative representations, using representation clauses: + +@example +type HBool is new Boolean; +for HBool use (16#5a#, 16#a5#); +for HBool'Size use 8; +@end example + +When validity checking is enabled, the compiler will check that +variables of such types hold values corresponding to the selected +representations. + +There are multiple strategies for where to introduce validity checking +(see @code{-gnatV} options). Their goal is to guard against +various kinds of programming errors, and GNAT strives to omit checks +when program logic rules out an invalid value, and optimizers may +further remove checks found to be redundant. + +For additional hardening, the @code{hardbool} @code{Machine_Attribute} +pragma can be used to annotate boolean types with representation +clauses, so that expressions of such types used as conditions are +checked even when compiling with @code{-gnatVT}. + +@example +pragma Machine_Attribute (HBool, "hardbool"); +@end example + +Note that @code{-gnatVn} will disable even @code{hardbool} testing. + +@c Control Flow Redundancy: + +@node Control Flow Redundancy,,Hardened Booleans,Security Hardening Features +@anchor{gnat_rm/security_hardening_features control-flow-redundancy}@anchor{442} +@section Control Flow Redundancy + + +GNAT can guard against unexpected execution flows, such as branching +into the middle of subprograms, as in Return Oriented Programming +exploits. + +In units compiled with @code{-fharden-control-flow-redundancy}, +subprograms are instrumented so that, every time they are called, +basic blocks take note as control flows through them, and, before +returning, subprograms verify that the taken notes are consistent with +the control-flow graph. + +Functions with too many basic blocks, or with multiple return points, +call a run-time function to perform the verification. Other functions +perform the verification inline before returning. + +Optimizing the inlined verification can be quite time consuming, so +the default upper limit for the inline mode is set at 16 blocks. +Command-line option @code{--param hardcfr-max-inline-blocks=} can +override it. + +Even though typically sparse control-flow graphs exhibit run-time +verification time nearly proportional to the block count of a +subprogram, it may become very significant for generated subprograms +with thousands of blocks. Command-line option +@code{--param hardcfr-max-blocks=} can set an upper limit for +instrumentation. + +For each block that is marked as visited, the mechanism checks that at +least one of its predecessors, and at least one of its successors, are +also marked as visited. + +Verification is performed just before returning. Subprogram +executions that complete by raising or propagating an exception bypass +verification-and-return points. A subprogram that can only complete +by raising or propagating an exception may have instrumentation +disabled altogether. + +The instrumentation for hardening with control flow redundancy can be +observed in dump files generated by the command-line option +@code{-fdump-tree-hardcfr}. + @node Obsolescent Features,Compatibility and Porting Guide,Security Hardening Features,Top -@anchor{gnat_rm/obsolescent_features doc}@anchor{441}@anchor{gnat_rm/obsolescent_features id1}@anchor{442}@anchor{gnat_rm/obsolescent_features obsolescent-features}@anchor{16} +@anchor{gnat_rm/obsolescent_features doc}@anchor{443}@anchor{gnat_rm/obsolescent_features id1}@anchor{444}@anchor{gnat_rm/obsolescent_features obsolescent-features}@anchor{16} @chapter Obsolescent Features @@ -29027,7 +29116,7 @@ compatibility purposes. @end menu @node pragma No_Run_Time,pragma Ravenscar,,Obsolescent Features -@anchor{gnat_rm/obsolescent_features id2}@anchor{443}@anchor{gnat_rm/obsolescent_features pragma-no-run-time}@anchor{444} +@anchor{gnat_rm/obsolescent_features id2}@anchor{445}@anchor{gnat_rm/obsolescent_features pragma-no-run-time}@anchor{446} @section pragma No_Run_Time @@ -29040,7 +29129,7 @@ preferred usage is to use an appropriately configured run-time that includes just those features that are to be made accessible. @node pragma Ravenscar,pragma Restricted_Run_Time,pragma No_Run_Time,Obsolescent Features -@anchor{gnat_rm/obsolescent_features id3}@anchor{445}@anchor{gnat_rm/obsolescent_features pragma-ravenscar}@anchor{446} +@anchor{gnat_rm/obsolescent_features id3}@anchor{447}@anchor{gnat_rm/obsolescent_features pragma-ravenscar}@anchor{448} @section pragma Ravenscar @@ -29049,7 +29138,7 @@ The pragma @code{Ravenscar} has exactly the same effect as pragma is part of the new Ada 2005 standard. @node pragma Restricted_Run_Time,pragma Task_Info,pragma Ravenscar,Obsolescent Features -@anchor{gnat_rm/obsolescent_features id4}@anchor{447}@anchor{gnat_rm/obsolescent_features pragma-restricted-run-time}@anchor{448} +@anchor{gnat_rm/obsolescent_features id4}@anchor{449}@anchor{gnat_rm/obsolescent_features pragma-restricted-run-time}@anchor{44a} @section pragma Restricted_Run_Time @@ -29059,7 +29148,7 @@ preferred since the Ada 2005 pragma @code{Profile} is intended for this kind of implementation dependent addition. @node pragma Task_Info,package System Task_Info s-tasinf ads,pragma Restricted_Run_Time,Obsolescent Features -@anchor{gnat_rm/obsolescent_features id5}@anchor{449}@anchor{gnat_rm/obsolescent_features pragma-task-info}@anchor{44a} +@anchor{gnat_rm/obsolescent_features id5}@anchor{44b}@anchor{gnat_rm/obsolescent_features pragma-task-info}@anchor{44c} @section pragma Task_Info @@ -29085,7 +29174,7 @@ in the spec of package System.Task_Info in the runtime library. @node package System Task_Info s-tasinf ads,,pragma Task_Info,Obsolescent Features -@anchor{gnat_rm/obsolescent_features package-system-task-info}@anchor{44b}@anchor{gnat_rm/obsolescent_features package-system-task-info-s-tasinf-ads}@anchor{44c} +@anchor{gnat_rm/obsolescent_features package-system-task-info}@anchor{44d}@anchor{gnat_rm/obsolescent_features package-system-task-info-s-tasinf-ads}@anchor{44e} @section package System.Task_Info (@code{s-tasinf.ads}) @@ -29095,7 +29184,7 @@ to support the @code{Task_Info} pragma. The predefined Ada package standard replacement for GNAT’s @code{Task_Info} functionality. @node Compatibility and Porting Guide,GNU Free Documentation License,Obsolescent Features,Top -@anchor{gnat_rm/compatibility_and_porting_guide doc}@anchor{44d}@anchor{gnat_rm/compatibility_and_porting_guide compatibility-and-porting-guide}@anchor{17}@anchor{gnat_rm/compatibility_and_porting_guide id1}@anchor{44e} +@anchor{gnat_rm/compatibility_and_porting_guide doc}@anchor{44f}@anchor{gnat_rm/compatibility_and_porting_guide compatibility-and-porting-guide}@anchor{17}@anchor{gnat_rm/compatibility_and_porting_guide id1}@anchor{450} @chapter Compatibility and Porting Guide @@ -29117,7 +29206,7 @@ applications developed in other Ada environments. @end menu @node Writing Portable Fixed-Point Declarations,Compatibility with Ada 83,,Compatibility and Porting Guide -@anchor{gnat_rm/compatibility_and_porting_guide id2}@anchor{44f}@anchor{gnat_rm/compatibility_and_porting_guide writing-portable-fixed-point-declarations}@anchor{450} +@anchor{gnat_rm/compatibility_and_porting_guide id2}@anchor{451}@anchor{gnat_rm/compatibility_and_porting_guide writing-portable-fixed-point-declarations}@anchor{452} @section Writing Portable Fixed-Point Declarations @@ -29239,7 +29328,7 @@ If you follow this scheme you will be guaranteed that your fixed-point types will be portable. @node Compatibility with Ada 83,Compatibility between Ada 95 and Ada 2005,Writing Portable Fixed-Point Declarations,Compatibility and Porting Guide -@anchor{gnat_rm/compatibility_and_porting_guide compatibility-with-ada-83}@anchor{451}@anchor{gnat_rm/compatibility_and_porting_guide id3}@anchor{452} +@anchor{gnat_rm/compatibility_and_porting_guide compatibility-with-ada-83}@anchor{453}@anchor{gnat_rm/compatibility_and_porting_guide id3}@anchor{454} @section Compatibility with Ada 83 @@ -29267,7 +29356,7 @@ following subsections treat the most likely issues to be encountered. @end menu @node Legal Ada 83 programs that are illegal in Ada 95,More deterministic semantics,,Compatibility with Ada 83 -@anchor{gnat_rm/compatibility_and_porting_guide id4}@anchor{453}@anchor{gnat_rm/compatibility_and_porting_guide legal-ada-83-programs-that-are-illegal-in-ada-95}@anchor{454} +@anchor{gnat_rm/compatibility_and_porting_guide id4}@anchor{455}@anchor{gnat_rm/compatibility_and_porting_guide legal-ada-83-programs-that-are-illegal-in-ada-95}@anchor{456} @subsection Legal Ada 83 programs that are illegal in Ada 95 @@ -29367,7 +29456,7 @@ the fix is usually simply to add the @code{(<>)} to the generic declaration. @end itemize @node More deterministic semantics,Changed semantics,Legal Ada 83 programs that are illegal in Ada 95,Compatibility with Ada 83 -@anchor{gnat_rm/compatibility_and_porting_guide id5}@anchor{455}@anchor{gnat_rm/compatibility_and_porting_guide more-deterministic-semantics}@anchor{456} +@anchor{gnat_rm/compatibility_and_porting_guide id5}@anchor{457}@anchor{gnat_rm/compatibility_and_porting_guide more-deterministic-semantics}@anchor{458} @subsection More deterministic semantics @@ -29395,7 +29484,7 @@ which open select branches are executed. @end itemize @node Changed semantics,Other language compatibility issues,More deterministic semantics,Compatibility with Ada 83 -@anchor{gnat_rm/compatibility_and_porting_guide changed-semantics}@anchor{457}@anchor{gnat_rm/compatibility_and_porting_guide id6}@anchor{458} +@anchor{gnat_rm/compatibility_and_porting_guide changed-semantics}@anchor{459}@anchor{gnat_rm/compatibility_and_porting_guide id6}@anchor{45a} @subsection Changed semantics @@ -29437,7 +29526,7 @@ covers only the restricted range. @end itemize @node Other language compatibility issues,,Changed semantics,Compatibility with Ada 83 -@anchor{gnat_rm/compatibility_and_porting_guide id7}@anchor{459}@anchor{gnat_rm/compatibility_and_porting_guide other-language-compatibility-issues}@anchor{45a} +@anchor{gnat_rm/compatibility_and_porting_guide id7}@anchor{45b}@anchor{gnat_rm/compatibility_and_porting_guide other-language-compatibility-issues}@anchor{45c} @subsection Other language compatibility issues @@ -29470,7 +29559,7 @@ include @code{pragma Interface} and the floating point type attributes @end itemize @node Compatibility between Ada 95 and Ada 2005,Implementation-dependent characteristics,Compatibility with Ada 83,Compatibility and Porting Guide -@anchor{gnat_rm/compatibility_and_porting_guide compatibility-between-ada-95-and-ada-2005}@anchor{45b}@anchor{gnat_rm/compatibility_and_porting_guide id8}@anchor{45c} +@anchor{gnat_rm/compatibility_and_porting_guide compatibility-between-ada-95-and-ada-2005}@anchor{45d}@anchor{gnat_rm/compatibility_and_porting_guide id8}@anchor{45e} @section Compatibility between Ada 95 and Ada 2005 @@ -29542,7 +29631,7 @@ can declare a function returning a value from an anonymous access type. @end itemize @node Implementation-dependent characteristics,Compatibility with Other Ada Systems,Compatibility between Ada 95 and Ada 2005,Compatibility and Porting Guide -@anchor{gnat_rm/compatibility_and_porting_guide id9}@anchor{45d}@anchor{gnat_rm/compatibility_and_porting_guide implementation-dependent-characteristics}@anchor{45e} +@anchor{gnat_rm/compatibility_and_porting_guide id9}@anchor{45f}@anchor{gnat_rm/compatibility_and_porting_guide implementation-dependent-characteristics}@anchor{460} @section Implementation-dependent characteristics @@ -29565,7 +29654,7 @@ transition from certain Ada 83 compilers. @end menu @node Implementation-defined pragmas,Implementation-defined attributes,,Implementation-dependent characteristics -@anchor{gnat_rm/compatibility_and_porting_guide id10}@anchor{45f}@anchor{gnat_rm/compatibility_and_porting_guide implementation-defined-pragmas}@anchor{460} +@anchor{gnat_rm/compatibility_and_porting_guide id10}@anchor{461}@anchor{gnat_rm/compatibility_and_porting_guide implementation-defined-pragmas}@anchor{462} @subsection Implementation-defined pragmas @@ -29587,7 +29676,7 @@ avoiding compiler rejection of units that contain such pragmas; they are not relevant in a GNAT context and hence are not otherwise implemented. @node Implementation-defined attributes,Libraries,Implementation-defined pragmas,Implementation-dependent characteristics -@anchor{gnat_rm/compatibility_and_porting_guide id11}@anchor{461}@anchor{gnat_rm/compatibility_and_porting_guide implementation-defined-attributes}@anchor{462} +@anchor{gnat_rm/compatibility_and_porting_guide id11}@anchor{463}@anchor{gnat_rm/compatibility_and_porting_guide implementation-defined-attributes}@anchor{464} @subsection Implementation-defined attributes @@ -29601,7 +29690,7 @@ Ada 83, GNAT supplies the attributes @code{Bit}, @code{Machine_Size} and @code{Type_Class}. @node Libraries,Elaboration order,Implementation-defined attributes,Implementation-dependent characteristics -@anchor{gnat_rm/compatibility_and_porting_guide id12}@anchor{463}@anchor{gnat_rm/compatibility_and_porting_guide libraries}@anchor{464} +@anchor{gnat_rm/compatibility_and_porting_guide id12}@anchor{465}@anchor{gnat_rm/compatibility_and_porting_guide libraries}@anchor{466} @subsection Libraries @@ -29630,7 +29719,7 @@ be preferable to retrofit the application using modular types. @end itemize @node Elaboration order,Target-specific aspects,Libraries,Implementation-dependent characteristics -@anchor{gnat_rm/compatibility_and_porting_guide elaboration-order}@anchor{465}@anchor{gnat_rm/compatibility_and_porting_guide id13}@anchor{466} +@anchor{gnat_rm/compatibility_and_porting_guide elaboration-order}@anchor{467}@anchor{gnat_rm/compatibility_and_porting_guide id13}@anchor{468} @subsection Elaboration order @@ -29666,7 +29755,7 @@ pragmas either globally (as an effect of the @emph{-gnatE} switch) or locally @end itemize @node Target-specific aspects,,Elaboration order,Implementation-dependent characteristics -@anchor{gnat_rm/compatibility_and_porting_guide id14}@anchor{467}@anchor{gnat_rm/compatibility_and_porting_guide target-specific-aspects}@anchor{468} +@anchor{gnat_rm/compatibility_and_porting_guide id14}@anchor{469}@anchor{gnat_rm/compatibility_and_porting_guide target-specific-aspects}@anchor{46a} @subsection Target-specific aspects @@ -29679,10 +29768,10 @@ on the robustness of the original design. Moreover, Ada 95 (and thus Ada 2005 and Ada 2012) are sometimes incompatible with typical Ada 83 compiler practices regarding implicit packing, the meaning of the Size attribute, and the size of access values. -GNAT’s approach to these issues is described in @ref{469,,Representation Clauses}. +GNAT’s approach to these issues is described in @ref{46b,,Representation Clauses}. @node Compatibility with Other Ada Systems,Representation Clauses,Implementation-dependent characteristics,Compatibility and Porting Guide -@anchor{gnat_rm/compatibility_and_porting_guide compatibility-with-other-ada-systems}@anchor{46a}@anchor{gnat_rm/compatibility_and_porting_guide id15}@anchor{46b} +@anchor{gnat_rm/compatibility_and_porting_guide compatibility-with-other-ada-systems}@anchor{46c}@anchor{gnat_rm/compatibility_and_porting_guide id15}@anchor{46d} @section Compatibility with Other Ada Systems @@ -29725,7 +29814,7 @@ far beyond this minimal set, as described in the next section. @end itemize @node Representation Clauses,Compatibility with HP Ada 83,Compatibility with Other Ada Systems,Compatibility and Porting Guide -@anchor{gnat_rm/compatibility_and_porting_guide id16}@anchor{46c}@anchor{gnat_rm/compatibility_and_porting_guide representation-clauses}@anchor{469} +@anchor{gnat_rm/compatibility_and_porting_guide id16}@anchor{46e}@anchor{gnat_rm/compatibility_and_porting_guide representation-clauses}@anchor{46b} @section Representation Clauses @@ -29818,7 +29907,7 @@ with thin pointers. @end itemize @node Compatibility with HP Ada 83,,Representation Clauses,Compatibility and Porting Guide -@anchor{gnat_rm/compatibility_and_porting_guide compatibility-with-hp-ada-83}@anchor{46d}@anchor{gnat_rm/compatibility_and_porting_guide id17}@anchor{46e} +@anchor{gnat_rm/compatibility_and_porting_guide compatibility-with-hp-ada-83}@anchor{46f}@anchor{gnat_rm/compatibility_and_porting_guide id17}@anchor{470} @section Compatibility with HP Ada 83 @@ -29848,7 +29937,7 @@ extension of package System. @end itemize @node GNU Free Documentation License,Index,Compatibility and Porting Guide,Top -@anchor{share/gnu_free_documentation_license doc}@anchor{46f}@anchor{share/gnu_free_documentation_license gnu-fdl}@anchor{1}@anchor{share/gnu_free_documentation_license gnu-free-documentation-license}@anchor{470} +@anchor{share/gnu_free_documentation_license doc}@anchor{471}@anchor{share/gnu_free_documentation_license gnu-fdl}@anchor{1}@anchor{share/gnu_free_documentation_license gnu-free-documentation-license}@anchor{472} @chapter GNU Free Documentation License diff --git a/gcc/ada/gnat_ugn.texi b/gcc/ada/gnat_ugn.texi index cf363c6..218c375 100644 --- a/gcc/ada/gnat_ugn.texi +++ b/gcc/ada/gnat_ugn.texi @@ -2808,6 +2808,7 @@ Ada_2005 Ada_12 Ada_2012 Ada_2022 +Aggregate_Individually_Assign Allow_Integer_Address Annotate Assertion_Policy @@ -5668,7 +5669,7 @@ challenge. This section gives a few hints that should make this task easier. GNAT supports interfacing with the G++ compiler (or any C++ compiler generating code that is compatible with the G++ Application Binary -Interface —see @indicateurl{http://www.codesourcery.com/archives/cxx-abi}). +Interface —see @indicateurl{http://itanium-cxx-abi.github.io/cxx-abi/abi.html}). Interfacing can be done at 3 levels: simple data, subprograms, and classes. In the first two cases, GNAT offers a specific @code{Convention C_Plus_Plus} @@ -20477,11 +20478,11 @@ package p2 is function to_a2 (Input : a1) return a2; end p2; -with Unchecked_Conversion; +with Ada.Unchecked_Conversion; package body p2 is function to_a2 (Input : a1) return a2 is function to_a2u is - new Unchecked_Conversion (a1, a2); + new Ada.Unchecked_Conversion (a1, a2); begin return to_a2u (Input); end to_a2; @@ -20580,7 +20581,7 @@ the warning off: @example pragma Warnings (Off); function to_a2u is - new Unchecked_Conversion (a1, a2); + new Ada.Unchecked_Conversion (a1, a2); pragma Warnings (On); @end example @end quotation @@ -22220,9 +22221,9 @@ properly allocated memory location. Here is a complete example of use of @quotation @example -with Gnat.Io; use Gnat.Io; -with Unchecked_Deallocation; -with Unchecked_Conversion; +with GNAT.IO; use GNAT.IO; +with Ada.Unchecked_Deallocation; +with Ada.Unchecked_Conversion; with GNAT.Debug_Pools; with System.Storage_Elements; with Ada.Exceptions; use Ada.Exceptions; @@ -22234,8 +22235,8 @@ procedure Debug_Pool_Test is P : GNAT.Debug_Pools.Debug_Pool; for T'Storage_Pool use P; - procedure Free is new Unchecked_Deallocation (Integer, T); - function UC is new Unchecked_Conversion (U, T); + procedure Free is new Ada.Unchecked_Deallocation (Integer, T); + function UC is new Ada.Unchecked_Conversion (U, T); A, B : aliased T; procedure Info is new GNAT.Debug_Pools.Print_Info(Put_Line); @@ -29247,8 +29248,8 @@ to permit their use in free software. @printindex ge -@anchor{gnat_ugn/gnat_utility_programs switches-related-to-project-files}@w{ } @anchor{cf}@w{ } +@anchor{gnat_ugn/gnat_utility_programs switches-related-to-project-files}@w{ } @c %**end of body @bye diff --git a/gcc/ada/lib-writ.adb b/gcc/ada/lib-writ.adb index 05571f2..556df9a 100644 --- a/gcc/ada/lib-writ.adb +++ b/gcc/ada/lib-writ.adb @@ -30,6 +30,7 @@ with Debug; use Debug; with Einfo; use Einfo; with Einfo.Entities; use Einfo.Entities; with Einfo.Utils; use Einfo.Utils; +with Elists; use Elists; with Errout; use Errout; with Fname; use Fname; with Fname.UF; use Fname.UF; @@ -37,6 +38,7 @@ with Lib.Util; use Lib.Util; with Lib.Xref; use Lib.Xref; with Nlists; use Nlists; with Gnatvsn; use Gnatvsn; +with GNAT_CUDA; use GNAT_CUDA; with Opt; use Opt; with Osint; use Osint; with Osint.C; use Osint.C; @@ -268,6 +270,10 @@ package body Lib.Writ is -- Collect with lines for entries in the context clause of the given -- compilation unit, Cunit. + procedure Output_CUDA_Symbols (Unit_Num : Unit_Number_Type); + -- Output CUDA symbols, so that the rest of the toolchain may know what + -- symbols need registering with the CUDA runtime. + procedure Write_Unit_Information (Unit_Num : Unit_Number_Type); -- Write out the library information for one unit for which code is -- generated (includes unit line and with lines). @@ -386,6 +392,41 @@ package body Lib.Writ is end loop; end Collect_Withs; + ------------------------- + -- Output_CUDA_Symbols -- + ------------------------- + + procedure Output_CUDA_Symbols (Unit_Num : Unit_Number_Type) is + Unit_Id : constant Node_Id := Unit (Cunit (Unit_Num)); + Spec_Id : Node_Id; + Kernels : Elist_Id; + Kernel_Elm : Elmt_Id; + Kernel : Entity_Id; + begin + if not Enable_CUDA_Expansion then + return; + end if; + Spec_Id := (if Nkind (Unit_Id) = N_Package_Body + then Corresponding_Spec (Unit_Id) + else Defining_Unit_Name (Specification (Unit_Id))); + Kernels := Get_CUDA_Kernels (Spec_Id); + if No (Kernels) then + return; + end if; + + Kernel_Elm := First_Elmt (Kernels); + while Present (Kernel_Elm) loop + Kernel := Node (Kernel_Elm); + + Write_Info_Initiate ('K'); + Write_Info_Char (' '); + Write_Info_Name (Chars (Kernel)); + Write_Info_Terminate; + Next_Elmt (Kernel_Elm); + end loop; + + end Output_CUDA_Symbols; + ---------------------------- -- Write_Unit_Information -- ---------------------------- @@ -1166,6 +1207,14 @@ package body Lib.Writ is Write_Info_Terminate; end loop; + -- Output CUDA Kernel lines + + for Unit in Units.First .. Last_Unit loop + if Present (Cunit (Unit)) then + Output_CUDA_Symbols (Unit); + end if; + end loop; + -- Output parameters ('P') line Write_Info_Initiate ('P'); @@ -1234,10 +1283,6 @@ package body Lib.Writ is Write_Info_Str (" UA"); end if; - if Front_End_Exceptions then - Write_Info_Str (" FX"); - end if; - if ZCX_Exceptions then Write_Info_Str (" ZX"); end if; diff --git a/gcc/ada/lib-xref.adb b/gcc/ada/lib-xref.adb index 610a4bd..919e41f 100644 --- a/gcc/ada/lib-xref.adb +++ b/gcc/ada/lib-xref.adb @@ -664,7 +664,7 @@ package body Lib.Xref is -- a default in an instance. -- We also set the referenced flag in a generic package that is not in - -- then main source unit, when the variable is of a formal private type, + -- the main source unit, when the object is of a formal private type, -- to warn in the instance if the corresponding type is not a fully -- initialized type. @@ -694,6 +694,7 @@ package body Lib.Xref is return; elsif Inside_A_Generic + and then Is_Object (E) and then Is_Generic_Type (Etype (E)) then Set_Referenced (E); diff --git a/gcc/ada/libgnarl/a-reatim.adb b/gcc/ada/libgnarl/a-reatim.adb index 6bb5ae5..fda2d63 100644 --- a/gcc/ada/libgnarl/a-reatim.adb +++ b/gcc/ada/libgnarl/a-reatim.adb @@ -30,8 +30,8 @@ -- -- ------------------------------------------------------------------------------ +with Ada.Unchecked_Conversion; with System.Tasking; -with Unchecked_Conversion; package body Ada.Real_Time with SPARK_Mode => Off @@ -128,7 +128,7 @@ is type Duration_Rep is range -(2 ** 63) .. +((2 ** 63 - 1)); function To_Integer is - new Unchecked_Conversion (Duration, Duration_Rep); + new Ada.Unchecked_Conversion (Duration, Duration_Rep); begin return Integer (To_Integer (Duration (Left)) / To_Integer (Duration (Right))); diff --git a/gcc/ada/libgnarl/s-osinte__gnu.ads b/gcc/ada/libgnarl/s-osinte__gnu.ads index e763fc9..39e20f2 100644 --- a/gcc/ada/libgnarl/s-osinte__gnu.ads +++ b/gcc/ada/libgnarl/s-osinte__gnu.ads @@ -40,7 +40,7 @@ with Interfaces.C; with System.Parameters; -with Unchecked_Conversion; +with Ada.Unchecked_Conversion; package System.OS_Interface is pragma Preelaborate; @@ -288,14 +288,14 @@ package System.OS_Interface is pragma Convention (C, Thread_Body); function Thread_Body_Access is new - Unchecked_Conversion (System.Address, Thread_Body); + Ada.Unchecked_Conversion (System.Address, Thread_Body); -- From: /usr/include/bits/pthread.h:typedef int __pthread_t; -- /usr/include/pthread/pthreadtypes.h:typedef __pthread_t pthread_t; type pthread_t is new unsigned_long; subtype Thread_Id is pthread_t; - function To_pthread_t is new Unchecked_Conversion + function To_pthread_t is new Ada.Unchecked_Conversion (unsigned_long, pthread_t); type pthread_mutex_t is limited private; diff --git a/gcc/ada/libgnarl/s-osinte__kfreebsd-gnu.ads b/gcc/ada/libgnarl/s-osinte__kfreebsd-gnu.ads index c8d94e3..ad1a1b5 100644 --- a/gcc/ada/libgnarl/s-osinte__kfreebsd-gnu.ads +++ b/gcc/ada/libgnarl/s-osinte__kfreebsd-gnu.ads @@ -38,9 +38,9 @@ -- PLEASE DO NOT add any with-clauses to this package or remove the pragma -- Preelaborate. This package is designed to be a bottom-level (leaf) package +with Ada.Unchecked_Conversion; with Interfaces.C; with System.Parameters; -with Unchecked_Conversion; package System.OS_Interface is pragma Preelaborate; @@ -276,12 +276,12 @@ package System.OS_Interface is pragma Convention (C, Thread_Body); function Thread_Body_Access is new - Unchecked_Conversion (System.Address, Thread_Body); + Ada.Unchecked_Conversion (System.Address, Thread_Body); type pthread_t is new unsigned_long; subtype Thread_Id is pthread_t; - function To_pthread_t is new Unchecked_Conversion + function To_pthread_t is new Ada.Unchecked_Conversion (unsigned_long, pthread_t); type pthread_mutex_t is limited private; diff --git a/gcc/ada/libgnarl/s-taprop__linux.adb b/gcc/ada/libgnarl/s-taprop__linux.adb index 4ff784f..42a95ea 100644 --- a/gcc/ada/libgnarl/s-taprop__linux.adb +++ b/gcc/ada/libgnarl/s-taprop__linux.adb @@ -96,7 +96,7 @@ package body System.Task_Primitives.Operations is Foreign_Task_Elaborated : aliased Boolean := True; -- Used to identified fake tasks (i.e., non-Ada Threads) - Use_Alternate_Stack : constant Boolean := Alternate_Stack_Size /= 0; + Use_Alternate_Stack : Boolean := Alternate_Stack_Size /= 0; -- Whether to use an alternate signal stack for stack overflows Abort_Handler_Installed : Boolean := False; @@ -1375,9 +1375,9 @@ package body System.Task_Primitives.Operations is function State (Int : System.Interrupt_Management.Interrupt_ID) return Character; pragma Import (C, State, "__gnat_get_interrupt_state"); - -- Get interrupt state. Defined in a-init.c - -- The input argument is the interrupt number, - -- and the result is one of the following: + -- Get interrupt state. Defined in init.c. + -- The input argument is the interrupt number, and the result is one of + -- the following: Default : constant Character := 's'; -- 'n' this interrupt not set by any Interrupt_State pragma @@ -1409,6 +1409,12 @@ package body System.Task_Primitives.Operations is Specific.Initialize (Environment_Task); + -- Do not use an alternate stack if no handler for SEGV is installed + + if State (SIGSEGV) = Default then + Use_Alternate_Stack := False; + end if; + if Use_Alternate_Stack then Environment_Task.Common.Task_Alternate_Stack := Alternate_Stack'Address; diff --git a/gcc/ada/libgnat/a-cfhama.adb b/gcc/ada/libgnat/a-cfhama.adb index da20b93..c2a7c59 100644 --- a/gcc/ada/libgnat/a-cfhama.adb +++ b/gcc/ada/libgnat/a-cfhama.adb @@ -25,11 +25,11 @@ -- <http://www.gnu.org/licenses/>. -- ------------------------------------------------------------------------------ -with Ada.Containers.Hash_Tables.Generic_Bounded_Operations; -pragma Elaborate_All (Ada.Containers.Hash_Tables.Generic_Bounded_Operations); +with Ada.Containers.Hash_Tables.Generic_Formal_Operations; +pragma Elaborate_All (Ada.Containers.Hash_Tables.Generic_Formal_Operations); -with Ada.Containers.Hash_Tables.Generic_Bounded_Keys; -pragma Elaborate_All (Ada.Containers.Hash_Tables.Generic_Bounded_Keys); +with Ada.Containers.Hash_Tables.Generic_Formal_Keys; +pragma Elaborate_All (Ada.Containers.Hash_Tables.Generic_Formal_Keys); with Ada.Containers.Prime_Numbers; use Ada.Containers.Prime_Numbers; @@ -56,7 +56,7 @@ is generic with procedure Set_Element (Node : in out Node_Type); procedure Generic_Allocate - (HT : in out Map; + (HT : in out HT_Types.Hash_Table_Type; Node : out Count_Type); function Hash_Node (Node : Node_Type) return Hash_Type; @@ -75,14 +75,14 @@ is -------------------------- package HT_Ops is - new Hash_Tables.Generic_Bounded_Operations + new Hash_Tables.Generic_Formal_Operations (HT_Types => HT_Types, Hash_Node => Hash_Node, Next => Next, Set_Next => Set_Next); package Key_Ops is - new Hash_Tables.Generic_Bounded_Keys + new Hash_Tables.Generic_Formal_Keys (HT_Types => HT_Types, Next => Next, Set_Next => Set_Next, @@ -154,10 +154,6 @@ is -- Start of processing for Assign begin - if Target'Address = Source'Address then - return; - end if; - if Target.Capacity < Length (Source) then raise Constraint_Error with -- correct exception ??? "Source length exceeds Target capacity"; @@ -556,13 +552,16 @@ is -- Generic_Allocate -- ---------------------- - procedure Generic_Allocate (HT : in out Map; Node : out Count_Type) is + procedure Generic_Allocate + (HT : in out HT_Types.Hash_Table_Type; + Node : out Count_Type) + is procedure Allocate is new HT_Ops.Generic_Allocate (Set_Element); begin - Allocate (HT.Content, Node); - HT.Content.Nodes (Node).Has_Element := True; + Allocate (HT, Node); + HT.Nodes (Node).Has_Element := True; end Generic_Allocate; ----------------- @@ -606,7 +605,8 @@ is if not Inserted then declare - N : Node_Type renames Container.Content.Nodes (Position.Node); + P : constant Count_Type := Position.Node; + N : Node_Type renames Container.Content.Nodes (P); begin N.Key := Key; N.Element := New_Item; @@ -628,7 +628,9 @@ is procedure Assign_Key (Node : in out Node_Type); pragma Inline (Assign_Key); - function New_Node return Count_Type; + procedure New_Node + (HT : in out HT_Types.Hash_Table_Type; + Node : out Count_Type); pragma Inline (New_Node); procedure Local_Insert is @@ -651,11 +653,12 @@ is -- New_Node -- -------------- - function New_Node return Count_Type is - Result : Count_Type; + procedure New_Node + (HT : in out HT_Types.Hash_Table_Type; + Node : out Count_Type) + is begin - Allocate (Container, Result); - return Result; + Allocate (HT, Node); end New_Node; -- Start of processing for Insert @@ -669,11 +672,11 @@ is Key : Key_Type; New_Item : Element_Type) is - Position : Cursor; - Inserted : Boolean; + Unused_Position : Cursor; + Inserted : Boolean; begin - Insert (Container, Key, New_Item, Position, Inserted); + Insert (Container, Key, New_Item, Unused_Position, Inserted); if not Inserted then raise Constraint_Error with "attempt to insert key already in map"; @@ -727,10 +730,6 @@ is Y : Count_Type; begin - if Target'Address = Source'Address then - return; - end if; - if Target.Capacity < Length (Source) then raise Constraint_Error with -- ??? "Source length exceeds Target capacity"; diff --git a/gcc/ada/libgnat/a-cfhama.ads b/gcc/ada/libgnat/a-cfhama.ads index 37024f0..bf1e85f 100644 --- a/gcc/ada/libgnat/a-cfhama.ads +++ b/gcc/ada/libgnat/a-cfhama.ads @@ -900,7 +900,7 @@ private end record; package HT_Types is new - Ada.Containers.Hash_Tables.Generic_Bounded_Hash_Table_Types (Node_Type); + Ada.Containers.Hash_Tables.Generic_Formal_Hash_Table_Types (Node_Type); type Map (Capacity : Count_Type; Modulus : Hash_Type) is record Content : HT_Types.Hash_Table_Type (Capacity, Modulus); diff --git a/gcc/ada/libgnat/a-cfhase.adb b/gcc/ada/libgnat/a-cfhase.adb index 6e289e4..834f43a 100644 --- a/gcc/ada/libgnat/a-cfhase.adb +++ b/gcc/ada/libgnat/a-cfhase.adb @@ -25,11 +25,11 @@ -- <http://www.gnu.org/licenses/>. -- ------------------------------------------------------------------------------ -with Ada.Containers.Hash_Tables.Generic_Bounded_Operations; -pragma Elaborate_All (Ada.Containers.Hash_Tables.Generic_Bounded_Operations); +with Ada.Containers.Hash_Tables.Generic_Formal_Operations; +pragma Elaborate_All (Ada.Containers.Hash_Tables.Generic_Formal_Operations); -with Ada.Containers.Hash_Tables.Generic_Bounded_Keys; -pragma Elaborate_All (Ada.Containers.Hash_Tables.Generic_Bounded_Keys); +with Ada.Containers.Hash_Tables.Generic_Formal_Keys; +pragma Elaborate_All (Ada.Containers.Hash_Tables.Generic_Formal_Keys); with Ada.Containers.Prime_Numbers; use Ada.Containers.Prime_Numbers; @@ -58,7 +58,7 @@ is generic with procedure Set_Element (Node : in out Node_Type); procedure Generic_Allocate - (HT : in out Set; + (HT : in out Hash_Table_Type; Node : out Count_Type); function Hash_Node (Node : Node_Type) return Hash_Type; @@ -95,13 +95,13 @@ is -- Local Instantiations -- -------------------------- - package HT_Ops is new Hash_Tables.Generic_Bounded_Operations + package HT_Ops is new Hash_Tables.Generic_Formal_Operations (HT_Types => HT_Types, Hash_Node => Hash_Node, Next => Next, Set_Next => Set_Next); - package Element_Keys is new Hash_Tables.Generic_Bounded_Keys + package Element_Keys is new Hash_Tables.Generic_Formal_Keys (HT_Types => HT_Types, Next => Next, Set_Next => Set_Next, @@ -167,22 +167,18 @@ is -------------------- procedure Insert_Element (Source_Node : Count_Type) is - N : Node_Type renames Source.Content.Nodes (Source_Node); - X : Count_Type; - B : Boolean; + N : Node_Type renames Source.Content.Nodes (Source_Node); + Unused_X : Count_Type; + B : Boolean; begin - Insert (Target, N.Element, X, B); + Insert (Target, N.Element, Unused_X, B); pragma Assert (B); end Insert_Element; -- Start of processing for Assign begin - if Target'Address = Source'Address then - return; - end if; - if Target.Capacity < Length (Source) then raise Storage_Error with "not enough capacity"; -- SE or CE? ??? end if; @@ -335,11 +331,6 @@ is SN : Nodes_Type renames Source.Content.Nodes; begin - if Target'Address = Source'Address then - Clear (Target); - return; - end if; - Src_Length := Source.Content.Length; if Src_Length = 0 then @@ -393,13 +384,13 @@ is ------------- procedure Process (L_Node : Count_Type) is - B : Boolean; - E : Element_Type renames Left.Content.Nodes (L_Node).Element; - X : Count_Type; + B : Boolean; + E : Element_Type renames Left.Content.Nodes (L_Node).Element; + Unused_X : Count_Type; begin if Find (Right, E).Node = 0 then - Insert (Target, E, X, B); + Insert (Target, E, Unused_X, B); pragma Assert (B); end if; end Process; @@ -411,14 +402,7 @@ is end Difference; function Difference (Left : Set; Right : Set) return Set is - C : Count_Type; - H : Hash_Type; - begin - if Left'Address = Right'Address then - return Empty_Set; - end if; - if Length (Left) = 0 then return Empty_Set; end if; @@ -427,12 +411,14 @@ is return Copy (Left); end if; - C := Length (Left); - H := Default_Modulus (C); - - return S : Set (C, H) do - Difference (Left, Right, Target => S); - end return; + declare + C : constant Count_Type := Length (Left); + H : constant Hash_Type := Default_Modulus (C); + begin + return S : Set (C, H) do + Difference (Left, Right, Target => S); + end return; + end; end Difference; ------------- @@ -461,7 +447,7 @@ is function Equivalent_Sets (Left, Right : Set) return Boolean is function Find_Equivalent_Key - (R_HT : Hash_Table_Type'Class; + (R_HT : Hash_Table_Type; L_Node : Node_Type) return Boolean; pragma Inline (Find_Equivalent_Key); @@ -473,7 +459,7 @@ is ------------------------- function Find_Equivalent_Key - (R_HT : Hash_Table_Type'Class; + (R_HT : Hash_Table_Type; L_Node : Node_Type) return Boolean is R_Index : constant Hash_Type := @@ -793,11 +779,14 @@ is -- Generic_Allocate -- ---------------------- - procedure Generic_Allocate (HT : in out Set; Node : out Count_Type) is + procedure Generic_Allocate + (HT : in out Hash_Table_Type; + Node : out Count_Type) + is procedure Allocate is new HT_Ops.Generic_Allocate (Set_Element); begin - Allocate (HT.Content, Node); - HT.Content.Nodes (Node).Has_Element := True; + Allocate (HT, Node); + HT.Nodes (Node).Has_Element := True; end Generic_Allocate; package body Generic_Keys with SPARK_Mode => Off is @@ -815,7 +804,7 @@ is -- Local Instantiations -- -------------------------- - package Key_Keys is new Hash_Tables.Generic_Bounded_Keys + package Key_Keys is new Hash_Tables.Generic_Formal_Keys (HT_Types => HT_Types, Next => Next, Set_Next => Set_Next, @@ -1031,11 +1020,11 @@ is end Insert; procedure Insert (Container : in out Set; New_Item : Element_Type) is - Inserted : Boolean; - Position : Cursor; + Inserted : Boolean; + Unused_Position : Cursor; begin - Insert (Container, New_Item, Position, Inserted); + Insert (Container, New_Item, Unused_Position, Inserted); if not Inserted then raise Constraint_Error with @@ -1052,7 +1041,9 @@ is procedure Allocate_Set_Element (Node : in out Node_Type); pragma Inline (Allocate_Set_Element); - function New_Node return Count_Type; + procedure New_Node + (HT : in out Hash_Table_Type; + Node : out Count_Type); pragma Inline (New_Node); procedure Local_Insert is @@ -1074,11 +1065,12 @@ is -- New_Node -- -------------- - function New_Node return Count_Type is - Result : Count_Type; + procedure New_Node + (HT : in out Hash_Table_Type; + Node : out Count_Type) + is begin - Allocate (Container, Result); - return Result; + Allocate (HT, Node); end New_Node; -- Start of processing for Insert @@ -1096,10 +1088,6 @@ is TN : Nodes_Type renames Target.Content.Nodes; begin - if Target'Address = Source'Address then - return; - end if; - if Source.Content.Length = 0 then Clear (Target); return; @@ -1133,13 +1121,13 @@ is ------------- procedure Process (L_Node : Count_Type) is - E : Element_Type renames Left.Content.Nodes (L_Node).Element; - X : Count_Type; - B : Boolean; + E : Element_Type renames Left.Content.Nodes (L_Node).Element; + Unused_X : Count_Type; + B : Boolean; begin if Find (Right, E).Node /= 0 then - Insert (Target, E, X, B); + Insert (Target, E, Unused_X, B); pragma Assert (B); end if; end Process; @@ -1151,17 +1139,11 @@ is end Intersection; function Intersection (Left : Set; Right : Set) return Set is - C : Count_Type; - H : Hash_Type; + C : constant Count_Type := + Count_Type'Min (Length (Left), Length (Right)); -- ??? + H : constant Hash_Type := Default_Modulus (C); begin - if Left'Address = Right'Address then - return Copy (Left); - end if; - - C := Count_Type'Min (Length (Left), Length (Right)); -- ??? - H := Default_Modulus (C); - return S : Set (C, H) do if Length (Left) /= 0 and Length (Right) /= 0 then Intersection (Left, Right, Target => S); @@ -1196,10 +1178,6 @@ is Subset_Nodes : Nodes_Type renames Subset.Content.Nodes; begin - if Subset'Address = Of_Set'Address then - return True; - end if; - if Length (Subset) > Length (Of_Set) then return False; end if; @@ -1207,7 +1185,8 @@ is Subset_Node := First (Subset).Node; while Subset_Node /= 0 loop declare - N : Node_Type renames Subset_Nodes (Subset_Node); + S : constant Count_Type := Subset_Node; + N : Node_Type renames Subset_Nodes (S); E : Element_Type renames N.Element; begin @@ -1242,10 +1221,6 @@ is X, Y : Count_Type; begin - if Target'Address = Source'Address then - return; - end if; - if Target.Capacity < Length (Source) then raise Constraint_Error with -- ??? "Source length exceeds Target capacity"; @@ -1312,14 +1287,11 @@ is return False; end if; - if Left'Address = Right'Address then - return True; - end if; - Left_Node := First (Left).Node; while Left_Node /= 0 loop declare - N : Node_Type renames Left_Nodes (Left_Node); + L : constant Count_Type := Left_Node; + N : Node_Type renames Left_Nodes (L); E : Element_Type renames N.Element; begin if Find (Right, E).Node /= 0 then @@ -1416,15 +1388,15 @@ is ------------- procedure Process (Source_Node : Count_Type) is - B : Boolean; - N : Node_Type renames Source.Content.Nodes (Source_Node); - X : Count_Type; + B : Boolean; + N : Node_Type renames Source.Content.Nodes (Source_Node); + Unused_X : Count_Type; begin if Is_In (Target, N) then Delete (Target, N.Element); else - Insert (Target, N.Element, X, B); + Insert (Target, N.Element, Unused_X, B); pragma Assert (B); end if; end Process; @@ -1432,11 +1404,6 @@ is -- Start of processing for Symmetric_Difference begin - if Target'Address = Source'Address then - Clear (Target); - return; - end if; - if Length (Target) = 0 then Assign (Target, Source); return; @@ -1446,14 +1413,7 @@ is end Symmetric_Difference; function Symmetric_Difference (Left : Set; Right : Set) return Set is - C : Count_Type; - H : Hash_Type; - begin - if Left'Address = Right'Address then - return Empty_Set; - end if; - if Length (Right) = 0 then return Copy (Left); end if; @@ -1462,13 +1422,15 @@ is return Copy (Right); end if; - C := Length (Left) + Length (Right); - H := Default_Modulus (C); - - return S : Set (C, H) do - Difference (Left, Right, S); - Difference (Right, Left, S); - end return; + declare + C : constant Count_Type := Length (Left) + Length (Right); + H : constant Hash_Type := Default_Modulus (C); + begin + return S : Set (C, H) do + Difference (Left, Right, S); + Difference (Right, Left, S); + end return; + end; end Symmetric_Difference; ------------ @@ -1476,12 +1438,12 @@ is ------------ function To_Set (New_Item : Element_Type) return Set is - X : Count_Type; - B : Boolean; + Unused_X : Count_Type; + B : Boolean; begin return S : Set (Capacity => 1, Modulus => 1) do - Insert (S, New_Item, X, B); + Insert (S, New_Item, Unused_X, B); pragma Assert (B); end return; end To_Set; @@ -1504,32 +1466,21 @@ is N : Node_Type renames Source.Content.Nodes (Src_Node); E : Element_Type renames N.Element; - X : Count_Type; - B : Boolean; + Unused_X : Count_Type; + Unused_B : Boolean; begin - Insert (Target, E, X, B); + Insert (Target, E, Unused_X, Unused_B); end Process; -- Start of processing for Union begin - if Target'Address = Source'Address then - return; - end if; - Iterate (Source.Content); end Union; function Union (Left : Set; Right : Set) return Set is - C : Count_Type; - H : Hash_Type; - begin - if Left'Address = Right'Address then - return Copy (Left); - end if; - if Length (Right) = 0 then return Copy (Left); end if; @@ -1538,12 +1489,15 @@ is return Copy (Right); end if; - C := Length (Left) + Length (Right); - H := Default_Modulus (C); - return S : Set (C, H) do - Assign (Target => S, Source => Left); - Union (Target => S, Source => Right); - end return; + declare + C : constant Count_Type := Length (Left) + Length (Right); + H : constant Hash_Type := Default_Modulus (C); + begin + return S : Set (C, H) do + Assign (Target => S, Source => Left); + Union (Target => S, Source => Right); + end return; + end; end Union; --------- diff --git a/gcc/ada/libgnat/a-cfhase.ads b/gcc/ada/libgnat/a-cfhase.ads index 425824d..1a40118 100644 --- a/gcc/ada/libgnat/a-cfhase.ads +++ b/gcc/ada/libgnat/a-cfhase.ads @@ -1479,7 +1479,7 @@ private end record; package HT_Types is new - Ada.Containers.Hash_Tables.Generic_Bounded_Hash_Table_Types (Node_Type); + Ada.Containers.Hash_Tables.Generic_Formal_Hash_Table_Types (Node_Type); type Set (Capacity : Count_Type; Modulus : Hash_Type) is record Content : HT_Types.Hash_Table_Type (Capacity, Modulus); diff --git a/gcc/ada/libgnat/a-chtgfk.adb b/gcc/ada/libgnat/a-chtgfk.adb new file mode 100644 index 0000000..7d355e0 --- /dev/null +++ b/gcc/ada/libgnat/a-chtgfk.adb @@ -0,0 +1,278 @@ +------------------------------------------------------------------------------ +-- -- +-- GNAT LIBRARY COMPONENTS -- +-- -- +-- ADA.CONTAINERS.HASH_TABLES.GENERIC_FORMAL_KEYS -- +-- -- +-- B o d y -- +-- -- +-- Copyright (C) 2004-2022, 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/>. -- +-- -- +-- This unit was originally developed by Matthew J Heaney. -- +------------------------------------------------------------------------------ + +package body Ada.Containers.Hash_Tables.Generic_Formal_Keys is + + Checks : constant Boolean := Container_Checks'Enabled; + + -------------------------- + -- Delete_Key_Sans_Free -- + -------------------------- + + procedure Delete_Key_Sans_Free + (HT : in out Hash_Table_Type; + Key : Key_Type; + X : out Count_Type) + is + Indx : Hash_Type; + Prev : Count_Type; + + begin + if HT.Length = 0 then + X := 0; + return; + end if; + + Indx := Index (HT, Key); + X := HT.Buckets (Indx); + + if X = 0 then + return; + end if; + + if Equivalent_Keys (Key, HT.Nodes (X)) then + HT.Buckets (Indx) := Next (HT.Nodes (X)); + HT.Length := HT.Length - 1; + return; + end if; + + loop + Prev := X; + X := Next (HT.Nodes (Prev)); + + if X = 0 then + return; + end if; + + if Equivalent_Keys (Key, HT.Nodes (X)) then + Set_Next (HT.Nodes (Prev), Next => Next (HT.Nodes (X))); + HT.Length := HT.Length - 1; + return; + end if; + end loop; + end Delete_Key_Sans_Free; + + ---------- + -- Find -- + ---------- + + function Find + (HT : Hash_Table_Type; + Key : Key_Type) return Count_Type + is + Indx : Hash_Type; + Node : Count_Type; + + begin + if HT.Length = 0 then + return 0; + end if; + + Indx := Index (HT, Key); + + Node := HT.Buckets (Indx); + while Node /= 0 loop + if Equivalent_Keys (Key, HT.Nodes (Node)) then + return Node; + end if; + Node := Next (HT.Nodes (Node)); + end loop; + + return 0; + end Find; + + -------------------------------- + -- Generic_Conditional_Insert -- + -------------------------------- + + procedure Generic_Conditional_Insert + (HT : in out Hash_Table_Type; + Key : Key_Type; + Node : out Count_Type; + Inserted : out Boolean) + is + Indx : Hash_Type; + + begin + Indx := Index (HT, Key); + Node := HT.Buckets (Indx); + + if Node = 0 then + if Checks and then HT.Length = HT.Capacity then + raise Capacity_Error with "no more capacity for insertion"; + end if; + + New_Node (HT, Node); + Set_Next (HT.Nodes (Node), Next => 0); + + Inserted := True; + + HT.Buckets (Indx) := Node; + HT.Length := HT.Length + 1; + + return; + end if; + + loop + if Equivalent_Keys (Key, HT.Nodes (Node)) then + Inserted := False; + return; + end if; + + Node := Next (HT.Nodes (Node)); + + exit when Node = 0; + end loop; + + if Checks and then HT.Length = HT.Capacity then + raise Capacity_Error with "no more capacity for insertion"; + end if; + + New_Node (HT, Node); + Set_Next (HT.Nodes (Node), Next => HT.Buckets (Indx)); + + Inserted := True; + + HT.Buckets (Indx) := Node; + HT.Length := HT.Length + 1; + end Generic_Conditional_Insert; + + ----------------------------- + -- Generic_Replace_Element -- + ----------------------------- + + procedure Generic_Replace_Element + (HT : in out Hash_Table_Type; + Node : Count_Type; + Key : Key_Type) + is + pragma Assert (HT.Length > 0); + pragma Assert (Node /= 0); + + BB : Buckets_Type renames HT.Buckets; + NN : Nodes_Type renames HT.Nodes; + + Old_Indx : Hash_Type; + New_Indx : constant Hash_Type := Index (HT, Key); + + New_Bucket : Count_Type renames BB (New_Indx); + N, M : Count_Type; + + begin + Old_Indx := HT.Buckets'First + Hash (NN (Node)) mod HT.Buckets'Length; + + -- Replace_Element is allowed to change a node's key to Key + -- (generic formal operation Assign provides the mechanism), but + -- only if Key is not already in the hash table. (In a unique-key + -- hash table as this one, a key is mapped to exactly one node.) + + if Equivalent_Keys (Key, NN (Node)) then + -- The new Key value is mapped to this same Node, so Node + -- stays in the same bucket. + + Assign (NN (Node), Key); + return; + end if; + + -- Key is not equivalent to Node, so we now have to determine if it's + -- equivalent to some other node in the hash table. This is the case + -- irrespective of whether Key is in the same or a different bucket from + -- Node. + + N := New_Bucket; + while N /= 0 loop + if Checks and then Equivalent_Keys (Key, NN (N)) then + pragma Assert (N /= Node); + raise Program_Error with + "attempt to replace existing element"; + end if; + + N := Next (NN (N)); + end loop; + + -- We have determined that Key is not already in the hash table, so + -- the change is allowed. + + if Old_Indx = New_Indx then + -- The node is already in the bucket implied by Key. In this case + -- we merely change its value without moving it. + + Assign (NN (Node), Key); + return; + end if; + + -- The node is in a bucket different from the bucket implied by Key. + -- Do the assignment first, before moving the node, so that if Assign + -- propagates an exception, then the hash table will not have been + -- modified (except for any possible side-effect Assign had on Node). + + Assign (NN (Node), Key); + + -- Now we can safely remove the node from its current bucket + + N := BB (Old_Indx); -- get value of first node in old bucket + pragma Assert (N /= 0); + + if N = Node then -- node is first node in its bucket + BB (Old_Indx) := Next (NN (Node)); + + else + pragma Assert (HT.Length > 1); + + loop + M := Next (NN (N)); + pragma Assert (M /= 0); + + if M = Node then + Set_Next (NN (N), Next => Next (NN (Node))); + exit; + end if; + + N := M; + end loop; + end if; + + -- Now we link the node into its new bucket (corresponding to Key) + + Set_Next (NN (Node), Next => New_Bucket); + New_Bucket := Node; + end Generic_Replace_Element; + + ----------- + -- Index -- + ----------- + + function Index + (HT : Hash_Table_Type; + Key : Key_Type) return Hash_Type is + begin + return HT.Buckets'First + Hash (Key) mod HT.Buckets'Length; + end Index; + +end Ada.Containers.Hash_Tables.Generic_Formal_Keys; diff --git a/gcc/ada/libgnat/a-chtgfk.ads b/gcc/ada/libgnat/a-chtgfk.ads new file mode 100644 index 0000000..363eaf0 --- /dev/null +++ b/gcc/ada/libgnat/a-chtgfk.ads @@ -0,0 +1,101 @@ +------------------------------------------------------------------------------ +-- -- +-- GNAT LIBRARY COMPONENTS -- +-- -- +-- ADA.CONTAINERS.HASH_TABLES.GENERIC_FORMAL_KEYS -- +-- -- +-- S p e c -- +-- -- +-- Copyright (C) 2004-2022, 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/>. -- +-- -- +-- This unit was originally developed by Matthew J Heaney. -- +------------------------------------------------------------------------------ + +-- Hash_Table_Type is used to implement hashed containers. This package +-- declares hash-table operations that depend on keys. + +generic + with package HT_Types is + new Generic_Formal_Hash_Table_Types (<>); + + use HT_Types; + + with function Next (Node : Node_Type) return Count_Type; + + with procedure Set_Next + (Node : in out Node_Type; + Next : Count_Type); + + type Key_Type (<>) is limited private; + + with function Hash (Key : Key_Type) return Hash_Type; + + with function Equivalent_Keys + (Key : Key_Type; + Node : Node_Type) return Boolean; + +package Ada.Containers.Hash_Tables.Generic_Formal_Keys is + pragma Pure; + + function Index + (HT : Hash_Table_Type; + Key : Key_Type) return Hash_Type; + pragma Inline (Index); + -- Returns the bucket number (array index value) for the given key + + procedure Delete_Key_Sans_Free + (HT : in out Hash_Table_Type; + Key : Key_Type; + X : out Count_Type); + -- Removes the node (if any) with the given key from the hash table + + function Find + (HT : Hash_Table_Type; + Key : Key_Type) return Count_Type; + -- Returns the node (if any) corresponding to the given key + + generic + with procedure New_Node + (HT : in out Hash_Table_Type; + Node : out Count_Type); + procedure Generic_Conditional_Insert + (HT : in out Hash_Table_Type; + Key : Key_Type; + Node : out Count_Type; + Inserted : out Boolean); + -- Attempts to insert a new node with the given key into the hash table. + -- If a node with that key already exists in the table, then that node + -- is returned and Inserted returns False. Otherwise New_Node is called + -- to allocate a new node, and Inserted returns True. + + generic + with function Hash (Node : Node_Type) return Hash_Type; + with procedure Assign (Node : in out Node_Type; Key : Key_Type); + procedure Generic_Replace_Element + (HT : in out Hash_Table_Type; + Node : Count_Type; + Key : Key_Type); + -- Assigns Key to Node, possibly changing its equivalence class. Procedure + -- Assign is called to assign Key to Node. If Node is not in the same + -- bucket as Key before the assignment, it is moved from its current bucket + -- to the bucket implied by Key. Note that it is never proper to assign to + -- Node a key value already in the hash table, and so if Key is equivalent + -- to some other node then Program_Error is raised. + +end Ada.Containers.Hash_Tables.Generic_Formal_Keys; diff --git a/gcc/ada/libgnat/a-chtgfo.adb b/gcc/ada/libgnat/a-chtgfo.adb new file mode 100644 index 0000000..d688863 --- /dev/null +++ b/gcc/ada/libgnat/a-chtgfo.adb @@ -0,0 +1,481 @@ +------------------------------------------------------------------------------ +-- -- +-- GNAT LIBRARY COMPONENTS -- +-- -- +-- ADA.CONTAINERS.HASH_TABLES.GENERIC_FORMAL_OPERATIONS -- +-- -- +-- B o d y -- +-- -- +-- Copyright (C) 2004-2022, 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/>. -- +-- -- +-- This unit was originally developed by Matthew J Heaney. -- +------------------------------------------------------------------------------ + +with System; use type System.Address; + +package body Ada.Containers.Hash_Tables.Generic_Formal_Operations is + + Checks : constant Boolean := Container_Checks'Enabled; + + ----------- + -- Clear -- + ----------- + + procedure Clear (HT : in out Hash_Table_Type) is + begin + HT.Length := 0; + HT.Free := -1; + HT.Buckets := [others => 0]; -- optimize this somehow ??? + end Clear; + + --------------------------- + -- Delete_Node_Sans_Free -- + --------------------------- + + procedure Delete_Node_Sans_Free + (HT : in out Hash_Table_Type; + X : Count_Type) + is + pragma Assert (X /= 0); + + Indx : Hash_Type; + Prev : Count_Type; + Curr : Count_Type; + + begin + if Checks and then HT.Length = 0 then + raise Program_Error with + "attempt to delete node from empty hashed container"; + end if; + + Indx := Index (HT, HT.Nodes (X)); + Prev := HT.Buckets (Indx); + + if Checks and then Prev = 0 then + raise Program_Error with + "attempt to delete node from empty hash bucket"; + end if; + + if Prev = X then + HT.Buckets (Indx) := Next (HT.Nodes (Prev)); + HT.Length := HT.Length - 1; + return; + end if; + + if Checks and then HT.Length = 1 then + raise Program_Error with + "attempt to delete node not in its proper hash bucket"; + end if; + + loop + Curr := Next (HT.Nodes (Prev)); + + if Checks and then Curr = 0 then + raise Program_Error with + "attempt to delete node not in its proper hash bucket"; + end if; + + if Curr = X then + Set_Next (HT.Nodes (Prev), Next => Next (HT.Nodes (Curr))); + HT.Length := HT.Length - 1; + return; + end if; + + Prev := Curr; + end loop; + end Delete_Node_Sans_Free; + + ----------- + -- First -- + ----------- + + function First (HT : Hash_Table_Type) return Count_Type is + Indx : Hash_Type; + + begin + if HT.Length = 0 then + return 0; + end if; + + Indx := HT.Buckets'First; + loop + if HT.Buckets (Indx) /= 0 then + return HT.Buckets (Indx); + end if; + + Indx := Indx + 1; + end loop; + end First; + + ---------- + -- Free -- + ---------- + + procedure Free + (HT : in out Hash_Table_Type; + X : Count_Type) + is + N : Nodes_Type renames HT.Nodes; + + begin + -- This subprogram "deallocates" a node by relinking the node off of the + -- active list and onto the free list. Previously it would flag index + -- value 0 as an error. The precondition was weakened, so that index + -- value 0 is now allowed, and this value is interpreted to mean "do + -- nothing". This makes its behavior analogous to the behavior of + -- Ada.Unchecked_Deallocation, and allows callers to avoid having to add + -- special-case checks at the point of call. + + if X = 0 then + return; + end if; + + pragma Assert (X <= HT.Capacity); + + -- pragma Assert (N (X).Prev >= 0); -- node is active + -- Find a way to mark a node as active vs. inactive; we could + -- use a special value in Color_Type for this. ??? + + -- The hash table actually contains two data structures: a list for + -- the "active" nodes that contain elements that have been inserted + -- onto the container, and another for the "inactive" nodes of the free + -- store. + -- + -- We desire that merely declaring an object should have only minimal + -- cost; specially, we want to avoid having to initialize the free + -- store (to fill in the links), especially if the capacity is large. + -- + -- The head of the free list is indicated by Container.Free. If its + -- value is non-negative, then the free store has been initialized + -- in the "normal" way: Container.Free points to the head of the list + -- of free (inactive) nodes, and the value 0 means the free list is + -- empty. Each node on the free list has been initialized to point + -- to the next free node (via its Next component), and the value 0 + -- means that this is the last free node. + -- + -- If Container.Free is negative, then the links on the free store + -- have not been initialized. In this case the link values are + -- implied: the free store comprises the components of the node array + -- started with the absolute value of Container.Free, and continuing + -- until the end of the array (Nodes'Last). + -- + -- ??? + -- It might be possible to perform an optimization here. Suppose that + -- the free store can be represented as having two parts: one + -- comprising the non-contiguous inactive nodes linked together + -- in the normal way, and the other comprising the contiguous + -- inactive nodes (that are not linked together, at the end of the + -- nodes array). This would allow us to never have to initialize + -- the free store, except in a lazy way as nodes become inactive. + + -- When an element is deleted from the list container, its node + -- becomes inactive, and so we set its Next component to value of + -- the node's index (in the nodes array), to indicate that it is + -- now inactive. This provides a useful way to detect a dangling + -- cursor reference. ??? + + Set_Next (N (X), Next => X); -- Node is deallocated (not on active list) + + if HT.Free >= 0 then + -- The free store has previously been initialized. All we need to + -- do here is link the newly-free'd node onto the free list. + + Set_Next (N (X), HT.Free); + HT.Free := X; + + elsif X + 1 = abs HT.Free then + -- The free store has not been initialized, and the node becoming + -- inactive immediately precedes the start of the free store. All + -- we need to do is move the start of the free store back by one. + + HT.Free := HT.Free + 1; + + else + -- The free store has not been initialized, and the node becoming + -- inactive does not immediately precede the free store. Here we + -- first initialize the free store (meaning the links are given + -- values in the traditional way), and then link the newly-free'd + -- node onto the head of the free store. + + -- ??? + -- See the comments above for an optimization opportunity. If + -- the next link for a node on the free store is negative, then + -- this means the remaining nodes on the free store are + -- physically contiguous, starting as the absolute value of + -- that index value. + + HT.Free := abs HT.Free; + + if HT.Free > HT.Capacity then + HT.Free := 0; + + else + for I in HT.Free .. HT.Capacity - 1 loop + Set_Next (Node => N (I), Next => I + 1); + end loop; + + Set_Next (Node => N (HT.Capacity), Next => 0); + end if; + + Set_Next (Node => N (X), Next => HT.Free); + HT.Free := X; + end if; + end Free; + + ---------------------- + -- Generic_Allocate -- + ---------------------- + + procedure Generic_Allocate + (HT : in out Hash_Table_Type; + Node : out Count_Type) + is + N : Nodes_Type renames HT.Nodes; + + begin + if HT.Free >= 0 then + Node := HT.Free; + + -- We always perform the assignment first, before we + -- change container state, in order to defend against + -- exceptions duration assignment. + + Set_Element (N (Node)); + HT.Free := Next (N (Node)); + + else + -- A negative free store value means that the links of the nodes + -- in the free store have not been initialized. In this case, the + -- nodes are physically contiguous in the array, starting at the + -- index that is the absolute value of the Container.Free, and + -- continuing until the end of the array (Nodes'Last). + + Node := abs HT.Free; + + -- As above, we perform this assignment first, before modifying + -- any container state. + + Set_Element (N (Node)); + HT.Free := HT.Free - 1; + end if; + end Generic_Allocate; + + ------------------- + -- Generic_Equal -- + ------------------- + + function Generic_Equal + (L, R : Hash_Table_Type) return Boolean + is + L_Index : Hash_Type; + L_Node : Count_Type; + + N : Count_Type; + + begin + if L.Length /= R.Length then + return False; + end if; + + if L.Length = 0 then + return True; + end if; + + -- Find the first node of hash table L + + L_Index := L.Buckets'First; + loop + L_Node := L.Buckets (L_Index); + exit when L_Node /= 0; + L_Index := L_Index + 1; + end loop; + + -- For each node of hash table L, search for an equivalent node in hash + -- table R. + + N := L.Length; + loop + if not Find (HT => R, Key => L.Nodes (L_Node)) then + return False; + end if; + + N := N - 1; + + L_Node := Next (L.Nodes (L_Node)); + + if L_Node = 0 then + + -- We have exhausted the nodes in this bucket + + if N = 0 then + return True; + end if; + + -- Find the next bucket + + loop + L_Index := L_Index + 1; + L_Node := L.Buckets (L_Index); + exit when L_Node /= 0; + end loop; + end if; + end loop; + end Generic_Equal; + + ----------------------- + -- Generic_Iteration -- + ----------------------- + + procedure Generic_Iteration (HT : Hash_Table_Type) is + Node : Count_Type; + + begin + if HT.Length = 0 then + return; + end if; + + for Indx in HT.Buckets'Range loop + Node := HT.Buckets (Indx); + while Node /= 0 loop + Process (Node); + Node := Next (HT.Nodes (Node)); + end loop; + end loop; + end Generic_Iteration; + + ------------------ + -- Generic_Read -- + ------------------ + + procedure Generic_Read + (Stream : not null access Root_Stream_Type'Class; + HT : out Hash_Table_Type) + is + N : Count_Type'Base; + + begin + Clear (HT); + + Count_Type'Base'Read (Stream, N); + + if Checks and then N < 0 then + raise Program_Error with "stream appears to be corrupt"; + end if; + + if N = 0 then + return; + end if; + + if Checks and then N > HT.Capacity then + raise Capacity_Error with "too many elements in stream"; + end if; + + for J in 1 .. N loop + declare + Node : constant Count_Type := New_Node (Stream); + Indx : constant Hash_Type := Index (HT, HT.Nodes (Node)); + B : Count_Type renames HT.Buckets (Indx); + begin + Set_Next (HT.Nodes (Node), Next => B); + B := Node; + end; + + HT.Length := HT.Length + 1; + end loop; + end Generic_Read; + + ------------------- + -- Generic_Write -- + ------------------- + + procedure Generic_Write + (Stream : not null access Root_Stream_Type'Class; + HT : Hash_Table_Type) + is + procedure Write (Node : Count_Type); + pragma Inline (Write); + + procedure Write is new Generic_Iteration (Write); + + ----------- + -- Write -- + ----------- + + procedure Write (Node : Count_Type) is + begin + Write (Stream, HT.Nodes (Node)); + end Write; + + begin + Count_Type'Base'Write (Stream, HT.Length); + Write (HT); + end Generic_Write; + + ----------- + -- Index -- + ----------- + + function Index + (Buckets : Buckets_Type; + Node : Node_Type) return Hash_Type is + begin + return Buckets'First + Hash_Node (Node) mod Buckets'Length; + end Index; + + function Index + (HT : Hash_Table_Type; + Node : Node_Type) return Hash_Type is + begin + return Index (HT.Buckets, Node); + end Index; + + ---------- + -- Next -- + ---------- + + function Next + (HT : Hash_Table_Type; + Node : Count_Type) return Count_Type + is + Result : Count_Type; + First : Hash_Type; + + begin + Result := Next (HT.Nodes (Node)); + + if Result /= 0 then -- another node in same bucket + return Result; + end if; + + -- This was the last node in the bucket, so move to the next + -- bucket, and start searching for next node from there. + + First := Index (HT, HT.Nodes (Node)) + 1; + for Indx in First .. HT.Buckets'Last loop + Result := HT.Buckets (Indx); + + if Result /= 0 then -- bucket is not empty + return Result; + end if; + end loop; + + return 0; + end Next; + +end Ada.Containers.Hash_Tables.Generic_Formal_Operations; diff --git a/gcc/ada/libgnat/a-chtgfo.ads b/gcc/ada/libgnat/a-chtgfo.ads new file mode 100644 index 0000000..043b732 --- /dev/null +++ b/gcc/ada/libgnat/a-chtgfo.ads @@ -0,0 +1,138 @@ +------------------------------------------------------------------------------ +-- -- +-- GNAT LIBRARY COMPONENTS -- +-- -- +-- ADA.CONTAINERS.HASH_TABLES.GENERIC_FORMAL_OPERATIONS -- +-- -- +-- S p e c -- +-- -- +-- Copyright (C) 2004-2022, 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/>. -- +-- -- +-- This unit was originally developed by Matthew J Heaney. -- +------------------------------------------------------------------------------ + +-- Hash_Table_Type is used to implement hashed containers. This package +-- declares hash-table operations that do not depend on keys. + +with Ada.Streams; + +generic + with package HT_Types is + new Generic_Formal_Hash_Table_Types (<>); + + use HT_Types; + + with function Hash_Node (Node : Node_Type) return Hash_Type; + + with function Next (Node : Node_Type) return Count_Type; + + with procedure Set_Next + (Node : in out Node_Type; + Next : Count_Type); + +package Ada.Containers.Hash_Tables.Generic_Formal_Operations is + pragma Pure; + + function Index + (Buckets : Buckets_Type; + Node : Node_Type) return Hash_Type; + pragma Inline (Index); + -- Uses the hash value of Node to compute its Buckets array index + + function Index + (HT : Hash_Table_Type; + Node : Node_Type) return Hash_Type; + pragma Inline (Index); + -- Uses the hash value of Node to compute its Hash_Table buckets array + -- index. + + generic + with function Find + (HT : Hash_Table_Type; + Key : Node_Type) return Boolean; + function Generic_Equal (L, R : Hash_Table_Type) return Boolean; + -- Used to implement hashed container equality. For each node in hash table + -- L, it calls Find to search for an equivalent item in hash table R. If + -- Find returns False for any node then Generic_Equal terminates + -- immediately and returns False. Otherwise if Find returns True for every + -- node then Generic_Equal returns True. + + procedure Clear (HT : in out Hash_Table_Type); + -- Empties the hash table HT + + procedure Delete_Node_Sans_Free + (HT : in out Hash_Table_Type; + X : Count_Type); + -- Removes node X from the hash table without deallocating the node + + generic + with procedure Set_Element (Node : in out Node_Type); + procedure Generic_Allocate + (HT : in out Hash_Table_Type; + Node : out Count_Type); + -- Claim a node from the free store. Generic_Allocate first + -- calls Set_Element on the potential node, and then returns + -- the node's index as the value of the Node parameter. + + procedure Free + (HT : in out Hash_Table_Type; + X : Count_Type); + -- Return a node back to the free store, from where it had + -- been previously claimed via Generic_Allocate. + + function First (HT : Hash_Table_Type) return Count_Type; + -- Returns the head of the list in the first (lowest-index) non-empty + -- bucket. + + function Next + (HT : Hash_Table_Type; + Node : Count_Type) return Count_Type; + -- Returns the node that immediately follows Node. This corresponds to + -- either the next node in the same bucket, or (if Node is the last node in + -- its bucket) the head of the list in the first non-empty bucket that + -- follows. + + generic + with procedure Process (Node : Count_Type); + procedure Generic_Iteration (HT : Hash_Table_Type); + -- Calls Process for each node in hash table HT + + generic + use Ada.Streams; + with procedure Write + (Stream : not null access Root_Stream_Type'Class; + Node : Node_Type); + procedure Generic_Write + (Stream : not null access Root_Stream_Type'Class; + HT : Hash_Table_Type); + -- Used to implement the streaming attribute for hashed containers. It + -- calls Write for each node to write its value into Stream. + + generic + use Ada.Streams; + with function New_Node (Stream : not null access Root_Stream_Type'Class) + return Count_Type; + procedure Generic_Read + (Stream : not null access Root_Stream_Type'Class; + HT : out Hash_Table_Type); + -- Used to implement the streaming attribute for hashed containers. It + -- first clears hash table HT, then populates the hash table by calling + -- New_Node for each item in Stream. + +end Ada.Containers.Hash_Tables.Generic_Formal_Operations; diff --git a/gcc/ada/libgnat/a-coboho.adb b/gcc/ada/libgnat/a-coboho.adb index db885b4..25d0777 100644 --- a/gcc/ada/libgnat/a-coboho.adb +++ b/gcc/ada/libgnat/a-coboho.adb @@ -25,7 +25,7 @@ -- <http://www.gnu.org/licenses/>. -- ------------------------------------------------------------------------------ -with Unchecked_Conversion; +with Ada.Unchecked_Conversion; with System.Put_Images; package body Ada.Containers.Bounded_Holders is @@ -54,7 +54,7 @@ package body Ada.Containers.Bounded_Holders is end Size_In_Storage_Elements; function Cast is new - Unchecked_Conversion (System.Address, Element_Access); + Ada.Unchecked_Conversion (System.Address, Element_Access); --------- -- "=" -- diff --git a/gcc/ada/libgnat/a-cohata.ads b/gcc/ada/libgnat/a-cohata.ads index 2c56321..b9f775f 100644 --- a/gcc/ada/libgnat/a-cohata.ads +++ b/gcc/ada/libgnat/a-cohata.ads @@ -79,4 +79,23 @@ package Ada.Containers.Hash_Tables is package Implementation is new Helpers.Generic_Implementation; end Generic_Bounded_Hash_Table_Types; + generic + type Node_Type is private; + package Generic_Formal_Hash_Table_Types is + + type Nodes_Type is array (Count_Type range <>) of Node_Type; + type Buckets_Type is array (Hash_Type range <>) of Count_Type; + + type Hash_Table_Type + (Capacity : Count_Type; + Modulus : Hash_Type) is + record + Length : Count_Type := 0; + Free : Count_Type'Base := -1; + Nodes : Nodes_Type (1 .. Capacity); + Buckets : Buckets_Type (1 .. Modulus) := [others => 0]; + end record; + + end Generic_Formal_Hash_Table_Types; + end Ada.Containers.Hash_Tables; diff --git a/gcc/ada/libgnat/a-direct.adb b/gcc/ada/libgnat/a-direct.adb index 2c07cc4..7a65587 100644 --- a/gcc/ada/libgnat/a-direct.adb +++ b/gcc/ada/libgnat/a-direct.adb @@ -38,7 +38,6 @@ use Ada.Directories.Hierarchical_File_Names; with Ada.Strings.Fixed; with Ada.Strings.Maps; use Ada.Strings.Maps; with Ada.Strings.Unbounded; use Ada.Strings.Unbounded; -with Ada.Unchecked_Conversion; with Ada.Unchecked_Deallocation; with Interfaces.C; diff --git a/gcc/ada/libgnat/a-strbou.ads b/gcc/ada/libgnat/a-strbou.ads index a9ee3b2..839760a 100644 --- a/gcc/ada/libgnat/a-strbou.ads +++ b/gcc/ada/libgnat/a-strbou.ads @@ -1898,7 +1898,7 @@ package Ada.Strings.Bounded with SPARK_Mode is -- some characters of Source are remaining at the left. and then - (if New_Item'Length > Max_Length then + (if New_Item'Length >= Max_Length then -- New_Item covers all Max_Length characters @@ -1984,7 +1984,7 @@ package Ada.Strings.Bounded with SPARK_Mode is -- some characters of Source are remaining at the left. and then - (if New_Item'Length > Max_Length then + (if New_Item'Length >= Max_Length then -- New_Item covers all Max_Length characters diff --git a/gcc/ada/libgnat/a-strsup.adb b/gcc/ada/libgnat/a-strsup.adb index 2c1b459..f1a40a2 100644 --- a/gcc/ada/libgnat/a-strsup.adb +++ b/gcc/ada/libgnat/a-strsup.adb @@ -1226,7 +1226,7 @@ package body Ada.Strings.Superbounded with SPARK_Mode is (New_Item (New_Item'First .. New_Item'Last - Droplen)); when Strings.Left => - if New_Item'Length > Max_Length then + if New_Item'Length >= Max_Length then Source.Data (1 .. Max_Length) := Super_String_Data (New_Item (New_Item'Last - Max_Length + 1 .. New_Item'Last)); diff --git a/gcc/ada/libgnat/a-strsup.ads b/gcc/ada/libgnat/a-strsup.ads index 19e333c..416fa7b 100644 --- a/gcc/ada/libgnat/a-strsup.ads +++ b/gcc/ada/libgnat/a-strsup.ads @@ -2000,7 +2000,7 @@ package Ada.Strings.Superbounded with SPARK_Mode is -- Source are remaining at the left. and then - (if New_Item'Length > Source.Max_Length then + (if New_Item'Length >= Source.Max_Length then -- New_Item covers all Max_Length characters @@ -2089,7 +2089,7 @@ package Ada.Strings.Superbounded with SPARK_Mode is -- Source are remaining at the left. and then - (if New_Item'Length > Source.Max_Length then + (if New_Item'Length >= Source.Max_Length then -- New_Item covers all Max_Length characters diff --git a/gcc/ada/libgnat/a-stuten.ads b/gcc/ada/libgnat/a-stuten.ads index 209c84a..618f5b0 100644 --- a/gcc/ada/libgnat/a-stuten.ads +++ b/gcc/ada/libgnat/a-stuten.ads @@ -36,8 +36,8 @@ -- UTF encoded strings. Note: this package is consistent with Ada 95, and may -- be used in Ada 95 or Ada 2005 mode. +with Ada.Unchecked_Conversion; with Interfaces; -with Unchecked_Conversion; package Ada.Strings.UTF_Encoding is pragma Pure (UTF_Encoding); @@ -106,13 +106,13 @@ package Ada.Strings.UTF_Encoding is private function To_Unsigned_8 is new - Unchecked_Conversion (Character, Interfaces.Unsigned_8); + Ada.Unchecked_Conversion (Character, Interfaces.Unsigned_8); function To_Unsigned_16 is new - Unchecked_Conversion (Wide_Character, Interfaces.Unsigned_16); + Ada.Unchecked_Conversion (Wide_Character, Interfaces.Unsigned_16); function To_Unsigned_32 is new - Unchecked_Conversion (Wide_Wide_Character, Interfaces.Unsigned_32); + Ada.Unchecked_Conversion (Wide_Wide_Character, Interfaces.Unsigned_32); subtype UTF_XE_Encoding is Encoding_Scheme range UTF_16BE .. UTF_16LE; -- Subtype containing only UTF_16BE and UTF_16LE entries diff --git a/gcc/ada/libgnat/a-swmwco.ads b/gcc/ada/libgnat/a-swmwco.ads index af11630..ed37718 100644 --- a/gcc/ada/libgnat/a-swmwco.ads +++ b/gcc/ada/libgnat/a-swmwco.ads @@ -66,27 +66,27 @@ private subtype WC is Wide_Character; Control_Ranges : aliased constant Wide_Character_Ranges := - [ (W.NUL, W.US), - (W.DEL, W.APC)]; + [(W.NUL, W.US), + (W.DEL, W.APC)]; Control_Set : constant Wide_Character_Set := (AF.Controlled with Control_Ranges'Unrestricted_Access); Graphic_Ranges : aliased constant Wide_Character_Ranges := - [ (W.Space, W.Tilde), - (WC'Val (256), WC'Last)]; + [(W.Space, W.Tilde), + (WC'Val (256), WC'Last)]; Graphic_Set : constant Wide_Character_Set := (AF.Controlled with Graphic_Ranges'Unrestricted_Access); Letter_Ranges : aliased constant Wide_Character_Ranges := - [ ('A', 'Z'), - (W.LC_A, W.LC_Z), - (W.UC_A_Grave, W.UC_O_Diaeresis), - (W.UC_O_Oblique_Stroke, W.LC_O_Diaeresis), - (W.LC_O_Oblique_Stroke, W.LC_Y_Diaeresis)]; + [('A', 'Z'), + (W.LC_A, W.LC_Z), + (W.UC_A_Grave, W.UC_O_Diaeresis), + (W.UC_O_Oblique_Stroke, W.LC_O_Diaeresis), + (W.LC_O_Oblique_Stroke, W.LC_Y_Diaeresis)]; Letter_Set : constant Wide_Character_Set := (AF.Controlled with @@ -126,7 +126,7 @@ private Basic_Ranges'Unrestricted_Access); Decimal_Digit_Ranges : aliased constant Wide_Character_Ranges := - [ ('0', '9')]; + [('0', '9')]; Decimal_Digit_Set : constant Wide_Character_Set := (AF.Controlled with @@ -167,14 +167,14 @@ private Special_Graphic_Ranges'Unrestricted_Access); ISO_646_Ranges : aliased constant Wide_Character_Ranges := - [ (W.NUL, W.DEL)]; + [(W.NUL, W.DEL)]; ISO_646_Set : constant Wide_Character_Set := (AF.Controlled with ISO_646_Ranges'Unrestricted_Access); Character_Ranges : aliased constant Wide_Character_Ranges := - [ (W.NUL, WC'Val (255))]; + [(W.NUL, WC'Val (255))]; Character_Set : constant Wide_Character_Set := (AF.Controlled with diff --git a/gcc/ada/libgnat/a-szmzco.ads b/gcc/ada/libgnat/a-szmzco.ads index 96d64b3..e8de549 100644 --- a/gcc/ada/libgnat/a-szmzco.ads +++ b/gcc/ada/libgnat/a-szmzco.ads @@ -66,27 +66,27 @@ private subtype WC is Wide_Wide_Character; Control_Ranges : aliased constant Wide_Wide_Character_Ranges := - [ (W.NUL, W.US), - (W.DEL, W.APC)]; + [(W.NUL, W.US), + (W.DEL, W.APC)]; Control_Set : constant Wide_Wide_Character_Set := (AF.Controlled with Control_Ranges'Unrestricted_Access); Graphic_Ranges : aliased constant Wide_Wide_Character_Ranges := - [ (W.Space, W.Tilde), - (WC'Val (256), WC'Last)]; + [(W.Space, W.Tilde), + (WC'Val (256), WC'Last)]; Graphic_Set : constant Wide_Wide_Character_Set := (AF.Controlled with Graphic_Ranges'Unrestricted_Access); Letter_Ranges : aliased constant Wide_Wide_Character_Ranges := - [ ('A', 'Z'), - (W.LC_A, W.LC_Z), - (W.UC_A_Grave, W.UC_O_Diaeresis), - (W.UC_O_Oblique_Stroke, W.LC_O_Diaeresis), - (W.LC_O_Oblique_Stroke, W.LC_Y_Diaeresis)]; + [('A', 'Z'), + (W.LC_A, W.LC_Z), + (W.UC_A_Grave, W.UC_O_Diaeresis), + (W.UC_O_Oblique_Stroke, W.LC_O_Diaeresis), + (W.LC_O_Oblique_Stroke, W.LC_Y_Diaeresis)]; Letter_Set : constant Wide_Wide_Character_Set := (AF.Controlled with @@ -126,7 +126,7 @@ private Basic_Ranges'Unrestricted_Access); Decimal_Digit_Ranges : aliased constant Wide_Wide_Character_Ranges := - [ ('0', '9')]; + [('0', '9')]; Decimal_Digit_Set : constant Wide_Wide_Character_Set := (AF.Controlled with @@ -167,14 +167,14 @@ private Special_Graphic_Ranges'Unrestricted_Access); ISO_646_Ranges : aliased constant Wide_Wide_Character_Ranges := - [ (W.NUL, W.DEL)]; + [(W.NUL, W.DEL)]; ISO_646_Set : constant Wide_Wide_Character_Set := (AF.Controlled with ISO_646_Ranges'Unrestricted_Access); Character_Ranges : aliased constant Wide_Wide_Character_Ranges := - [ (W.NUL, WC'Val (255))]; + [(W.NUL, WC'Val (255))]; Character_Set : constant Wide_Wide_Character_Set := (AF.Controlled with diff --git a/gcc/ada/libgnat/s-aridou.ads b/gcc/ada/libgnat/s-aridou.ads index 815865f..29e13a5 100644 --- a/gcc/ada/libgnat/s-aridou.ads +++ b/gcc/ada/libgnat/s-aridou.ads @@ -34,7 +34,6 @@ -- or intermediate results are longer than the result type. with Ada.Numerics.Big_Numbers.Big_Integers_Ghost; -use Ada.Numerics.Big_Numbers.Big_Integers_Ghost; generic @@ -67,20 +66,27 @@ is Contract_Cases => Ignore, Ghost => Ignore); - package Signed_Conversion is new Signed_Conversions (Int => Double_Int); + package BI_Ghost renames Ada.Numerics.Big_Numbers.Big_Integers_Ghost; + subtype Big_Integer is BI_Ghost.Big_Integer with Ghost; + subtype Big_Natural is BI_Ghost.Big_Natural with Ghost; + use type BI_Ghost.Big_Integer; + + package Signed_Conversion is + new BI_Ghost.Signed_Conversions (Int => Double_Int); function Big (Arg : Double_Int) return Big_Integer is (Signed_Conversion.To_Big_Integer (Arg)) with Ghost; - package Unsigned_Conversion is new Unsigned_Conversions (Int => Double_Uns); + package Unsigned_Conversion is + new BI_Ghost.Unsigned_Conversions (Int => Double_Uns); function Big (Arg : Double_Uns) return Big_Integer is (Unsigned_Conversion.To_Big_Integer (Arg)) with Ghost; function In_Double_Int_Range (Arg : Big_Integer) return Boolean is - (In_Range (Arg, Big (Double_Int'First), Big (Double_Int'Last))) + (BI_Ghost.In_Range (Arg, Big (Double_Int'First), Big (Double_Int'Last))) with Ghost; function Add_With_Ovflo_Check (X, Y : Double_Int) return Double_Int diff --git a/gcc/ada/libgnat/s-bignum.adb b/gcc/ada/libgnat/s-bignum.adb index 9377102..93f2229 100644 --- a/gcc/ada/libgnat/s-bignum.adb +++ b/gcc/ada/libgnat/s-bignum.adb @@ -29,7 +29,6 @@ -- -- ------------------------------------------------------------------------------ -with Ada.Unchecked_Conversion; with System.Generic_Bignums; with System.Secondary_Stack; use System.Secondary_Stack; with System.Shared_Bignums; use System.Shared_Bignums; diff --git a/gcc/ada/libgnat/s-exponn.ads b/gcc/ada/libgnat/s-exponn.ads index 2c95f60..5c6eeac 100644 --- a/gcc/ada/libgnat/s-exponn.ads +++ b/gcc/ada/libgnat/s-exponn.ads @@ -32,7 +32,6 @@ -- Signed integer exponentiation (checks off) with Ada.Numerics.Big_Numbers.Big_Integers_Ghost; -use Ada.Numerics.Big_Numbers.Big_Integers_Ghost; generic @@ -41,7 +40,6 @@ generic package System.Exponn with Pure, SPARK_Mode is - -- Preconditions in this unit are meant for analysis only, not for run-time -- checking, so that the expected exceptions are raised. This is enforced -- by setting the corresponding assertion policy to Ignore. Postconditions @@ -53,14 +51,18 @@ is Contract_Cases => Ignore, Ghost => Ignore); - package Signed_Conversion is new Signed_Conversions (Int => Int); + package BI_Ghost renames Ada.Numerics.Big_Numbers.Big_Integers_Ghost; + subtype Big_Integer is BI_Ghost.Big_Integer with Ghost; + use type BI_Ghost.Big_Integer; + + package Signed_Conversion is new BI_Ghost.Signed_Conversions (Int => Int); function Big (Arg : Int) return Big_Integer is (Signed_Conversion.To_Big_Integer (Arg)) with Ghost; function In_Int_Range (Arg : Big_Integer) return Boolean is - (In_Range (Arg, Big (Int'First), Big (Int'Last))) + (BI_Ghost.In_Range (Arg, Big (Int'First), Big (Int'Last))) with Ghost; function Expon (Left : Int; Right : Natural) return Int diff --git a/gcc/ada/libgnat/s-expont.ads b/gcc/ada/libgnat/s-expont.ads index 7ca43ab..99de227 100644 --- a/gcc/ada/libgnat/s-expont.ads +++ b/gcc/ada/libgnat/s-expont.ads @@ -32,7 +32,6 @@ -- Signed integer exponentiation (checks on) with Ada.Numerics.Big_Numbers.Big_Integers_Ghost; -use Ada.Numerics.Big_Numbers.Big_Integers_Ghost; generic @@ -41,7 +40,6 @@ generic package System.Expont with Pure, SPARK_Mode is - -- Preconditions in this unit are meant for analysis only, not for run-time -- checking, so that the expected exceptions are raised. This is enforced -- by setting the corresponding assertion policy to Ignore. Postconditions @@ -53,14 +51,18 @@ is Contract_Cases => Ignore, Ghost => Ignore); - package Signed_Conversion is new Signed_Conversions (Int => Int); + package BI_Ghost renames Ada.Numerics.Big_Numbers.Big_Integers_Ghost; + subtype Big_Integer is BI_Ghost.Big_Integer with Ghost; + use type BI_Ghost.Big_Integer; + + package Signed_Conversion is new BI_Ghost.Signed_Conversions (Int => Int); function Big (Arg : Int) return Big_Integer is (Signed_Conversion.To_Big_Integer (Arg)) with Ghost; function In_Int_Range (Arg : Big_Integer) return Boolean is - (In_Range (Arg, Big (Int'First), Big (Int'Last))) + (BI_Ghost.In_Range (Arg, Big (Int'First), Big (Int'Last))) with Ghost; function Expon (Left : Int; Right : Natural) return Int diff --git a/gcc/ada/libgnat/s-imagef.adb b/gcc/ada/libgnat/s-imagef.adb index 14e9d06..fd8e848 100644 --- a/gcc/ada/libgnat/s-imagef.adb +++ b/gcc/ada/libgnat/s-imagef.adb @@ -31,9 +31,24 @@ with System.Image_I; with System.Img_Util; use System.Img_Util; +with System.Val_Util; package body System.Image_F is + -- Contracts, ghost code, loop invariants and assertions in this unit are + -- meant for analysis only, not for run-time checking, as it would be too + -- costly otherwise. This is enforced by setting the assertion policy to + -- Ignore. + + pragma Assertion_Policy (Assert => Ignore, + Assert_And_Cut => Ignore, + Contract_Cases => Ignore, + Ghost => Ignore, + Loop_Invariant => Ignore, + Pre => Ignore, + Post => Ignore, + Subprogram_Variant => Ignore); + Maxdigs : constant Natural := Int'Width - 2; -- Maximum number of decimal digits that can be represented in an Int. -- The "-2" accounts for the sign and one extra digit, since we need the @@ -54,7 +69,70 @@ package body System.Image_F is -- if the small is larger than 1, and smaller than 2**(Int'Size - 1) / 10 -- if the small is smaller than 1. - package Image_I is new System.Image_I (Int); + -- Define ghost subprograms without implementation (marked as Import) to + -- create a suitable package Int_Params for type Int, as instantiations + -- of System.Image_F use for this type one of the derived integer types + -- defined in Interfaces, instead of the standard signed integer types + -- which are used to define System.Img_*.Int_Params. + + type Uns_Option (Overflow : Boolean := False) is record + case Overflow is + when True => + null; + when False => + Value : Uns := 0; + end case; + end record; + + Unsigned_Width_Ghost : constant Natural := Int'Width; + + function Wrap_Option (Value : Uns) return Uns_Option + with Ghost, Import; + function Only_Decimal_Ghost + (Str : String; + From, To : Integer) + return Boolean + with Ghost, Import; + function Hexa_To_Unsigned_Ghost (X : Character) return Uns + with Ghost, Import; + function Scan_Based_Number_Ghost + (Str : String; + From, To : Integer; + Base : Uns := 10; + Acc : Uns := 0) + return Uns_Option + with Ghost, Import; + function Is_Integer_Ghost (Str : String) return Boolean + with Ghost, Import; + procedure Prove_Iter_Scan_Based_Number_Ghost + (Str1, Str2 : String; + From, To : Integer; + Base : Uns := 10; + Acc : Uns := 0) + with Ghost, Import; + procedure Prove_Scan_Only_Decimal_Ghost (Str : String; Val : Int) + with Ghost, Import; + function Abs_Uns_Of_Int (Val : Int) return Uns + with Ghost, Import; + function Value_Integer (Str : String) return Int + with Ghost, Import; + + package Int_Params is new Val_Util.Int_Params + (Int => Int, + Uns => Uns, + Uns_Option => Uns_Option, + Unsigned_Width_Ghost => Unsigned_Width_Ghost, + Wrap_Option => Wrap_Option, + Only_Decimal_Ghost => Only_Decimal_Ghost, + Hexa_To_Unsigned_Ghost => Hexa_To_Unsigned_Ghost, + Scan_Based_Number_Ghost => Scan_Based_Number_Ghost, + Is_Integer_Ghost => Is_Integer_Ghost, + Prove_Iter_Scan_Based_Number_Ghost => Prove_Iter_Scan_Based_Number_Ghost, + Prove_Scan_Only_Decimal_Ghost => Prove_Scan_Only_Decimal_Ghost, + Abs_Uns_Of_Int => Abs_Uns_Of_Int, + Value_Integer => Value_Integer); + + package Image_I is new System.Image_I (Int_Params); procedure Set_Image_Integer (V : Int; @@ -96,7 +174,7 @@ package body System.Image_F is -- operation are omitted here. -- A 64-bit value can represent all integers with 18 decimal digits, but - -- not all with 19 decimal digits. If the total number of requested ouput + -- not all with 19 decimal digits. If the total number of requested output -- digits (Fore - 1) + Aft is greater than 18 then, for purposes of the -- conversion, Aft is adjusted to 18 - (Fore - 1). In that case, trailing -- zeros can complete the output after writing the first 18 significant @@ -355,6 +433,8 @@ package body System.Image_F is Digs (1 .. 2) := " 0"; Ndigs := 2; end if; + pragma Annotate (CodePeer, False_Positive, "test always true", + "no digits were output for zero"); Set_Decimal_Digits (Digs, Ndigs, S, P, Scale, Fore, Aft, Exp); end Set_Image_Fixed; diff --git a/gcc/ada/libgnat/s-imagef.ads b/gcc/ada/libgnat/s-imagef.ads index c16d2c5..13ea22f 100644 --- a/gcc/ada/libgnat/s-imagef.ads +++ b/gcc/ada/libgnat/s-imagef.ads @@ -36,6 +36,7 @@ generic type Int is range <>; + type Uns is mod <>; with procedure Scaled_Divide (X, Y, Z : Int; diff --git a/gcc/ada/libgnat/s-imagei.adb b/gcc/ada/libgnat/s-imagei.adb index e7199af..f340d13 100644 --- a/gcc/ada/libgnat/s-imagei.adb +++ b/gcc/ada/libgnat/s-imagei.adb @@ -29,18 +29,140 @@ -- -- ------------------------------------------------------------------------------ +with Ada.Numerics.Big_Numbers.Big_Integers_Ghost; +use Ada.Numerics.Big_Numbers.Big_Integers_Ghost; + package body System.Image_I is + -- Ghost code, loop invariants and assertions in this unit are meant for + -- analysis only, not for run-time checking, as it would be too costly + -- otherwise. This is enforced by setting the assertion policy to Ignore. + + pragma Assertion_Policy (Ghost => Ignore, + Loop_Invariant => Ignore, + Assert => Ignore, + Assert_And_Cut => Ignore, + Pre => Ignore, + Post => Ignore, + Subprogram_Variant => Ignore); + + -- As a use_clause for Int_Params cannot be used for instances of this + -- generic in System specs, rename all constants and subprograms. + + Unsigned_Width_Ghost : constant Natural := Int_Params.Unsigned_Width_Ghost; + + function Wrap_Option (Value : Uns) return Uns_Option + renames Int_Params.Wrap_Option; + function Only_Decimal_Ghost + (Str : String; + From, To : Integer) + return Boolean + renames Int_Params.Only_Decimal_Ghost; + function Hexa_To_Unsigned_Ghost (X : Character) return Uns + renames Int_Params.Hexa_To_Unsigned_Ghost; + function Scan_Based_Number_Ghost + (Str : String; + From, To : Integer; + Base : Uns := 10; + Acc : Uns := 0) + return Uns_Option + renames Int_Params.Scan_Based_Number_Ghost; + function Is_Integer_Ghost (Str : String) return Boolean + renames Int_Params.Is_Integer_Ghost; + procedure Prove_Iter_Scan_Based_Number_Ghost + (Str1, Str2 : String; + From, To : Integer; + Base : Uns := 10; + Acc : Uns := 0) + renames Int_Params.Prove_Iter_Scan_Based_Number_Ghost; + procedure Prove_Scan_Only_Decimal_Ghost (Str : String; Val : Int) + renames Int_Params.Prove_Scan_Only_Decimal_Ghost; + function Abs_Uns_Of_Int (Val : Int) return Uns + renames Int_Params.Abs_Uns_Of_Int; + function Value_Integer (Str : String) return Int + renames Int_Params.Value_Integer; + subtype Non_Positive is Int range Int'First .. 0; + function Uns_Of_Non_Positive (T : Non_Positive) return Uns is + (if T = Int'First then Uns (Int'Last) + 1 else Uns (-T)); + procedure Set_Digits (T : Non_Positive; S : in out String; - P : in out Natural); + P : in out Natural) + with + Pre => P < Integer'Last + and then S'Last < Integer'Last + and then S'First <= P + 1 + and then S'First <= S'Last + and then P <= S'Last - Unsigned_Width_Ghost + 1, + Post => S (S'First .. P'Old) = S'Old (S'First .. P'Old) + and then P in P'Old + 1 .. S'Last + and then Only_Decimal_Ghost (S, From => P'Old + 1, To => P) + and then Scan_Based_Number_Ghost (S, From => P'Old + 1, To => P) + = Wrap_Option (Uns_Of_Non_Positive (T)); -- Set digits of absolute value of T, which is zero or negative. We work -- with the negative of the value so that the largest negative number is -- not a special case. + package Unsigned_Conversion is new Unsigned_Conversions (Int => Uns); + + function Big (Arg : Uns) return Big_Integer renames + Unsigned_Conversion.To_Big_Integer; + + function From_Big (Arg : Big_Integer) return Uns renames + Unsigned_Conversion.From_Big_Integer; + + Big_10 : constant Big_Integer := Big (10) with Ghost; + + ------------------ + -- Local Lemmas -- + ------------------ + + procedure Lemma_Non_Zero (X : Uns) + with + Ghost, + Pre => X /= 0, + Post => Big (X) /= 0; + + procedure Lemma_Div_Commutation (X, Y : Uns) + with + Ghost, + Pre => Y /= 0, + Post => Big (X) / Big (Y) = Big (X / Y); + + procedure Lemma_Div_Twice (X : Big_Natural; Y, Z : Big_Positive) + with + Ghost, + Post => X / Y / Z = X / (Y * Z); + + --------------------------- + -- Lemma_Div_Commutation -- + --------------------------- + + procedure Lemma_Non_Zero (X : Uns) is null; + procedure Lemma_Div_Commutation (X, Y : Uns) is null; + + --------------------- + -- Lemma_Div_Twice -- + --------------------- + + procedure Lemma_Div_Twice (X : Big_Natural; Y, Z : Big_Positive) is + XY : constant Big_Natural := X / Y; + YZ : constant Big_Natural := Y * Z; + XYZ : constant Big_Natural := X / Y / Z; + R : constant Big_Natural := (XY rem Z) * Y + (X rem Y); + begin + pragma Assert (X = XY * Y + (X rem Y)); + pragma Assert (XY = XY / Z * Z + (XY rem Z)); + pragma Assert (X = XYZ * YZ + R); + pragma Assert ((XY rem Z) * Y <= (Z - 1) * Y); + pragma Assert (R <= YZ - 1); + pragma Assert (X / YZ = (XYZ * YZ + R) / YZ); + pragma Assert (X / YZ = XYZ + R / YZ); + end Lemma_Div_Twice; + ------------------- -- Image_Integer -- ------------------- @@ -52,6 +174,39 @@ package body System.Image_I is is pragma Assert (S'First = 1); + procedure Prove_Value_Integer + with + Ghost, + Pre => S'First = 1 + and then S'Last < Integer'Last + and then P in 2 .. S'Last + and then S (1) in ' ' | '-' + and then (S (1) = '-') = (V < 0) + and then Only_Decimal_Ghost (S, From => 2, To => P) + and then Scan_Based_Number_Ghost (S, From => 2, To => P) + = Wrap_Option (Abs_Uns_Of_Int (V)), + Post => Is_Integer_Ghost (S (1 .. P)) + and then Value_Integer (S (1 .. P)) = V; + -- Ghost lemma to prove the value of Value_Integer from the value of + -- Scan_Based_Number_Ghost and the sign on a decimal string. + + ------------------------- + -- Prove_Value_Integer -- + ------------------------- + + procedure Prove_Value_Integer is + Str : constant String := S (1 .. P); + begin + pragma Assert (Str'First = 1); + pragma Assert (Only_Decimal_Ghost (Str, From => 2, To => P)); + Prove_Iter_Scan_Based_Number_Ghost (S, Str, From => 2, To => P); + pragma Assert (Scan_Based_Number_Ghost (Str, From => 2, To => P) + = Wrap_Option (Abs_Uns_Of_Int (V))); + Prove_Scan_Only_Decimal_Ghost (Str, V); + end Prove_Value_Integer; + + -- Start of processing for Image_Integer + begin if V >= 0 then S (1) := ' '; @@ -63,7 +218,16 @@ package body System.Image_I is pragma Assert (P < S'Last - 1); end if; - Set_Image_Integer (V, S, P); + declare + P_Prev : constant Integer := P with Ghost; + Offset : constant Positive := (if V >= 0 then 1 else 2) with Ghost; + begin + Set_Image_Integer (V, S, P); + + pragma Assert (P_Prev + Offset = 2); + end; + + Prove_Value_Integer; end Image_Integer; ---------------- @@ -77,6 +241,106 @@ package body System.Image_I is is Nb_Digits : Natural := 0; Value : Non_Positive := T; + + -- Local ghost variables + + Pow : Big_Positive := 1 with Ghost; + S_Init : constant String := S with Ghost; + Uns_T : constant Uns := Uns_Of_Non_Positive (T) with Ghost; + Uns_Value : Uns := Uns_Of_Non_Positive (Value) with Ghost; + Prev, Cur : Uns_Option with Ghost; + Prev_Value : Uns with Ghost; + Prev_S : String := S with Ghost; + + -- Local ghost lemmas + + procedure Prove_Character_Val (RU : Uns; RI : Int) + with + Ghost, + Pre => RU in 0 .. 9 + and then RI in 0 .. 9, + Post => Character'Val (48 + RU) in '0' .. '9' + and then Character'Val (48 + RI) in '0' .. '9'; + -- Ghost lemma to prove the value of a character corresponding to the + -- next figure. + + procedure Prove_Hexa_To_Unsigned_Ghost (RU : Uns; RI : Int) + with + Ghost, + Pre => RU in 0 .. 9 + and then RI in 0 .. 9, + Post => Hexa_To_Unsigned_Ghost (Character'Val (48 + RU)) = RU + and then Hexa_To_Unsigned_Ghost (Character'Val (48 + RI)) = Uns (RI); + -- Ghost lemma to prove that Hexa_To_Unsigned_Ghost returns the source + -- figure when applied to the corresponding character. + + procedure Prove_Unchanged + with + Ghost, + Pre => P <= S'Last + and then S_Init'First = S'First + and then S_Init'Last = S'Last + and then (for all K in S'First .. P => S (K) = S_Init (K)), + Post => S (S'First .. P) = S_Init (S'First .. P); + -- Ghost lemma to prove that the part of string S before P has not been + -- modified. + + procedure Prove_Uns_Of_Non_Positive_Value + with + Ghost, + Pre => Uns_Value = Uns_Of_Non_Positive (Value), + Post => Uns_Value / 10 = Uns_Of_Non_Positive (Value / 10) + and then Uns_Value rem 10 = Uns_Of_Non_Positive (Value rem 10); + -- Ghost lemma to prove that the relation between Value and its unsigned + -- version is preserved. + + procedure Prove_Iter_Scan + (Str1, Str2 : String; + From, To : Integer; + Base : Uns := 10; + Acc : Uns := 0) + with + Ghost, + Pre => Str1'Last /= Positive'Last + and then + (From > To or else (From >= Str1'First and then To <= Str1'Last)) + and then Only_Decimal_Ghost (Str1, From, To) + and then Str1'First = Str2'First + and then Str1'Last = Str2'Last + and then (for all J in From .. To => Str1 (J) = Str2 (J)), + Post => + Scan_Based_Number_Ghost (Str1, From, To, Base, Acc) + = Scan_Based_Number_Ghost (Str2, From, To, Base, Acc); + -- Ghost lemma to prove that the result of Scan_Based_Number_Ghost only + -- depends on the value of the argument string in the (From .. To) range + -- of indexes. This is a wrapper on Prove_Iter_Scan_Based_Number_Ghost + -- so that we can call it here on ghost arguments. + + ----------------------------- + -- Local lemma null bodies -- + ----------------------------- + + procedure Prove_Character_Val (RU : Uns; RI : Int) is null; + procedure Prove_Hexa_To_Unsigned_Ghost (RU : Uns; RI : Int) is null; + procedure Prove_Unchanged is null; + procedure Prove_Uns_Of_Non_Positive_Value is null; + + --------------------- + -- Prove_Iter_Scan -- + --------------------- + + procedure Prove_Iter_Scan + (Str1, Str2 : String; + From, To : Integer; + Base : Uns := 10; + Acc : Uns := 0) + is + begin + Prove_Iter_Scan_Based_Number_Ghost (Str1, Str2, From, To, Base, Acc); + end Prove_Iter_Scan; + + -- Start of processing for Set_Digits + begin pragma Assert (P >= S'First - 1 and P < S'Last); -- No check is done since, as documented in the Set_Image_Integer @@ -86,19 +350,116 @@ package body System.Image_I is -- First we compute the number of characters needed for representing -- the number. loop + Lemma_Div_Commutation (Uns_Of_Non_Positive (Value), 10); + Lemma_Div_Twice (Big (Uns_Of_Non_Positive (T)), + Big_10 ** Nb_Digits, Big_10); + Prove_Uns_Of_Non_Positive_Value; + Value := Value / 10; Nb_Digits := Nb_Digits + 1; + + Uns_Value := Uns_Value / 10; + Pow := Pow * 10; + + pragma Loop_Invariant (Uns_Value = Uns_Of_Non_Positive (Value)); + pragma Loop_Invariant (Nb_Digits in 1 .. Unsigned_Width_Ghost - 1); + pragma Loop_Invariant (Pow = Big_10 ** Nb_Digits); + pragma Loop_Invariant (Big (Uns_Value) = Big (Uns_T) / Pow); + pragma Loop_Variant (Increases => Value); + exit when Value = 0; + + Lemma_Non_Zero (Uns_Value); + pragma Assert (Pow <= Big (Uns'Last)); end loop; Value := T; + Uns_Value := Uns_Of_Non_Positive (T); + Pow := 1; + + pragma Assert (Uns_Value = From_Big (Big (Uns_T) / Big_10 ** 0)); -- We now populate digits from the end of the string to the beginning for J in reverse 1 .. Nb_Digits loop + Lemma_Div_Commutation (Uns_Value, 10); + Lemma_Div_Twice (Big (Uns_T), Big_10 ** (Nb_Digits - J), Big_10); + Prove_Character_Val (Uns_Value rem 10, -(Value rem 10)); + Prove_Hexa_To_Unsigned_Ghost (Uns_Value rem 10, -(Value rem 10)); + Prove_Uns_Of_Non_Positive_Value; + pragma Assert (Uns_Value rem 10 = Uns_Of_Non_Positive (Value rem 10)); + pragma Assert (Uns_Value rem 10 = Uns (-(Value rem 10))); + + Prev_Value := Uns_Value; + Prev_S := S; + Pow := Pow * 10; + Uns_Value := Uns_Value / 10; + S (P + J) := Character'Val (48 - (Value rem 10)); Value := Value / 10; + + pragma Assert (S (P + J) in '0' .. '9'); + pragma Assert (Hexa_To_Unsigned_Ghost (S (P + J)) = + From_Big (Big (Uns_T) / Big_10 ** (Nb_Digits - J)) rem 10); + pragma Assert + (for all K in P + J + 1 .. P + Nb_Digits => S (K) in '0' .. '9'); + + Prev := Scan_Based_Number_Ghost + (Str => S, + From => P + J + 1, + To => P + Nb_Digits, + Base => 10, + Acc => Prev_Value); + Cur := Scan_Based_Number_Ghost + (Str => S, + From => P + J, + To => P + Nb_Digits, + Base => 10, + Acc => Uns_Value); + pragma Assert (Prev_Value = 10 * Uns_Value + (Prev_Value rem 10)); + pragma Assert + (Prev_Value rem 10 = Hexa_To_Unsigned_Ghost (S (P + J))); + pragma Assert + (Prev_Value = 10 * Uns_Value + Hexa_To_Unsigned_Ghost (S (P + J))); + + if J /= Nb_Digits then + Prove_Iter_Scan + (Prev_S, S, P + J + 1, P + Nb_Digits, 10, Prev_Value); + end if; + + pragma Assert (Prev = Cur); + pragma Assert (Prev = Wrap_Option (Uns_T)); + + pragma Loop_Invariant (Uns_Value = Uns_Of_Non_Positive (Value)); + pragma Loop_Invariant (Uns_Value <= Uns'Last / 10); + pragma Loop_Invariant + (for all K in S'First .. P => S (K) = S_Init (K)); + pragma Loop_Invariant (Only_Decimal_Ghost (S, P + J, P + Nb_Digits)); + pragma Loop_Invariant + (for all K in P + J .. P + Nb_Digits => S (K) in '0' .. '9'); + pragma Loop_Invariant (Pow = Big_10 ** (Nb_Digits - J + 1)); + pragma Loop_Invariant (Big (Uns_Value) = Big (Uns_T) / Pow); + pragma Loop_Invariant + (Scan_Based_Number_Ghost + (Str => S, + From => P + J, + To => P + Nb_Digits, + Base => 10, + Acc => Uns_Value) + = Wrap_Option (Uns_T)); end loop; + pragma Assert (Big (Uns_Value) = Big (Uns_T) / Big_10 ** (Nb_Digits)); + pragma Assert (Uns_Value = 0); + Prove_Unchanged; + pragma Assert + (Scan_Based_Number_Ghost + (Str => S, + From => P + 1, + To => P + Nb_Digits, + Base => 10, + Acc => Uns_Value) + = Wrap_Option (Uns_T)); + P := P + Nb_Digits; end Set_Digits; diff --git a/gcc/ada/libgnat/s-imagei.ads b/gcc/ada/libgnat/s-imagei.ads index 7d2434b..10116d1 100644 --- a/gcc/ada/libgnat/s-imagei.ads +++ b/gcc/ada/libgnat/s-imagei.ads @@ -33,17 +33,45 @@ -- signed integer types, and also for conversion operations required in -- Text_IO.Integer_IO for such types. +-- Preconditions in this unit are meant for analysis only, not for run-time +-- checking, so that the expected exceptions are raised. This is enforced by +-- setting the corresponding assertion policy to Ignore. Postconditions and +-- contract cases should not be executed at runtime as well, in order not to +-- slow down the execution of these functions. + +pragma Assertion_Policy (Pre => Ignore, + Post => Ignore, + Contract_Cases => Ignore, + Ghost => Ignore, + Subprogram_Variant => Ignore); + +with System.Val_Util; + generic - type Int is range <>; + with package Int_Params is new System.Val_Util.Int_Params (<>); package System.Image_I is - pragma Pure; + + subtype Int is Int_Params.Int; + use type Int_Params.Int; + + subtype Uns is Int_Params.Uns; + use type Int_Params.Uns; + + subtype Uns_Option is Int_Params.Uns_Option; + use type Int_Params.Uns_Option; procedure Image_Integer (V : Int; S : in out String; - P : out Natural); + P : out Natural) + with + Pre => S'First = 1 + and then S'Last < Integer'Last + and then S'Last >= Int_Params.Unsigned_Width_Ghost, + Post => P in S'Range + and then Int_Params.Value_Integer (S (1 .. P)) = V; -- Computes Int'Image (V) and stores the result in S (1 .. P) -- setting the resulting value of P. The caller guarantees that S -- is long enough to hold the result, and that S'First is 1. @@ -51,7 +79,31 @@ package System.Image_I is procedure Set_Image_Integer (V : Int; S : in out String; - P : in out Natural); + P : in out Natural) + with + Pre => P < Integer'Last + and then S'Last < Integer'Last + and then S'First <= P + 1 + and then S'First <= S'Last + and then + (if V >= 0 then + P <= S'Last - Int_Params.Unsigned_Width_Ghost + 1 + else + P <= S'Last - Int_Params.Unsigned_Width_Ghost), + Post => S (S'First .. P'Old) = S'Old (S'First .. P'Old) + and then + (declare + Minus : constant Boolean := S (P'Old + 1) = '-'; + Offset : constant Positive := (if V >= 0 then 1 else 2); + Abs_V : constant Uns := Int_Params.Abs_Uns_Of_Int (V); + begin + Minus = (V < 0) + and then P in P'Old + Offset .. S'Last + and then Int_Params.Only_Decimal_Ghost + (S, From => P'Old + Offset, To => P) + and then Int_Params.Scan_Based_Number_Ghost + (S, From => P'Old + Offset, To => P) + = Int_Params.Wrap_Option (Abs_V)); -- Stores the image of V in S starting at S (P + 1), P is updated to point -- to the last character stored. The value stored is identical to the value -- of Int'Image (V) except that no leading space is stored when V is diff --git a/gcc/ada/libgnat/s-imageu.adb b/gcc/ada/libgnat/s-imageu.adb index 87830df..d6d9d46 100644 --- a/gcc/ada/libgnat/s-imageu.adb +++ b/gcc/ada/libgnat/s-imageu.adb @@ -210,6 +210,15 @@ package body System.Image_U is -- Ghost lemma to prove the value of a character corresponding to the -- next figure. + procedure Prove_Euclidian (Val, Quot, Rest : Uns) + with + Ghost, + Pre => Quot = Val / 10 + and then Rest = Val rem 10, + Post => Val = 10 * Quot + Rest; + -- Ghost lemma to prove the relation between the quotient/remainder of + -- division by 10 and the initial value. + procedure Prove_Hexa_To_Unsigned_Ghost (R : Uns) with Ghost, @@ -256,6 +265,7 @@ package body System.Image_U is ----------------------------- procedure Prove_Character_Val (R : Uns) is null; + procedure Prove_Euclidian (Val, Quot, Rest : Uns) is null; procedure Prove_Hexa_To_Unsigned_Ghost (R : Uns) is null; procedure Prove_Unchanged is null; @@ -347,6 +357,9 @@ package body System.Image_U is Acc => Value); if J /= Nb_Digits then + Prove_Euclidian (Val => Prev_Value, + Quot => Value, + Rest => Hexa_To_Unsigned_Ghost (S (P + J))); pragma Assert (Prev_Value = 10 * Value + Hexa_To_Unsigned_Ghost (S (P + J))); Prove_Iter_Scan diff --git a/gcc/ada/libgnat/s-imfi128.ads b/gcc/ada/libgnat/s-imfi128.ads index 4614455..7f64b83 100644 --- a/gcc/ada/libgnat/s-imfi128.ads +++ b/gcc/ada/libgnat/s-imfi128.ads @@ -39,8 +39,9 @@ with System.Image_F; package System.Img_Fixed_128 is subtype Int128 is Interfaces.Integer_128; + subtype Uns128 is Interfaces.Unsigned_128; - package Impl is new Image_F (Int128, Arith_128.Scaled_Divide128); + package Impl is new Image_F (Int128, Uns128, Arith_128.Scaled_Divide128); procedure Image_Fixed128 (V : Int128; diff --git a/gcc/ada/libgnat/s-imfi32.ads b/gcc/ada/libgnat/s-imfi32.ads index 492cc92..e5c6ff8 100644 --- a/gcc/ada/libgnat/s-imfi32.ads +++ b/gcc/ada/libgnat/s-imfi32.ads @@ -39,8 +39,9 @@ with System.Image_F; package System.Img_Fixed_32 is subtype Int32 is Interfaces.Integer_32; + subtype Uns32 is Interfaces.Unsigned_32; - package Impl is new Image_F (Int32, Arith_32.Scaled_Divide32); + package Impl is new Image_F (Int32, Uns32, Arith_32.Scaled_Divide32); procedure Image_Fixed32 (V : Int32; diff --git a/gcc/ada/libgnat/s-imfi64.ads b/gcc/ada/libgnat/s-imfi64.ads index d51634c..91f4daf 100644 --- a/gcc/ada/libgnat/s-imfi64.ads +++ b/gcc/ada/libgnat/s-imfi64.ads @@ -39,8 +39,9 @@ with System.Image_F; package System.Img_Fixed_64 is subtype Int64 is Interfaces.Integer_64; + subtype Uns64 is Interfaces.Unsigned_64; - package Impl is new Image_F (Int64, Arith_64.Scaled_Divide64); + package Impl is new Image_F (Int64, Uns64, Arith_64.Scaled_Divide64); procedure Image_Fixed64 (V : Int64; diff --git a/gcc/ada/libgnat/s-imgint.ads b/gcc/ada/libgnat/s-imgint.ads index 7b1fe22..fd5bea3 100644 --- a/gcc/ada/libgnat/s-imgint.ads +++ b/gcc/ada/libgnat/s-imgint.ads @@ -33,12 +33,51 @@ -- signed integer types up to Integer, and also for conversion operations -- required in Text_IO.Integer_IO for such types. +-- Preconditions in this unit are meant for analysis only, not for run-time +-- checking, so that the expected exceptions are raised. This is enforced by +-- setting the corresponding assertion policy to Ignore. Postconditions and +-- contract cases should not be executed at runtime as well, in order not to +-- slow down the execution of these functions. + +pragma Assertion_Policy (Pre => Ignore, + Post => Ignore, + Contract_Cases => Ignore, + Ghost => Ignore, + Subprogram_Variant => Ignore); + with System.Image_I; +with System.Unsigned_Types; +with System.Val_Int; +with System.Val_Uns; +with System.Val_Util; +with System.Wid_Uns; + +package System.Img_Int + with SPARK_Mode +is + subtype Unsigned is Unsigned_Types.Unsigned; -package System.Img_Int is - pragma Pure; + package Int_Params is new Val_Util.Int_Params + (Int => Integer, + Uns => Unsigned, + Uns_Option => Val_Uns.Impl.Uns_Option, + Unsigned_Width_Ghost => + Wid_Uns.Width_Unsigned (0, Unsigned'Last), + Only_Decimal_Ghost => Val_Uns.Impl.Only_Decimal_Ghost, + Hexa_To_Unsigned_Ghost => + Val_Uns.Impl.Hexa_To_Unsigned_Ghost, + Wrap_Option => Val_Uns.Impl.Wrap_Option, + Scan_Based_Number_Ghost => + Val_Uns.Impl.Scan_Based_Number_Ghost, + Prove_Iter_Scan_Based_Number_Ghost => + Val_Uns.Impl.Prove_Iter_Scan_Based_Number_Ghost, + Is_Integer_Ghost => Val_Int.Impl.Is_Integer_Ghost, + Prove_Scan_Only_Decimal_Ghost => + Val_Int.Impl.Prove_Scan_Only_Decimal_Ghost, + Abs_Uns_Of_Int => Val_Int.Impl.Abs_Uns_Of_Int, + Value_Integer => Val_Int.Impl.Value_Integer); - package Impl is new Image_I (Integer); + package Impl is new Image_I (Int_Params); procedure Image_Integer (V : Integer; diff --git a/gcc/ada/libgnat/s-imglli.ads b/gcc/ada/libgnat/s-imglli.ads index fc773ae..20f108c 100644 --- a/gcc/ada/libgnat/s-imglli.ads +++ b/gcc/ada/libgnat/s-imglli.ads @@ -33,12 +33,51 @@ -- signed integer types larger than Integer, and also for conversion -- operations required in Text_IO.Integer_IO for such types. +-- Preconditions in this unit are meant for analysis only, not for run-time +-- checking, so that the expected exceptions are raised. This is enforced by +-- setting the corresponding assertion policy to Ignore. Postconditions and +-- contract cases should not be executed at runtime as well, in order not to +-- slow down the execution of these functions. + +pragma Assertion_Policy (Pre => Ignore, + Post => Ignore, + Contract_Cases => Ignore, + Ghost => Ignore, + Subprogram_Variant => Ignore); + with System.Image_I; +with System.Unsigned_Types; +with System.Val_LLI; +with System.Val_LLU; +with System.Val_Util; +with System.Wid_LLU; + +package System.Img_LLI + with SPARK_Mode +is + subtype Long_Long_Unsigned is Unsigned_Types.Long_Long_Unsigned; -package System.Img_LLI is - pragma Pure; + package Int_Params is new Val_Util.Int_Params + (Int => Long_Long_Integer, + Uns => Long_Long_Unsigned, + Uns_Option => Val_LLU.Impl.Uns_Option, + Unsigned_Width_Ghost => + Wid_LLU.Width_Long_Long_Unsigned (0, Long_Long_Unsigned'Last), + Only_Decimal_Ghost => Val_LLU.Impl.Only_Decimal_Ghost, + Hexa_To_Unsigned_Ghost => + Val_LLU.Impl.Hexa_To_Unsigned_Ghost, + Wrap_Option => Val_LLU.Impl.Wrap_Option, + Scan_Based_Number_Ghost => + Val_LLU.Impl.Scan_Based_Number_Ghost, + Prove_Iter_Scan_Based_Number_Ghost => + Val_LLU.Impl.Prove_Iter_Scan_Based_Number_Ghost, + Is_Integer_Ghost => Val_LLI.Impl.Is_Integer_Ghost, + Prove_Scan_Only_Decimal_Ghost => + Val_LLI.Impl.Prove_Scan_Only_Decimal_Ghost, + Abs_Uns_Of_Int => Val_LLI.Impl.Abs_Uns_Of_Int, + Value_Integer => Val_LLI.Impl.Value_Integer); - package Impl is new Image_I (Long_Long_Integer); + package Impl is new Image_I (Int_Params); procedure Image_Long_Long_Integer (V : Long_Long_Integer; diff --git a/gcc/ada/libgnat/s-imgllli.ads b/gcc/ada/libgnat/s-imgllli.ads index a5a1052..989c296 100644 --- a/gcc/ada/libgnat/s-imgllli.ads +++ b/gcc/ada/libgnat/s-imgllli.ads @@ -33,12 +33,52 @@ -- signed integer types larger than Long_Long_Integer, and also for conversion -- operations required in Text_IO.Integer_IO for such types. +-- Preconditions in this unit are meant for analysis only, not for run-time +-- checking, so that the expected exceptions are raised. This is enforced by +-- setting the corresponding assertion policy to Ignore. Postconditions and +-- contract cases should not be executed at runtime as well, in order not to +-- slow down the execution of these functions. + +pragma Assertion_Policy (Pre => Ignore, + Post => Ignore, + Contract_Cases => Ignore, + Ghost => Ignore, + Subprogram_Variant => Ignore); + with System.Image_I; +with System.Unsigned_Types; +with System.Val_LLLI; +with System.Val_LLLU; +with System.Val_Util; +with System.Wid_LLLU; + +package System.Img_LLLI + with SPARK_Mode +is + subtype Long_Long_Long_Unsigned is Unsigned_Types.Long_Long_Long_Unsigned; -package System.Img_LLLI is - pragma Pure; + package Int_Params is new Val_Util.Int_Params + (Int => Long_Long_Long_Integer, + Uns => Long_Long_Long_Unsigned, + Uns_Option => Val_LLLU.Impl.Uns_Option, + Unsigned_Width_Ghost => + Wid_LLLU.Width_Long_Long_Long_Unsigned + (0, Long_Long_Long_Unsigned'Last), + Only_Decimal_Ghost => Val_LLLU.Impl.Only_Decimal_Ghost, + Hexa_To_Unsigned_Ghost => + Val_LLLU.Impl.Hexa_To_Unsigned_Ghost, + Wrap_Option => Val_LLLU.Impl.Wrap_Option, + Scan_Based_Number_Ghost => + Val_LLLU.Impl.Scan_Based_Number_Ghost, + Prove_Iter_Scan_Based_Number_Ghost => + Val_LLLU.Impl.Prove_Iter_Scan_Based_Number_Ghost, + Is_Integer_Ghost => Val_LLLI.Impl.Is_Integer_Ghost, + Prove_Scan_Only_Decimal_Ghost => + Val_LLLI.Impl.Prove_Scan_Only_Decimal_Ghost, + Abs_Uns_Of_Int => Val_LLLI.Impl.Abs_Uns_Of_Int, + Value_Integer => Val_LLLI.Impl.Value_Integer); - package Impl is new Image_I (Long_Long_Long_Integer); + package Impl is new Image_I (Int_Params); procedure Image_Long_Long_Long_Integer (V : Long_Long_Long_Integer; diff --git a/gcc/ada/libgnat/s-putima.adb b/gcc/ada/libgnat/s-putima.adb index cc36fce..10d8b84 100644 --- a/gcc/ada/libgnat/s-putima.adb +++ b/gcc/ada/libgnat/s-putima.adb @@ -32,7 +32,7 @@ with Ada.Strings.Text_Buffers.Utils; use Ada.Strings.Text_Buffers; use Ada.Strings.Text_Buffers.Utils; -with Unchecked_Conversion; +with Ada.Unchecked_Conversion; package body System.Put_Images is @@ -133,7 +133,7 @@ package body System.Put_Images is procedure Put_Image_Pointer (S : in out Sink'Class; X : Pointer; Type_Kind : String) is - function Cast is new Unchecked_Conversion + function Cast is new Ada.Unchecked_Conversion (System.Address, Unsigned_Address); begin if X = null then diff --git a/gcc/ada/libgnat/s-valint.ads b/gcc/ada/libgnat/s-valint.ads index c0d47aa..9e47f1b 100644 --- a/gcc/ada/libgnat/s-valint.ads +++ b/gcc/ada/libgnat/s-valint.ads @@ -57,6 +57,8 @@ package System.Val_Int with SPARK_Mode is (Int => Integer, Uns => Unsigned, Scan_Raw_Unsigned => Val_Uns.Scan_Raw_Unsigned, + Uns_Option => Val_Uns.Impl.Uns_Option, + Wrap_Option => Val_Uns.Impl.Wrap_Option, Is_Raw_Unsigned_Format_Ghost => Val_Uns.Impl.Is_Raw_Unsigned_Format_Ghost, Raw_Unsigned_Overflows_Ghost => @@ -64,7 +66,11 @@ package System.Val_Int with SPARK_Mode is Scan_Raw_Unsigned_Ghost => Val_Uns.Impl.Scan_Raw_Unsigned_Ghost, Raw_Unsigned_Last_Ghost => - Val_Uns.Impl.Raw_Unsigned_Last_Ghost); + Val_Uns.Impl.Raw_Unsigned_Last_Ghost, + Only_Decimal_Ghost => + Val_Uns.Impl.Only_Decimal_Ghost, + Scan_Based_Number_Ghost => + Val_Uns.Impl.Scan_Based_Number_Ghost); procedure Scan_Integer (Str : String; diff --git a/gcc/ada/libgnat/s-vallli.ads b/gcc/ada/libgnat/s-vallli.ads index dfb1729..5bccb1a 100644 --- a/gcc/ada/libgnat/s-vallli.ads +++ b/gcc/ada/libgnat/s-vallli.ads @@ -58,6 +58,8 @@ package System.Val_LLI with SPARK_Mode is Uns => Long_Long_Unsigned, Scan_Raw_Unsigned => Val_LLU.Scan_Raw_Long_Long_Unsigned, + Uns_Option => Val_LLU.Impl.Uns_Option, + Wrap_Option => Val_LLU.Impl.Wrap_Option, Is_Raw_Unsigned_Format_Ghost => Val_LLU.Impl.Is_Raw_Unsigned_Format_Ghost, Raw_Unsigned_Overflows_Ghost => @@ -65,7 +67,11 @@ package System.Val_LLI with SPARK_Mode is Scan_Raw_Unsigned_Ghost => Val_LLU.Impl.Scan_Raw_Unsigned_Ghost, Raw_Unsigned_Last_Ghost => - Val_LLU.Impl.Raw_Unsigned_Last_Ghost); + Val_LLU.Impl.Raw_Unsigned_Last_Ghost, + Only_Decimal_Ghost => + Val_LLU.Impl.Only_Decimal_Ghost, + Scan_Based_Number_Ghost => + Val_LLU.Impl.Scan_Based_Number_Ghost); procedure Scan_Long_Long_Integer (Str : String; diff --git a/gcc/ada/libgnat/s-valllli.ads b/gcc/ada/libgnat/s-valllli.ads index 84bca58..586c737 100644 --- a/gcc/ada/libgnat/s-valllli.ads +++ b/gcc/ada/libgnat/s-valllli.ads @@ -58,6 +58,8 @@ package System.Val_LLLI with SPARK_Mode is Uns => Long_Long_Long_Unsigned, Scan_Raw_Unsigned => Val_LLLU.Scan_Raw_Long_Long_Long_Unsigned, + Uns_Option => Val_LLLU.Impl.Uns_Option, + Wrap_Option => Val_LLLU.Impl.Wrap_Option, Is_Raw_Unsigned_Format_Ghost => Val_LLLU.Impl.Is_Raw_Unsigned_Format_Ghost, Raw_Unsigned_Overflows_Ghost => @@ -65,7 +67,11 @@ package System.Val_LLLI with SPARK_Mode is Scan_Raw_Unsigned_Ghost => Val_LLLU.Impl.Scan_Raw_Unsigned_Ghost, Raw_Unsigned_Last_Ghost => - Val_LLLU.Impl.Raw_Unsigned_Last_Ghost); + Val_LLLU.Impl.Raw_Unsigned_Last_Ghost, + Only_Decimal_Ghost => + Val_LLLU.Impl.Only_Decimal_Ghost, + Scan_Based_Number_Ghost => + Val_LLLU.Impl.Scan_Based_Number_Ghost); procedure Scan_Long_Long_Long_Integer (Str : String; diff --git a/gcc/ada/libgnat/s-valuei.adb b/gcc/ada/libgnat/s-valuei.adb index 68d8984..b453ffc 100644 --- a/gcc/ada/libgnat/s-valuei.adb +++ b/gcc/ada/libgnat/s-valuei.adb @@ -41,6 +41,59 @@ package body System.Value_I is Assert_And_Cut => Ignore, Subprogram_Variant => Ignore); + ----------------------------------- + -- Prove_Scan_Only_Decimal_Ghost -- + ----------------------------------- + + procedure Prove_Scan_Only_Decimal_Ghost (Str : String; Val : Int) is + Non_Blank : constant Positive := First_Non_Space_Ghost + (Str, Str'First, Str'Last); + pragma Assert + (if Val < 0 then Non_Blank = Str'First + else + Only_Space_Ghost (Str, Str'First, Str'First) + and then Non_Blank = Str'First + 1); + Minus : constant Boolean := Str (Non_Blank) = '-'; + Fst_Num : constant Positive := + (if Minus then Non_Blank + 1 else Non_Blank); + pragma Assert (Fst_Num = Str'First + 1); + Uval : constant Uns := + Scan_Raw_Unsigned_Ghost (Str, Fst_Num, Str'Last); + + procedure Unique_Int_Of_Uns (Val1, Val2 : Int) + with + Pre => Uns_Is_Valid_Int (Minus, Uval) + and then Is_Int_Of_Uns (Minus, Uval, Val1) + and then Is_Int_Of_Uns (Minus, Uval, Val2), + Post => Val1 = Val2; + -- Local proof of the unicity of the signed representation + + procedure Unique_Int_Of_Uns (Val1, Val2 : Int) is null; + + -- Start of processing for Prove_Scan_Only_Decimal_Ghost + + begin + pragma Assert (Minus = (Val < 0)); + pragma Assert (Uval = Abs_Uns_Of_Int (Val)); + pragma Assert (if Minus then Uval <= Uns (Int'Last) + 1 + else Uval <= Uns (Int'Last)); + pragma Assert (Uns_Is_Valid_Int (Minus, Uval)); + pragma Assert + (if Minus and then Uval = Uns (Int'Last) + 1 then Val = Int'First + elsif Minus then Val = -(Int (Uval)) + else Val = Int (Uval)); + pragma Assert (Is_Int_Of_Uns (Minus, Uval, Val)); + pragma Assert + (Is_Raw_Unsigned_Format_Ghost (Str (Fst_Num .. Str'Last))); + pragma Assert + (not Raw_Unsigned_Overflows_Ghost (Str, Fst_Num, Str'Last)); + pragma Assert (Only_Space_Ghost + (Str, Raw_Unsigned_Last_Ghost (Str, Fst_Num, Str'Last), Str'Last)); + pragma Assert (Is_Integer_Ghost (Str)); + pragma Assert (Is_Value_Integer_Ghost (Str, Val)); + Unique_Int_Of_Uns (Val, Value_Integer (Str)); + end Prove_Scan_Only_Decimal_Ghost; + ------------------ -- Scan_Integer -- ------------------ diff --git a/gcc/ada/libgnat/s-valuei.ads b/gcc/ada/libgnat/s-valuei.ads index a7e20ab..c5b4b8e 100644 --- a/gcc/ada/libgnat/s-valuei.ads +++ b/gcc/ada/libgnat/s-valuei.ads @@ -37,8 +37,6 @@ pragma Assertion_Policy (Pre => Ignore, Contract_Cases => Ignore, Ghost => Ignore, Subprogram_Variant => Ignore); -pragma Warnings (Off, "postcondition does not mention function result"); --- True postconditions are used to avoid inlining for GNATprove with System.Val_Util; use System.Val_Util; @@ -56,19 +54,31 @@ generic -- Additional parameters for ghost subprograms used inside contracts + type Uns_Option is private; + with function Wrap_Option (Value : Uns) return Uns_Option; with function Is_Raw_Unsigned_Format_Ghost (Str : String) return Boolean; with function Raw_Unsigned_Overflows_Ghost - (Str : String; - From, To : Integer) - return Boolean; + (Str : String; + From, To : Integer) + return Boolean; with function Scan_Raw_Unsigned_Ghost - (Str : String; - From, To : Integer) - return Uns; + (Str : String; + From, To : Integer) + return Uns; with function Raw_Unsigned_Last_Ghost - (Str : String; - From, To : Integer) - return Positive; + (Str : String; + From, To : Integer) + return Positive; + with function Only_Decimal_Ghost + (Str : String; + From, To : Integer) + return Boolean; + with function Scan_Based_Number_Ghost + (Str : String; + From, To : Integer; + Base : Uns := 10; + Acc : Uns := 0) + return Uns_Option; package System.Value_I is pragma Preelaborate; @@ -96,6 +106,13 @@ package System.Value_I is Post => True; -- Return True if Uval (or -Uval when Minus is True) is equal to Val + function Abs_Uns_Of_Int (Val : Int) return Uns is + (if Val = Int'First then Uns (Int'Last) + 1 + elsif Val < 0 then Uns (-Val) + else Uns (Val)) + with Ghost; + -- Return the unsigned absolute value of Val + procedure Scan_Integer (Str : String; Ptr : not null access Integer; @@ -238,6 +255,22 @@ package System.Value_I is -- argument of the attribute. Constraint_Error is raised if the string is -- malformed, or if the value is out of range. + procedure Prove_Scan_Only_Decimal_Ghost (Str : String; Val : Int) + with + Ghost, + Pre => Str'Last /= Positive'Last + and then Str'Length >= 2 + and then Str (Str'First) in ' ' | '-' + and then (Str (Str'First) = '-') = (Val < 0) + and then Only_Decimal_Ghost (Str, Str'First + 1, Str'Last) + and then Scan_Based_Number_Ghost (Str, Str'First + 1, Str'Last) + = Wrap_Option (Abs_Uns_Of_Int (Val)), + Post => Is_Integer_Ghost (Slide_If_Necessary (Str)) + and then Value_Integer (Str) = Val; + -- Ghost lemma used in the proof of 'Image implementation, to prove that + -- the result of Value_Integer on a decimal string is the same as the + -- signing the result of Scan_Based_Number_Ghost. + private ---------------- diff --git a/gcc/ada/libgnat/s-valueu.adb b/gcc/ada/libgnat/s-valueu.adb index f1456a1..461d957 100644 --- a/gcc/ada/libgnat/s-valueu.adb +++ b/gcc/ada/libgnat/s-valueu.adb @@ -590,6 +590,10 @@ package body System.Value_U is if Str (P) = Base_Char then Ptr.all := P + 1; pragma Assert (Ptr.all = Last_Num_Based + 2); + pragma Assert + (if not Overflow then + Based_Val = Scan_Based_Number_Ghost + (Str, P, Last_Num_Based, Base, Uval)); Lemma_End_Of_Scan (Str, P, Last_Num_Based, Base, Uval); pragma Assert (if not Overflow then Uval = Based_Val.Value); exit; diff --git a/gcc/ada/libgnat/s-valueu.ads b/gcc/ada/libgnat/s-valueu.ads index 6245c47..1508b6e 100644 --- a/gcc/ada/libgnat/s-valueu.ads +++ b/gcc/ada/libgnat/s-valueu.ads @@ -43,8 +43,6 @@ pragma Assertion_Policy (Pre => Ignore, Contract_Cases => Ignore, Ghost => Ignore, Subprogram_Variant => Ignore); -pragma Warnings (Off, "postcondition does not mention function result"); --- True postconditions are used to avoid inlining for GNATprove with System.Val_Util; use System.Val_Util; diff --git a/gcc/ada/libgnat/s-valuti.ads b/gcc/ada/libgnat/s-valuti.ads index 5c0f2a5..45a0b66 100644 --- a/gcc/ada/libgnat/s-valuti.ads +++ b/gcc/ada/libgnat/s-valuti.ads @@ -41,8 +41,6 @@ pragma Assertion_Policy (Pre => Ignore, Post => Ignore, Contract_Cases => Ignore, Ghost => Ignore); -pragma Warnings (Off, "postcondition does not mention function result"); --- True postconditions are used to avoid inlining for GNATprove with System.Case_Util; @@ -376,6 +374,41 @@ is -- no check for this case, the caller must ensure this condition is met. pragma Warnings (GNATprove, On, """Ptr"" is not modified"); + -- Bundle Int type with other types, constants and subprograms used in + -- ghost code, so that this package can be instantiated once and used + -- multiple times as generic formal for a given Int type. + generic + type Int is range <>; + type Uns is mod <>; + type Uns_Option is private; + + Unsigned_Width_Ghost : Natural; + + with function Wrap_Option (Value : Uns) return Uns_Option; + with function Only_Decimal_Ghost + (Str : String; + From, To : Integer) + return Boolean; + with function Hexa_To_Unsigned_Ghost (X : Character) return Uns; + with function Scan_Based_Number_Ghost + (Str : String; + From, To : Integer; + Base : Uns := 10; + Acc : Uns := 0) + return Uns_Option; + with function Is_Integer_Ghost (Str : String) return Boolean; + with procedure Prove_Iter_Scan_Based_Number_Ghost + (Str1, Str2 : String; + From, To : Integer; + Base : Uns := 10; + Acc : Uns := 0); + with procedure Prove_Scan_Only_Decimal_Ghost (Str : String; Val : Int); + with function Abs_Uns_Of_Int (Val : Int) return Uns; + with function Value_Integer (Str : String) return Int; + + package Int_Params is + end Int_Params; + private ------------------------ diff --git a/gcc/ada/libgnat/s-widthu.ads b/gcc/ada/libgnat/s-widthu.ads index 7bad3fd..b6ae541 100644 --- a/gcc/ada/libgnat/s-widthu.ads +++ b/gcc/ada/libgnat/s-widthu.ads @@ -45,7 +45,6 @@ pragma Assertion_Policy (Pre => Ignore, -- type. The arguments Lo, Hi are the bounds of the type. with Ada.Numerics.Big_Numbers.Big_Integers_Ghost; -use Ada.Numerics.Big_Numbers.Big_Integers_Ghost; generic @@ -54,12 +53,19 @@ generic package System.Width_U with Pure is - package Unsigned_Conversion is new Unsigned_Conversions (Int => Uns); + package BI_Ghost renames Ada.Numerics.Big_Numbers.Big_Integers_Ghost; + subtype Big_Integer is BI_Ghost.Big_Integer with Ghost; + subtype Big_Natural is BI_Ghost.Big_Natural with Ghost; + subtype Big_Positive is BI_Ghost.Big_Positive with Ghost; + use type BI_Ghost.Big_Integer; + + package Unsigned_Conversion is + new BI_Ghost.Unsigned_Conversions (Int => Uns); function Big (Arg : Uns) return Big_Integer renames Unsigned_Conversion.To_Big_Integer; - Big_10 : constant Big_Integer := Big (10) with Ghost; + Big_10 : constant Big_Integer := Big (Uns'(10)) with Ghost; -- Maximum value of exponent for 10 that fits in Uns'Base function Max_Log10 return Natural is diff --git a/gcc/ada/libgnat/system-aix.ads b/gcc/ada/libgnat/system-aix.ads index c016361..57756d4 100644 --- a/gcc/ada/libgnat/system-aix.ads +++ b/gcc/ada/libgnat/system-aix.ads @@ -150,7 +150,6 @@ private Always_Compatible_Rep : constant Boolean := False; Suppress_Standard_Library : constant Boolean := False; Use_Ada_Main_Program_Name : constant Boolean := False; - Frontend_Exceptions : constant Boolean := False; ZCX_By_Default : constant Boolean := True; end System; diff --git a/gcc/ada/libgnat/system-darwin-arm.ads b/gcc/ada/libgnat/system-darwin-arm.ads index be5d664..7390f3a 100644 --- a/gcc/ada/libgnat/system-darwin-arm.ads +++ b/gcc/ada/libgnat/system-darwin-arm.ads @@ -166,7 +166,6 @@ private Always_Compatible_Rep : constant Boolean := False; Suppress_Standard_Library : constant Boolean := False; Use_Ada_Main_Program_Name : constant Boolean := False; - Frontend_Exceptions : constant Boolean := False; ZCX_By_Default : constant Boolean := True; end System; diff --git a/gcc/ada/libgnat/system-darwin-ppc.ads b/gcc/ada/libgnat/system-darwin-ppc.ads index dc3d6c4..984d5a2 100644 --- a/gcc/ada/libgnat/system-darwin-ppc.ads +++ b/gcc/ada/libgnat/system-darwin-ppc.ads @@ -166,7 +166,6 @@ private Always_Compatible_Rep : constant Boolean := False; Suppress_Standard_Library : constant Boolean := False; Use_Ada_Main_Program_Name : constant Boolean := False; - Frontend_Exceptions : constant Boolean := False; ZCX_By_Default : constant Boolean := True; end System; diff --git a/gcc/ada/libgnat/system-darwin-x86.ads b/gcc/ada/libgnat/system-darwin-x86.ads index 378fa9b..8d8e5f0 100644 --- a/gcc/ada/libgnat/system-darwin-x86.ads +++ b/gcc/ada/libgnat/system-darwin-x86.ads @@ -166,7 +166,6 @@ private Always_Compatible_Rep : constant Boolean := False; Suppress_Standard_Library : constant Boolean := False; Use_Ada_Main_Program_Name : constant Boolean := False; - Frontend_Exceptions : constant Boolean := False; ZCX_By_Default : constant Boolean := True; end System; diff --git a/gcc/ada/libgnat/system-djgpp.ads b/gcc/ada/libgnat/system-djgpp.ads index 31a5351..1148a46 100644 --- a/gcc/ada/libgnat/system-djgpp.ads +++ b/gcc/ada/libgnat/system-djgpp.ads @@ -140,7 +140,6 @@ private Always_Compatible_Rep : constant Boolean := False; Suppress_Standard_Library : constant Boolean := False; Use_Ada_Main_Program_Name : constant Boolean := False; - Frontend_Exceptions : constant Boolean := False; ZCX_By_Default : constant Boolean := True; end System; diff --git a/gcc/ada/libgnat/system-dragonfly-x86_64.ads b/gcc/ada/libgnat/system-dragonfly-x86_64.ads index 37726fe..90abfe9 100644 --- a/gcc/ada/libgnat/system-dragonfly-x86_64.ads +++ b/gcc/ada/libgnat/system-dragonfly-x86_64.ads @@ -140,7 +140,6 @@ private Always_Compatible_Rep : constant Boolean := False; Suppress_Standard_Library : constant Boolean := False; Use_Ada_Main_Program_Name : constant Boolean := False; - Frontend_Exceptions : constant Boolean := False; ZCX_By_Default : constant Boolean := True; end System; diff --git a/gcc/ada/libgnat/system-freebsd.ads b/gcc/ada/libgnat/system-freebsd.ads index 3604280..fcc0c4f 100644 --- a/gcc/ada/libgnat/system-freebsd.ads +++ b/gcc/ada/libgnat/system-freebsd.ads @@ -141,7 +141,6 @@ private Always_Compatible_Rep : constant Boolean := False; Suppress_Standard_Library : constant Boolean := False; Use_Ada_Main_Program_Name : constant Boolean := False; - Frontend_Exceptions : constant Boolean := False; ZCX_By_Default : constant Boolean := True; end System; diff --git a/gcc/ada/libgnat/system-hpux-ia64.ads b/gcc/ada/libgnat/system-hpux-ia64.ads index 4268ff5..0562bf7 100644 --- a/gcc/ada/libgnat/system-hpux-ia64.ads +++ b/gcc/ada/libgnat/system-hpux-ia64.ads @@ -140,7 +140,6 @@ private Always_Compatible_Rep : constant Boolean := False; Suppress_Standard_Library : constant Boolean := False; Use_Ada_Main_Program_Name : constant Boolean := False; - Frontend_Exceptions : constant Boolean := False; ZCX_By_Default : constant Boolean := True; end System; diff --git a/gcc/ada/libgnat/system-hpux.ads b/gcc/ada/libgnat/system-hpux.ads index a412645..a8848d6 100644 --- a/gcc/ada/libgnat/system-hpux.ads +++ b/gcc/ada/libgnat/system-hpux.ads @@ -139,7 +139,6 @@ private Always_Compatible_Rep : constant Boolean := False; Suppress_Standard_Library : constant Boolean := False; Use_Ada_Main_Program_Name : constant Boolean := False; - Frontend_Exceptions : constant Boolean := False; ZCX_By_Default : constant Boolean := True; -------------------------- diff --git a/gcc/ada/libgnat/system-linux-alpha.ads b/gcc/ada/libgnat/system-linux-alpha.ads index b6f1550..56d708d 100644 --- a/gcc/ada/libgnat/system-linux-alpha.ads +++ b/gcc/ada/libgnat/system-linux-alpha.ads @@ -140,7 +140,6 @@ private Always_Compatible_Rep : constant Boolean := False; Suppress_Standard_Library : constant Boolean := False; Use_Ada_Main_Program_Name : constant Boolean := False; - Frontend_Exceptions : constant Boolean := False; ZCX_By_Default : constant Boolean := True; end System; diff --git a/gcc/ada/libgnat/system-linux-arm.ads b/gcc/ada/libgnat/system-linux-arm.ads index 10fc281..6f2cb24 100644 --- a/gcc/ada/libgnat/system-linux-arm.ads +++ b/gcc/ada/libgnat/system-linux-arm.ads @@ -149,7 +149,6 @@ private Always_Compatible_Rep : constant Boolean := False; Suppress_Standard_Library : constant Boolean := False; Use_Ada_Main_Program_Name : constant Boolean := False; - Frontend_Exceptions : constant Boolean := False; ZCX_By_Default : constant Boolean := True; end System; diff --git a/gcc/ada/libgnat/system-linux-hppa.ads b/gcc/ada/libgnat/system-linux-hppa.ads index 9a40009..d4b8364 100644 --- a/gcc/ada/libgnat/system-linux-hppa.ads +++ b/gcc/ada/libgnat/system-linux-hppa.ads @@ -139,7 +139,6 @@ private Always_Compatible_Rep : constant Boolean := False; Suppress_Standard_Library : constant Boolean := False; Use_Ada_Main_Program_Name : constant Boolean := False; - Frontend_Exceptions : constant Boolean := False; ZCX_By_Default : constant Boolean := True; end System; diff --git a/gcc/ada/libgnat/system-linux-ia64.ads b/gcc/ada/libgnat/system-linux-ia64.ads index 85e9c9e..0ebc233 100644 --- a/gcc/ada/libgnat/system-linux-ia64.ads +++ b/gcc/ada/libgnat/system-linux-ia64.ads @@ -148,7 +148,6 @@ private Always_Compatible_Rep : constant Boolean := False; Suppress_Standard_Library : constant Boolean := False; Use_Ada_Main_Program_Name : constant Boolean := False; - Frontend_Exceptions : constant Boolean := False; ZCX_By_Default : constant Boolean := True; end System; diff --git a/gcc/ada/libgnat/system-linux-m68k.ads b/gcc/ada/libgnat/system-linux-m68k.ads index 83ac5ea..2189465 100644 --- a/gcc/ada/libgnat/system-linux-m68k.ads +++ b/gcc/ada/libgnat/system-linux-m68k.ads @@ -150,7 +150,6 @@ private Always_Compatible_Rep : constant Boolean := False; Suppress_Standard_Library : constant Boolean := False; Use_Ada_Main_Program_Name : constant Boolean := False; - Frontend_Exceptions : constant Boolean := False; ZCX_By_Default : constant Boolean := True; end System; diff --git a/gcc/ada/libgnat/system-linux-mips.ads b/gcc/ada/libgnat/system-linux-mips.ads index 5013883..d3bafb2 100644 --- a/gcc/ada/libgnat/system-linux-mips.ads +++ b/gcc/ada/libgnat/system-linux-mips.ads @@ -140,7 +140,6 @@ private Always_Compatible_Rep : constant Boolean := False; Suppress_Standard_Library : constant Boolean := False; Use_Ada_Main_Program_Name : constant Boolean := False; - Frontend_Exceptions : constant Boolean := False; ZCX_By_Default : constant Boolean := True; end System; diff --git a/gcc/ada/libgnat/system-linux-ppc.ads b/gcc/ada/libgnat/system-linux-ppc.ads index 84cf532..0b8aad9 100644 --- a/gcc/ada/libgnat/system-linux-ppc.ads +++ b/gcc/ada/libgnat/system-linux-ppc.ads @@ -148,7 +148,6 @@ private Always_Compatible_Rep : constant Boolean := False; Suppress_Standard_Library : constant Boolean := False; Use_Ada_Main_Program_Name : constant Boolean := False; - Frontend_Exceptions : constant Boolean := False; ZCX_By_Default : constant Boolean := True; end System; diff --git a/gcc/ada/libgnat/system-linux-riscv.ads b/gcc/ada/libgnat/system-linux-riscv.ads index 56f4d09..c656604 100644 --- a/gcc/ada/libgnat/system-linux-riscv.ads +++ b/gcc/ada/libgnat/system-linux-riscv.ads @@ -139,7 +139,6 @@ private Always_Compatible_Rep : constant Boolean := False; Suppress_Standard_Library : constant Boolean := False; Use_Ada_Main_Program_Name : constant Boolean := False; - Frontend_Exceptions : constant Boolean := False; ZCX_By_Default : constant Boolean := True; end System; diff --git a/gcc/ada/libgnat/system-linux-s390.ads b/gcc/ada/libgnat/system-linux-s390.ads index 24803e2..ee1e87a 100644 --- a/gcc/ada/libgnat/system-linux-s390.ads +++ b/gcc/ada/libgnat/system-linux-s390.ads @@ -139,7 +139,6 @@ private Always_Compatible_Rep : constant Boolean := False; Suppress_Standard_Library : constant Boolean := False; Use_Ada_Main_Program_Name : constant Boolean := False; - Frontend_Exceptions : constant Boolean := False; ZCX_By_Default : constant Boolean := True; end System; diff --git a/gcc/ada/libgnat/system-linux-sh4.ads b/gcc/ada/libgnat/system-linux-sh4.ads index 5cee747..c4fb6ed 100644 --- a/gcc/ada/libgnat/system-linux-sh4.ads +++ b/gcc/ada/libgnat/system-linux-sh4.ads @@ -147,7 +147,6 @@ private Always_Compatible_Rep : constant Boolean := False; Suppress_Standard_Library : constant Boolean := False; Use_Ada_Main_Program_Name : constant Boolean := False; - Frontend_Exceptions : constant Boolean := False; ZCX_By_Default : constant Boolean := True; end System; diff --git a/gcc/ada/libgnat/system-linux-sparc.ads b/gcc/ada/libgnat/system-linux-sparc.ads index db46b74..cc502da 100644 --- a/gcc/ada/libgnat/system-linux-sparc.ads +++ b/gcc/ada/libgnat/system-linux-sparc.ads @@ -139,7 +139,6 @@ private Always_Compatible_Rep : constant Boolean := False; Suppress_Standard_Library : constant Boolean := False; Use_Ada_Main_Program_Name : constant Boolean := False; - Frontend_Exceptions : constant Boolean := False; ZCX_By_Default : constant Boolean := True; end System; diff --git a/gcc/ada/libgnat/system-linux-x86.ads b/gcc/ada/libgnat/system-linux-x86.ads index 87eb903..9336207 100644 --- a/gcc/ada/libgnat/system-linux-x86.ads +++ b/gcc/ada/libgnat/system-linux-x86.ads @@ -148,7 +148,6 @@ private Always_Compatible_Rep : constant Boolean := False; Suppress_Standard_Library : constant Boolean := False; Use_Ada_Main_Program_Name : constant Boolean := False; - Frontend_Exceptions : constant Boolean := False; ZCX_By_Default : constant Boolean := True; end System; diff --git a/gcc/ada/libgnat/system-lynxos178-ppc.ads b/gcc/ada/libgnat/system-lynxos178-ppc.ads index ebf8132..2a693c5 100644 --- a/gcc/ada/libgnat/system-lynxos178-ppc.ads +++ b/gcc/ada/libgnat/system-lynxos178-ppc.ads @@ -154,7 +154,6 @@ private Always_Compatible_Rep : constant Boolean := False; Suppress_Standard_Library : constant Boolean := False; Use_Ada_Main_Program_Name : constant Boolean := False; - Frontend_Exceptions : constant Boolean := False; ZCX_By_Default : constant Boolean := False; end System; diff --git a/gcc/ada/libgnat/system-lynxos178-x86.ads b/gcc/ada/libgnat/system-lynxos178-x86.ads index 302a2f3..2f13aae 100644 --- a/gcc/ada/libgnat/system-lynxos178-x86.ads +++ b/gcc/ada/libgnat/system-lynxos178-x86.ads @@ -154,7 +154,6 @@ private Always_Compatible_Rep : constant Boolean := False; Suppress_Standard_Library : constant Boolean := False; Use_Ada_Main_Program_Name : constant Boolean := False; - Frontend_Exceptions : constant Boolean := False; ZCX_By_Default : constant Boolean := False; end System; diff --git a/gcc/ada/libgnat/system-mingw.ads b/gcc/ada/libgnat/system-mingw.ads index 77fb6f0..a2eaf6a 100644 --- a/gcc/ada/libgnat/system-mingw.ads +++ b/gcc/ada/libgnat/system-mingw.ads @@ -140,7 +140,6 @@ private Always_Compatible_Rep : constant Boolean := False; Suppress_Standard_Library : constant Boolean := False; Use_Ada_Main_Program_Name : constant Boolean := False; - Frontend_Exceptions : constant Boolean := False; ZCX_By_Default : constant Boolean := True; --------------------------- diff --git a/gcc/ada/libgnat/system-qnx-aarch64.ads b/gcc/ada/libgnat/system-qnx-aarch64.ads index 827f9df..7e61ae3 100644 --- a/gcc/ada/libgnat/system-qnx-aarch64.ads +++ b/gcc/ada/libgnat/system-qnx-aarch64.ads @@ -149,7 +149,6 @@ private Always_Compatible_Rep : constant Boolean := False; Suppress_Standard_Library : constant Boolean := False; Use_Ada_Main_Program_Name : constant Boolean := False; - Frontend_Exceptions : constant Boolean := False; ZCX_By_Default : constant Boolean := True; end System; diff --git a/gcc/ada/libgnat/system-rtems.ads b/gcc/ada/libgnat/system-rtems.ads index 06f7831..5959b72 100644 --- a/gcc/ada/libgnat/system-rtems.ads +++ b/gcc/ada/libgnat/system-rtems.ads @@ -156,7 +156,6 @@ private Always_Compatible_Rep : constant Boolean := False; Suppress_Standard_Library : constant Boolean := False; Use_Ada_Main_Program_Name : constant Boolean := False; - Frontend_Exceptions : constant Boolean := False; ZCX_By_Default : constant Boolean := True; end System; diff --git a/gcc/ada/libgnat/system-solaris-sparc.ads b/gcc/ada/libgnat/system-solaris-sparc.ads index 2ba5198..c15a517 100644 --- a/gcc/ada/libgnat/system-solaris-sparc.ads +++ b/gcc/ada/libgnat/system-solaris-sparc.ads @@ -140,7 +140,6 @@ private Always_Compatible_Rep : constant Boolean := False; Suppress_Standard_Library : constant Boolean := False; Use_Ada_Main_Program_Name : constant Boolean := False; - Frontend_Exceptions : constant Boolean := False; ZCX_By_Default : constant Boolean := True; end System; diff --git a/gcc/ada/libgnat/system-solaris-x86.ads b/gcc/ada/libgnat/system-solaris-x86.ads index 7872523..981e7ca 100644 --- a/gcc/ada/libgnat/system-solaris-x86.ads +++ b/gcc/ada/libgnat/system-solaris-x86.ads @@ -140,7 +140,6 @@ private Always_Compatible_Rep : constant Boolean := False; Suppress_Standard_Library : constant Boolean := False; Use_Ada_Main_Program_Name : constant Boolean := False; - Frontend_Exceptions : constant Boolean := False; ZCX_By_Default : constant Boolean := True; end System; diff --git a/gcc/ada/libgnat/system-vxworks-arm-rtp-smp.ads b/gcc/ada/libgnat/system-vxworks-arm-rtp-smp.ads index 4273245..42d14c4 100644 --- a/gcc/ada/libgnat/system-vxworks-arm-rtp-smp.ads +++ b/gcc/ada/libgnat/system-vxworks-arm-rtp-smp.ads @@ -158,7 +158,6 @@ private Always_Compatible_Rep : constant Boolean := False; Suppress_Standard_Library : constant Boolean := False; Use_Ada_Main_Program_Name : constant Boolean := False; - Frontend_Exceptions : constant Boolean := False; ZCX_By_Default : constant Boolean := True; Executable_Extension : constant String := ".vxe"; diff --git a/gcc/ada/libgnat/system-vxworks-arm-rtp.ads b/gcc/ada/libgnat/system-vxworks-arm-rtp.ads index 214e3d5..aa8515a 100644 --- a/gcc/ada/libgnat/system-vxworks-arm-rtp.ads +++ b/gcc/ada/libgnat/system-vxworks-arm-rtp.ads @@ -157,7 +157,6 @@ private Always_Compatible_Rep : constant Boolean := False; Suppress_Standard_Library : constant Boolean := False; Use_Ada_Main_Program_Name : constant Boolean := False; - Frontend_Exceptions : constant Boolean := False; ZCX_By_Default : constant Boolean := True; Executable_Extension : constant String := ".vxe"; diff --git a/gcc/ada/libgnat/system-vxworks-arm.ads b/gcc/ada/libgnat/system-vxworks-arm.ads index be391d0..ae09b78 100644 --- a/gcc/ada/libgnat/system-vxworks-arm.ads +++ b/gcc/ada/libgnat/system-vxworks-arm.ads @@ -152,7 +152,6 @@ private Always_Compatible_Rep : constant Boolean := False; Suppress_Standard_Library : constant Boolean := False; Use_Ada_Main_Program_Name : constant Boolean := True; - Frontend_Exceptions : constant Boolean := False; ZCX_By_Default : constant Boolean := True; Executable_Extension : constant String := ".out"; diff --git a/gcc/ada/libgnat/system-vxworks-e500-kernel.ads b/gcc/ada/libgnat/system-vxworks-e500-kernel.ads index 9ee828b..4b091ae 100644 --- a/gcc/ada/libgnat/system-vxworks-e500-kernel.ads +++ b/gcc/ada/libgnat/system-vxworks-e500-kernel.ads @@ -153,7 +153,6 @@ private Always_Compatible_Rep : constant Boolean := False; Suppress_Standard_Library : constant Boolean := False; Use_Ada_Main_Program_Name : constant Boolean := True; - Frontend_Exceptions : constant Boolean := False; ZCX_By_Default : constant Boolean := True; Executable_Extension : constant String := ".out"; diff --git a/gcc/ada/libgnat/system-vxworks-e500-rtp-smp.ads b/gcc/ada/libgnat/system-vxworks-e500-rtp-smp.ads index d7ab0a9..a5d4d87 100644 --- a/gcc/ada/libgnat/system-vxworks-e500-rtp-smp.ads +++ b/gcc/ada/libgnat/system-vxworks-e500-rtp-smp.ads @@ -159,7 +159,6 @@ private Always_Compatible_Rep : constant Boolean := False; Suppress_Standard_Library : constant Boolean := False; Use_Ada_Main_Program_Name : constant Boolean := False; - Frontend_Exceptions : constant Boolean := False; ZCX_By_Default : constant Boolean := True; Executable_Extension : constant String := ".vxe"; diff --git a/gcc/ada/libgnat/system-vxworks-e500-rtp.ads b/gcc/ada/libgnat/system-vxworks-e500-rtp.ads index e304d50..4f96385 100644 --- a/gcc/ada/libgnat/system-vxworks-e500-rtp.ads +++ b/gcc/ada/libgnat/system-vxworks-e500-rtp.ads @@ -157,7 +157,6 @@ private Always_Compatible_Rep : constant Boolean := False; Suppress_Standard_Library : constant Boolean := False; Use_Ada_Main_Program_Name : constant Boolean := False; - Frontend_Exceptions : constant Boolean := False; ZCX_By_Default : constant Boolean := True; Executable_Extension : constant String := ".vxe"; diff --git a/gcc/ada/libgnat/system-vxworks-ppc-kernel.ads b/gcc/ada/libgnat/system-vxworks-ppc-kernel.ads index 6cf9b3f..b8a0ba1 100644 --- a/gcc/ada/libgnat/system-vxworks-ppc-kernel.ads +++ b/gcc/ada/libgnat/system-vxworks-ppc-kernel.ads @@ -152,7 +152,6 @@ private Always_Compatible_Rep : constant Boolean := False; Suppress_Standard_Library : constant Boolean := False; Use_Ada_Main_Program_Name : constant Boolean := True; - Frontend_Exceptions : constant Boolean := False; ZCX_By_Default : constant Boolean := True; Executable_Extension : constant String := ".out"; diff --git a/gcc/ada/libgnat/system-vxworks-ppc-rtp-smp.ads b/gcc/ada/libgnat/system-vxworks-ppc-rtp-smp.ads index 07da01d..ecfd7e6 100644 --- a/gcc/ada/libgnat/system-vxworks-ppc-rtp-smp.ads +++ b/gcc/ada/libgnat/system-vxworks-ppc-rtp-smp.ads @@ -158,7 +158,6 @@ private Always_Compatible_Rep : constant Boolean := False; Suppress_Standard_Library : constant Boolean := False; Use_Ada_Main_Program_Name : constant Boolean := False; - Frontend_Exceptions : constant Boolean := False; ZCX_By_Default : constant Boolean := True; Executable_Extension : constant String := ".vxe"; diff --git a/gcc/ada/libgnat/system-vxworks-ppc-rtp.ads b/gcc/ada/libgnat/system-vxworks-ppc-rtp.ads index b6807b3..72fb963 100644 --- a/gcc/ada/libgnat/system-vxworks-ppc-rtp.ads +++ b/gcc/ada/libgnat/system-vxworks-ppc-rtp.ads @@ -157,7 +157,6 @@ private Always_Compatible_Rep : constant Boolean := False; Suppress_Standard_Library : constant Boolean := False; Use_Ada_Main_Program_Name : constant Boolean := False; - Frontend_Exceptions : constant Boolean := False; ZCX_By_Default : constant Boolean := True; Executable_Extension : constant String := ".vxe"; diff --git a/gcc/ada/libgnat/system-vxworks-x86-kernel.ads b/gcc/ada/libgnat/system-vxworks-x86-kernel.ads index c8cbf52..4c912b8 100644 --- a/gcc/ada/libgnat/system-vxworks-x86-kernel.ads +++ b/gcc/ada/libgnat/system-vxworks-x86-kernel.ads @@ -156,7 +156,6 @@ private Always_Compatible_Rep : constant Boolean := False; Suppress_Standard_Library : constant Boolean := False; Use_Ada_Main_Program_Name : constant Boolean := True; - Frontend_Exceptions : constant Boolean := False; ZCX_By_Default : constant Boolean := True; Executable_Extension : constant String := ".out"; diff --git a/gcc/ada/libgnat/system-vxworks-x86-rtp-smp.ads b/gcc/ada/libgnat/system-vxworks-x86-rtp-smp.ads index d70642e..f8115a5 100644 --- a/gcc/ada/libgnat/system-vxworks-x86-rtp-smp.ads +++ b/gcc/ada/libgnat/system-vxworks-x86-rtp-smp.ads @@ -157,7 +157,6 @@ private Always_Compatible_Rep : constant Boolean := False; Suppress_Standard_Library : constant Boolean := False; Use_Ada_Main_Program_Name : constant Boolean := False; - Frontend_Exceptions : constant Boolean := False; ZCX_By_Default : constant Boolean := True; Executable_Extension : constant String := ".vxe"; diff --git a/gcc/ada/libgnat/system-vxworks-x86-rtp.ads b/gcc/ada/libgnat/system-vxworks-x86-rtp.ads index 262445d..8894abb 100644 --- a/gcc/ada/libgnat/system-vxworks-x86-rtp.ads +++ b/gcc/ada/libgnat/system-vxworks-x86-rtp.ads @@ -156,7 +156,6 @@ private Always_Compatible_Rep : constant Boolean := False; Suppress_Standard_Library : constant Boolean := False; Use_Ada_Main_Program_Name : constant Boolean := False; - Frontend_Exceptions : constant Boolean := False; ZCX_By_Default : constant Boolean := True; Executable_Extension : constant String := ".vxe"; diff --git a/gcc/ada/libgnat/system-vxworks7-aarch64-rtp-smp.ads b/gcc/ada/libgnat/system-vxworks7-aarch64-rtp-smp.ads index a739441..0556cbf 100644 --- a/gcc/ada/libgnat/system-vxworks7-aarch64-rtp-smp.ads +++ b/gcc/ada/libgnat/system-vxworks7-aarch64-rtp-smp.ads @@ -157,7 +157,6 @@ private Always_Compatible_Rep : constant Boolean := False; Suppress_Standard_Library : constant Boolean := False; Use_Ada_Main_Program_Name : constant Boolean := False; - Frontend_Exceptions : constant Boolean := False; ZCX_By_Default : constant Boolean := True; Executable_Extension : constant String := ".vxe"; diff --git a/gcc/ada/libgnat/system-vxworks7-aarch64.ads b/gcc/ada/libgnat/system-vxworks7-aarch64.ads index 840682b..8bf58b7 100644 --- a/gcc/ada/libgnat/system-vxworks7-aarch64.ads +++ b/gcc/ada/libgnat/system-vxworks7-aarch64.ads @@ -154,7 +154,6 @@ private Always_Compatible_Rep : constant Boolean := False; Suppress_Standard_Library : constant Boolean := False; Use_Ada_Main_Program_Name : constant Boolean := True; - Frontend_Exceptions : constant Boolean := False; ZCX_By_Default : constant Boolean := True; Executable_Extension : constant String := ".out"; diff --git a/gcc/ada/libgnat/system-vxworks7-arm-rtp-smp.ads b/gcc/ada/libgnat/system-vxworks7-arm-rtp-smp.ads index c82f8fc..1341b9d 100644 --- a/gcc/ada/libgnat/system-vxworks7-arm-rtp-smp.ads +++ b/gcc/ada/libgnat/system-vxworks7-arm-rtp-smp.ads @@ -154,7 +154,6 @@ private Always_Compatible_Rep : constant Boolean := False; Suppress_Standard_Library : constant Boolean := False; Use_Ada_Main_Program_Name : constant Boolean := False; - Frontend_Exceptions : constant Boolean := False; ZCX_By_Default : constant Boolean := True; Executable_Extension : constant String := ".vxe"; diff --git a/gcc/ada/libgnat/system-vxworks7-arm.ads b/gcc/ada/libgnat/system-vxworks7-arm.ads index be391d0..ae09b78 100644 --- a/gcc/ada/libgnat/system-vxworks7-arm.ads +++ b/gcc/ada/libgnat/system-vxworks7-arm.ads @@ -152,7 +152,6 @@ private Always_Compatible_Rep : constant Boolean := False; Suppress_Standard_Library : constant Boolean := False; Use_Ada_Main_Program_Name : constant Boolean := True; - Frontend_Exceptions : constant Boolean := False; ZCX_By_Default : constant Boolean := True; Executable_Extension : constant String := ".out"; diff --git a/gcc/ada/libgnat/system-vxworks7-e500-kernel.ads b/gcc/ada/libgnat/system-vxworks7-e500-kernel.ads index bb72157..c7b2c97 100644 --- a/gcc/ada/libgnat/system-vxworks7-e500-kernel.ads +++ b/gcc/ada/libgnat/system-vxworks7-e500-kernel.ads @@ -153,7 +153,6 @@ private Always_Compatible_Rep : constant Boolean := False; Suppress_Standard_Library : constant Boolean := False; Use_Ada_Main_Program_Name : constant Boolean := True; - Frontend_Exceptions : constant Boolean := False; ZCX_By_Default : constant Boolean := True; Executable_Extension : constant String := ".out"; diff --git a/gcc/ada/libgnat/system-vxworks7-e500-rtp-smp.ads b/gcc/ada/libgnat/system-vxworks7-e500-rtp-smp.ads index d4b4dce..a9dbf97 100644 --- a/gcc/ada/libgnat/system-vxworks7-e500-rtp-smp.ads +++ b/gcc/ada/libgnat/system-vxworks7-e500-rtp-smp.ads @@ -158,7 +158,6 @@ private Always_Compatible_Rep : constant Boolean := False; Suppress_Standard_Library : constant Boolean := False; Use_Ada_Main_Program_Name : constant Boolean := False; - Frontend_Exceptions : constant Boolean := False; ZCX_By_Default : constant Boolean := True; Executable_Extension : constant String := ".vxe"; diff --git a/gcc/ada/libgnat/system-vxworks7-e500-rtp.ads b/gcc/ada/libgnat/system-vxworks7-e500-rtp.ads index 7f7f817..83e44cb 100644 --- a/gcc/ada/libgnat/system-vxworks7-e500-rtp.ads +++ b/gcc/ada/libgnat/system-vxworks7-e500-rtp.ads @@ -157,7 +157,6 @@ private Always_Compatible_Rep : constant Boolean := False; Suppress_Standard_Library : constant Boolean := False; Use_Ada_Main_Program_Name : constant Boolean := False; - Frontend_Exceptions : constant Boolean := False; ZCX_By_Default : constant Boolean := True; Executable_Extension : constant String := ".vxe"; diff --git a/gcc/ada/libgnat/system-vxworks7-ppc-kernel.ads b/gcc/ada/libgnat/system-vxworks7-ppc-kernel.ads index 2b83609..e7dfc29 100644 --- a/gcc/ada/libgnat/system-vxworks7-ppc-kernel.ads +++ b/gcc/ada/libgnat/system-vxworks7-ppc-kernel.ads @@ -152,7 +152,6 @@ private Always_Compatible_Rep : constant Boolean := False; Suppress_Standard_Library : constant Boolean := False; Use_Ada_Main_Program_Name : constant Boolean := True; - Frontend_Exceptions : constant Boolean := False; ZCX_By_Default : constant Boolean := True; Executable_Extension : constant String := ".out"; diff --git a/gcc/ada/libgnat/system-vxworks7-ppc-rtp-smp.ads b/gcc/ada/libgnat/system-vxworks7-ppc-rtp-smp.ads index f232b34..146a87b 100644 --- a/gcc/ada/libgnat/system-vxworks7-ppc-rtp-smp.ads +++ b/gcc/ada/libgnat/system-vxworks7-ppc-rtp-smp.ads @@ -157,7 +157,6 @@ private Always_Compatible_Rep : constant Boolean := False; Suppress_Standard_Library : constant Boolean := False; Use_Ada_Main_Program_Name : constant Boolean := False; - Frontend_Exceptions : constant Boolean := False; ZCX_By_Default : constant Boolean := True; Executable_Extension : constant String := ".vxe"; diff --git a/gcc/ada/libgnat/system-vxworks7-ppc-rtp.ads b/gcc/ada/libgnat/system-vxworks7-ppc-rtp.ads index 1c59deb..0e448d4 100644 --- a/gcc/ada/libgnat/system-vxworks7-ppc-rtp.ads +++ b/gcc/ada/libgnat/system-vxworks7-ppc-rtp.ads @@ -157,7 +157,6 @@ private Always_Compatible_Rep : constant Boolean := False; Suppress_Standard_Library : constant Boolean := False; Use_Ada_Main_Program_Name : constant Boolean := False; - Frontend_Exceptions : constant Boolean := False; ZCX_By_Default : constant Boolean := True; Executable_Extension : constant String := ".vxe"; diff --git a/gcc/ada/libgnat/system-vxworks7-ppc64-kernel.ads b/gcc/ada/libgnat/system-vxworks7-ppc64-kernel.ads index 942c4b1..70c1e7c 100644 --- a/gcc/ada/libgnat/system-vxworks7-ppc64-kernel.ads +++ b/gcc/ada/libgnat/system-vxworks7-ppc64-kernel.ads @@ -154,7 +154,6 @@ private Always_Compatible_Rep : constant Boolean := False; Suppress_Standard_Library : constant Boolean := False; Use_Ada_Main_Program_Name : constant Boolean := True; - Frontend_Exceptions : constant Boolean := False; ZCX_By_Default : constant Boolean := True; Executable_Extension : constant String := ".out"; diff --git a/gcc/ada/libgnat/system-vxworks7-ppc64-rtp-smp.ads b/gcc/ada/libgnat/system-vxworks7-ppc64-rtp-smp.ads index 42aeb34..bb42c6a1 100644 --- a/gcc/ada/libgnat/system-vxworks7-ppc64-rtp-smp.ads +++ b/gcc/ada/libgnat/system-vxworks7-ppc64-rtp-smp.ads @@ -157,7 +157,6 @@ private Always_Compatible_Rep : constant Boolean := False; Suppress_Standard_Library : constant Boolean := False; Use_Ada_Main_Program_Name : constant Boolean := False; - Frontend_Exceptions : constant Boolean := False; ZCX_By_Default : constant Boolean := True; Executable_Extension : constant String := ".vxe"; diff --git a/gcc/ada/libgnat/system-vxworks7-x86-kernel.ads b/gcc/ada/libgnat/system-vxworks7-x86-kernel.ads index f84d8f0..f7be01d 100644 --- a/gcc/ada/libgnat/system-vxworks7-x86-kernel.ads +++ b/gcc/ada/libgnat/system-vxworks7-x86-kernel.ads @@ -153,7 +153,6 @@ private Always_Compatible_Rep : constant Boolean := False; Suppress_Standard_Library : constant Boolean := False; Use_Ada_Main_Program_Name : constant Boolean := True; - Frontend_Exceptions : constant Boolean := False; ZCX_By_Default : constant Boolean := True; Executable_Extension : constant String := ".out"; diff --git a/gcc/ada/libgnat/system-vxworks7-x86-rtp-smp.ads b/gcc/ada/libgnat/system-vxworks7-x86-rtp-smp.ads index 26e35ab..05cadbc 100644 --- a/gcc/ada/libgnat/system-vxworks7-x86-rtp-smp.ads +++ b/gcc/ada/libgnat/system-vxworks7-x86-rtp-smp.ads @@ -156,7 +156,6 @@ private Always_Compatible_Rep : constant Boolean := False; Suppress_Standard_Library : constant Boolean := False; Use_Ada_Main_Program_Name : constant Boolean := False; - Frontend_Exceptions : constant Boolean := False; ZCX_By_Default : constant Boolean := True; Executable_Extension : constant String := ".vxe"; diff --git a/gcc/ada/libgnat/system-vxworks7-x86-rtp.ads b/gcc/ada/libgnat/system-vxworks7-x86-rtp.ads index 9eb643c..aebbfd7 100644 --- a/gcc/ada/libgnat/system-vxworks7-x86-rtp.ads +++ b/gcc/ada/libgnat/system-vxworks7-x86-rtp.ads @@ -156,7 +156,6 @@ private Always_Compatible_Rep : constant Boolean := False; Suppress_Standard_Library : constant Boolean := False; Use_Ada_Main_Program_Name : constant Boolean := False; - Frontend_Exceptions : constant Boolean := False; ZCX_By_Default : constant Boolean := True; Executable_Extension : constant String := ".vxe"; diff --git a/gcc/ada/libgnat/system-vxworks7-x86_64-kernel.ads b/gcc/ada/libgnat/system-vxworks7-x86_64-kernel.ads index 6cdd59e..ed9850f 100644 --- a/gcc/ada/libgnat/system-vxworks7-x86_64-kernel.ads +++ b/gcc/ada/libgnat/system-vxworks7-x86_64-kernel.ads @@ -153,7 +153,6 @@ private Always_Compatible_Rep : constant Boolean := False; Suppress_Standard_Library : constant Boolean := False; Use_Ada_Main_Program_Name : constant Boolean := True; - Frontend_Exceptions : constant Boolean := False; ZCX_By_Default : constant Boolean := True; Executable_Extension : constant String := ".out"; diff --git a/gcc/ada/libgnat/system-vxworks7-x86_64-rtp-smp.ads b/gcc/ada/libgnat/system-vxworks7-x86_64-rtp-smp.ads index 47a91e6..3c98b4c 100644 --- a/gcc/ada/libgnat/system-vxworks7-x86_64-rtp-smp.ads +++ b/gcc/ada/libgnat/system-vxworks7-x86_64-rtp-smp.ads @@ -156,7 +156,6 @@ private Always_Compatible_Rep : constant Boolean := False; Suppress_Standard_Library : constant Boolean := False; Use_Ada_Main_Program_Name : constant Boolean := False; - Frontend_Exceptions : constant Boolean := False; ZCX_By_Default : constant Boolean := True; Executable_Extension : constant String := ".vxe"; diff --git a/gcc/ada/namet.adb b/gcc/ada/namet.adb index e8162e4..50dc783 100644 --- a/gcc/ada/namet.adb +++ b/gcc/ada/namet.adb @@ -170,39 +170,39 @@ package body Namet is (Buf : in out Bounded_String; Id : Valid_Name_Id) is - C : Character; - P : Natural; Temp : Bounded_String; + function Has_Encodings (Temp : Bounded_String) return Boolean; + -- True if Temp contains encoded characters. If not, we can set + -- Name_Has_No_Encodings to True below, and never call this again + -- on the same Name_Id. + + function Has_Encodings (Temp : Bounded_String) return Boolean is + begin + for J in 1 .. Temp.Length loop + if Temp.Chars (J) in 'U' | 'W' | 'Q' | 'O' then + return True; + end if; + end loop; + + return False; + end Has_Encodings; + begin Append (Temp, Id); - -- Skip scan if we already know there are no encodings + -- Skip scan if we already know there are no encodings (i.e. the first + -- time this was called on Id, the Has_Encodings call below returned + -- False). if Name_Entries.Table (Id).Name_Has_No_Encodings then goto Done; end if; - -- Quick loop to see if there is anything special to do - - P := 1; - loop - if P = Temp.Length then - Name_Entries.Table (Id).Name_Has_No_Encodings := True; - goto Done; - - else - C := Temp.Chars (P); - - exit when - C = 'U' or else - C = 'W' or else - C = 'Q' or else - C = 'O'; - - P := P + 1; - end if; - end loop; + if not Has_Encodings (Temp) then + Name_Entries.Table (Id).Name_Has_No_Encodings := True; + goto Done; + end if; -- Here we have at least some encoding that we must decode @@ -235,8 +235,7 @@ package body Namet is if C = 'U' and then Old < Temp.Length - and then Temp.Chars (Old + 1) not in 'A' .. 'Z' - and then Temp.Chars (Old + 1) /= '_' + and then Temp.Chars (Old + 1) not in 'A' .. 'Z' | '_' then Old := Old + 1; @@ -274,8 +273,7 @@ package body Namet is elsif C = 'W' and then Old < Temp.Length - and then Temp.Chars (Old + 1) not in 'A' .. 'Z' - and then Temp.Chars (Old + 1) /= '_' + and then Temp.Chars (Old + 1) not in 'A' .. 'Z' | '_' then Old := Old + 1; Widechar.Set_Wide (Char_Code (Hex (4)), New_Buf, New_Len); @@ -301,7 +299,7 @@ package body Namet is C := Temp.Chars (Old); Old := Old + 1; - pragma Assert (C in '0' .. '9' or else C in 'a' .. 'f'); + pragma Assert (C in '0' .. '9' | 'a' .. 'f'); if C <= '9' then T := 16 * T + Character'Pos (C) - Character'Pos ('0'); @@ -347,8 +345,7 @@ package body Namet is elsif Temp.Chars (Old) = 'O' and then Old < Temp.Length - and then Temp.Chars (Old + 1) not in 'A' .. 'Z' - and then Temp.Chars (Old + 1) /= '_' + and then Temp.Chars (Old + 1) not in 'A' .. 'Z' | '_' then Old := Old + 1; @@ -501,8 +498,7 @@ package body Namet is elsif Temp.Chars (P) = 'W' and then P + 9 <= Temp.Length and then Temp.Chars (P + 1) = 'W' - and then Temp.Chars (P + 2) not in 'A' .. 'Z' - and then Temp.Chars (P + 2) /= '_' + and then Temp.Chars (P + 2) not in 'A' .. 'Z' | '_' then Temp.Chars (P + 12 .. Temp.Length + 2) := Temp.Chars (P + 10 .. Temp.Length); @@ -517,8 +513,7 @@ package body Namet is elsif Temp.Chars (P) = 'W' and then P < Temp.Length - and then Temp.Chars (P + 1) not in 'A' .. 'Z' - and then Temp.Chars (P + 1) /= '_' + and then Temp.Chars (P + 1) not in 'A' .. 'Z' | '_' then Temp.Chars (P + 8 .. P + Temp.Length + 3) := Temp.Chars (P + 5 .. Temp.Length); @@ -571,7 +566,7 @@ package body Namet is declare CC : constant Character := Get_Character (C); begin - if CC in 'a' .. 'z' or else CC in '0' .. '9' then + if CC in 'a' .. 'z' | '0' .. '9' then Buf.Chars (Buf.Length) := CC; else Buf.Chars (Buf.Length) := 'U'; @@ -625,6 +620,25 @@ package body Namet is Append (Buf, Temp); end Append_Unqualified_Decoded; + -------------------------------- + -- Destroy_Global_Name_Buffer -- + -------------------------------- + + procedure Destroy_Global_Name_Buffer is + procedure Do_It; + -- Do the work. Needed only for "pragma Debug" below, so we don't do + -- anything in production mode. + + procedure Do_It is + begin + Global_Name_Buffer.Length := Global_Name_Buffer.Max_Length; + Global_Name_Buffer.Chars := (others => '!'); + end Do_It; + pragma Debug (Do_It); + begin + null; + end Destroy_Global_Name_Buffer; + -------------- -- Finalize -- -------------- @@ -990,9 +1004,7 @@ package body Namet is begin -- Any name starting or ending with underscore is internal - if Buf.Chars (1) = '_' - or else Buf.Chars (Buf.Length) = '_' - then + if Buf.Chars (1) = '_' or else Buf.Chars (Buf.Length) = '_' then return True; -- Allow quoted character @@ -1059,12 +1071,7 @@ package body Namet is function Is_OK_Internal_Letter (C : Character) return Boolean is begin - return C in 'A' .. 'Z' - and then C /= 'O' - and then C /= 'Q' - and then C /= 'U' - and then C /= 'W' - and then C /= 'X'; + return C in 'A' .. 'Z' and then C not in 'O' | 'Q' | 'U' | 'W' | 'X'; end Is_OK_Internal_Letter; ---------------------- @@ -1450,9 +1457,7 @@ package body Namet is exit; end if; - exit when Buf.Chars (J) /= 'b' - and then Buf.Chars (J) /= 'n' - and then Buf.Chars (J) /= 'p'; + exit when Buf.Chars (J) not in 'b' | 'n' | 'p'; end loop; -- Find rightmost __ or $ separator if one exists. First we position @@ -1535,25 +1540,7 @@ package body Namet is procedure wn (Id : Name_Id) is begin - if Is_Valid_Name (Id) then - declare - Buf : Bounded_String (Max_Length => Natural (Length_Of_Name (Id))); - begin - Append (Buf, Id); - Write_Str (Buf.Chars (1 .. Buf.Length)); - end; - - elsif Id = No_Name then - Write_Str ("<No_Name>"); - - elsif Id = Error_Name then - Write_Str ("<Error_Name>"); - - else - Write_Str ("<invalid name_id>"); - Write_Int (Int (Id)); - end if; - + Write_Name_For_Debug (Id); Write_Eol; end wn; @@ -1579,6 +1566,37 @@ package body Namet is Write_Str (Buf.Chars (1 .. Buf.Length)); end Write_Name_Decoded; + -------------------------- + -- Write_Name_For_Debug -- + -------------------------- + + procedure Write_Name_For_Debug (Id : Name_Id; Quote : String := "") is + begin + if Is_Valid_Name (Id) then + Write_Str (Quote); + + declare + Buf : Bounded_String (Max_Length => Natural (Length_Of_Name (Id))); + begin + Append (Buf, Id); + Write_Str (Buf.Chars (1 .. Buf.Length)); + end; + + Write_Str (Quote); + + elsif Id = No_Name then + Write_Str ("<No_Name>"); + + elsif Id = Error_Name then + Write_Str ("<Error_Name>"); + + else + Write_Str ("<invalid name "); + Write_Int (Int (Id)); + Write_Str (">"); + end if; + end Write_Name_For_Debug; + -- Package initialization, initialize tables begin diff --git a/gcc/ada/namet.ads b/gcc/ada/namet.ads index 87fc65e..11c88ef 100644 --- a/gcc/ada/namet.ads +++ b/gcc/ada/namet.ads @@ -166,6 +166,11 @@ package Namet is -- does a save/restore on Name_Len and Name_Buffer (1 .. Name_Len). This -- works in part because Name_Len is default-initialized to 0. + procedure Destroy_Global_Name_Buffer with Inline; + -- Overwrites Global_Name_Buffer with meaningless data. This can be used in + -- the transition away from Global_Name_Buffer, in order to detect cases + -- where we incorrectly rely on the global. + ----------------------------- -- Types for Namet Package -- ----------------------------- @@ -422,12 +427,16 @@ package Namet is -- Write_Name writes the characters of the specified name using the -- standard output procedures in package Output. The name is written -- in encoded form (i.e. including Uhh, Whhh, Qx, _op as they appear in - -- the name table). If Id is Error_Name, or No_Name, no text is output. + -- the name table). If Id is Error_Name or No_Name, no text is output. procedure Write_Name_Decoded (Id : Valid_Name_Id); -- Like Write_Name, except that the name written is the decoded name, as -- described for Append_Decoded. + procedure Write_Name_For_Debug (Id : Name_Id; Quote : String := ""); + -- Like Write_Name, except it tries to be robust in the presence of invalid + -- data, and valid names are surrounded by Quote. + function Name_Entries_Count return Nat; -- Return current number of entries in the names table @@ -537,14 +546,8 @@ package Namet is procedure wn (Id : Name_Id); pragma Export (Ada, wn); - -- This routine is intended for debugging use only (i.e. it is intended to - -- be called from the debugger). It writes the characters of the specified - -- name using the standard output procedures in package Output, followed by - -- a new line. The name is written in encoded form (i.e. including Uhh, - -- Whhh, Qx, _op as they appear in the name table). If Id is Error_Name, - -- No_Name, or invalid an appropriate string is written (<Error_Name>, - -- <No_Name>, <invalid name>). Unlike Write_Name, this call does not affect - -- the contents of Name_Buffer or Name_Len. + -- Write Id to standard output, followed by a newline. Intended to be + -- called in the debugger. private diff --git a/gcc/ada/opt.adb b/gcc/ada/opt.adb index 49e03b0..24f6cc9 100644 --- a/gcc/ada/opt.adb +++ b/gcc/ada/opt.adb @@ -23,28 +23,9 @@ -- -- ------------------------------------------------------------------------------ -package body Opt is - - ------------------------- - -- Back_End_Exceptions -- - ------------------------- - - function Back_End_Exceptions return Boolean is - begin - return - Exception_Mechanism = Back_End_SJLJ - or else - Exception_Mechanism = Back_End_ZCX; - end Back_End_Exceptions; +with Csets; use Csets; - ------------------------- - -- Front_End_Exceptions -- - ------------------------- - - function Front_End_Exceptions return Boolean is - begin - return Exception_Mechanism = Front_End_SJLJ; - end Front_End_Exceptions; +package body Opt is -------------------- -- SJLJ_Exceptions -- @@ -52,10 +33,7 @@ package body Opt is function SJLJ_Exceptions return Boolean is begin - return - Exception_Mechanism = Back_End_SJLJ - or else - Exception_Mechanism = Front_End_SJLJ; + return Exception_Mechanism = Back_End_SJLJ; end SJLJ_Exceptions; -------------------- @@ -210,6 +188,7 @@ package body Opt is Prefix_Exception_Messages := True; Uneval_Old := 'E'; Use_VADS_Size := False; + Identifier_Char ('[') := False; -- Note: we do not need to worry about Warnings_As_Errors_Count since -- we do not expect to get any warnings from compiling such a unit. diff --git a/gcc/ada/opt.ads b/gcc/ada/opt.ads index c38a93f..e747397 100644 --- a/gcc/ada/opt.ads +++ b/gcc/ada/opt.ads @@ -527,6 +527,12 @@ package Opt is -- WARNING: There is a matching C declaration of this variable in fe.h + Enable_CUDA_Expansion : Boolean := False; + -- GNAT, GNATBIND + -- Set to True to enable CUDA host expansion: + -- - Removal of CUDA_Global and CUDA_Device symbols + -- - Generation of kernel registration code in packages + Error_Msg_Line_Length : Nat := 0; -- GNAT -- Records the error message line length limit. If this is set to zero, @@ -567,13 +573,7 @@ package Opt is type Exception_Mechanism_Type is -- Determines the kind of mechanism used to handle exceptions -- - (Front_End_SJLJ, - -- Exceptions use setjmp/longjmp generated explicitly by the front end - -- (this includes gigi or other equivalent parts of the code generator). - -- AT END handlers are converted into exception handlers by the front - -- end in this mode. - - Back_End_ZCX, + (Back_End_ZCX, -- Exceptions are handled by the back end. The front end simply -- generates the handlers as they appear in the source, and AT END -- handlers are left untouched (they are not converted into exception @@ -589,16 +589,13 @@ package Opt is -- WARNING: There is a matching C declaration of this type in fe.h - Exception_Mechanism : Exception_Mechanism_Type := Front_End_SJLJ; + Exception_Mechanism : Exception_Mechanism_Type := Back_End_SJLJ; -- GNAT -- Set to the appropriate value depending on the flags in system.ads - -- (Frontend_Exceptions + ZCX_By_Default). The C convention is there to - -- allow access by gigi. + -- (ZCX_By_Default). The C convention is there to allow access by gigi. -- WARNING: There is a matching C declaration of this variable in fe.h - function Back_End_Exceptions return Boolean; - function Front_End_Exceptions return Boolean; function ZCX_Exceptions return Boolean; function SJLJ_Exceptions return Boolean; -- GNAT diff --git a/gcc/ada/osint.adb b/gcc/ada/osint.adb index af76dc7..a38ad78 100644 --- a/gcc/ada/osint.adb +++ b/gcc/ada/osint.adb @@ -34,7 +34,7 @@ with Sdefault; use Sdefault; with Table; with Targparm; use Targparm; -with Unchecked_Conversion; +with Ada.Unchecked_Conversion; pragma Warnings (Off); -- This package is used also by gnatcoll @@ -2216,9 +2216,9 @@ package body Osint is -- GNAT releases are available with these functions. function To_Int is - new Unchecked_Conversion (OS_Time, Underlying_OS_Time); + new Ada.Unchecked_Conversion (OS_Time, Underlying_OS_Time); function From_Int is - new Unchecked_Conversion (Underlying_OS_Time, OS_Time); + new Ada.Unchecked_Conversion (Underlying_OS_Time, OS_Time); TI : Underlying_OS_Time := To_Int (T); Y : Year_Type; @@ -2758,7 +2758,25 @@ package body Osint is begin if Std_Prefix = null then - Std_Prefix := Executable_Prefix; + Std_Prefix := String_Ptr (Getenv ("GNSA_ROOT")); + + if Std_Prefix.all = "" then + Std_Prefix := Executable_Prefix; + + elsif not Is_Directory_Separator (Std_Prefix (Std_Prefix'Last)) then + + -- The remainder of this function assumes that Std_Prefix + -- terminates with a dir separator, so we force this here. + + declare + Old_Prefix : String_Ptr := Std_Prefix; + begin + Std_Prefix := new String (1 .. Old_Prefix'Length + 1); + Std_Prefix (1 .. Old_Prefix'Length) := Old_Prefix.all; + Std_Prefix (Old_Prefix'Length + 1) := Directory_Separator; + Free (Old_Prefix); + end; + end if; if Std_Prefix.all /= "" then @@ -3085,8 +3103,8 @@ package body Osint is type Path_String_Access is access Path_String; function Address_To_Access is new - Unchecked_Conversion (Source => Address, - Target => Path_String_Access); + Ada.Unchecked_Conversion (Source => Address, + Target => Path_String_Access); Path_Access : constant Path_String_Access := Address_To_Access (Path_Addr); diff --git a/gcc/ada/osint.ads b/gcc/ada/osint.ads index a4a863e..328619c 100644 --- a/gcc/ada/osint.ads +++ b/gcc/ada/osint.ads @@ -237,8 +237,11 @@ package Osint is -- replace the Prefix substring with the root installation directory. -- By default, try to compute the root installation directory by looking -- at the executable name as it was typed on the command line and, if - -- needed, use the PATH environment variable. If the above computation - -- fails, return Path. This function assumes Prefix'First = Path'First. + -- needed, use the PATH environment variable. If the GNSA_ROOT environment + -- variable is set, then the content of this variable is used as the root + -- installation directory. + -- If the above computation fails, return Path. This function assumes + -- Prefix'First = Path'First. function Shared_Lib (Name : String) return String; -- Returns the runtime shared library in the form -l<name>-<version> where diff --git a/gcc/ada/scng.adb b/gcc/ada/scng.adb index c50a41e..cd10d1d 100644 --- a/gcc/ada/scng.adb +++ b/gcc/ada/scng.adb @@ -1421,7 +1421,7 @@ package body Scng is Token := Tok_Left_Paren; if Style_Check then - Style.Check_Left_Paren; + Style.Check_Left_Paren_Square_Bracket; end if; return; @@ -1437,6 +1437,11 @@ package body Scng is if Ada_Version >= Ada_2022 then Scan_Ptr := Scan_Ptr + 1; Token := Tok_Left_Bracket; + + if Style_Check then + Style.Check_Left_Paren_Square_Bracket; + end if; + return; elsif Source (Scan_Ptr + 1) = '"' then diff --git a/gcc/ada/sem.adb b/gcc/ada/sem.adb index ea64690..796fffb 100644 --- a/gcc/ada/sem.adb +++ b/gcc/ada/sem.adb @@ -61,7 +61,7 @@ with Stylesw; use Stylesw; with Uintp; use Uintp; with Uname; use Uname; -with Unchecked_Deallocation; +with Ada.Unchecked_Deallocation; pragma Warnings (Off, Sem_Util); -- Suppress warnings of unused with for Sem_Util (used only in asserts) @@ -1062,7 +1062,7 @@ package body Sem is procedure Initialize is Next : Suppress_Stack_Entry_Ptr; - procedure Free is new Unchecked_Deallocation + procedure Free is new Ada.Unchecked_Deallocation (Suppress_Stack_Entry, Suppress_Stack_Entry_Ptr); begin diff --git a/gcc/ada/sem_aggr.adb b/gcc/ada/sem_aggr.adb index 6e73aac..0437a50 100644 --- a/gcc/ada/sem_aggr.adb +++ b/gcc/ada/sem_aggr.adb @@ -1833,7 +1833,7 @@ package body Sem_Aggr is or else No (Iterator_Specification (Assoc)) then Error_Msg_N ("mixed iterated component association" - & " (RM 4.4.3 (17.1/5))", + & " (RM 4.3.3 (17.1/5))", Assoc); return False; end if; @@ -1852,7 +1852,7 @@ package body Sem_Aggr is and then Present (Iterator_Specification (Assoc)) then Error_Msg_N ("mixed iterated component association" - & " (RM 4.4.3 (17.1/5))", + & " (RM 4.3.3 (17.1/5))", Assoc); return False; end if; @@ -1860,9 +1860,6 @@ package body Sem_Aggr is Next (Assoc); end loop; - while Present (Assoc) loop - Next (Assoc); - end loop; end if; Assoc := First (Component_Associations (N)); diff --git a/gcc/ada/sem_attr.adb b/gcc/ada/sem_attr.adb index 4748567..55da9ef 100644 --- a/gcc/ada/sem_attr.adb +++ b/gcc/ada/sem_attr.adb @@ -12500,6 +12500,28 @@ package body Sem_Attr is when others => null; end case; + -- Ensure that attribute expressions are resolved at this stage; + -- required for preanalyzed references to discriminants since + -- their resolution (and expansion) will take care of updating + -- their Entity attribute to reference their discriminal. + + if Expander_Active + and then Present (Expressions (N)) + then + declare + Expr : Node_Id := First (Expressions (N)); + + begin + while Present (Expr) loop + if not Analyzed (Expr) then + Resolve (Expr, Etype (Expr)); + end if; + + Next (Expr); + end loop; + end; + end if; + -- If the prefix of the attribute is a class-wide type then it -- will be expanded into a dispatching call to a predefined -- primitive. Therefore we must check for potential violation diff --git a/gcc/ada/sem_ch12.adb b/gcc/ada/sem_ch12.adb index 963f353..6a914ec 100644 --- a/gcc/ada/sem_ch12.adb +++ b/gcc/ada/sem_ch12.adb @@ -5708,9 +5708,9 @@ package body Sem_Ch12 is Set_Scope (Inst_Id, Current_Scope); Set_Entity (Gen_Id, Gen_Unit); - Set_Is_Instantiated (Gen_Unit); if In_Extended_Main_Source_Unit (N) then + Set_Is_Instantiated (Gen_Unit); Generate_Reference (Gen_Unit, N); end if; diff --git a/gcc/ada/sem_ch13.adb b/gcc/ada/sem_ch13.adb index 3cac123..61f7ba7 100644 --- a/gcc/ada/sem_ch13.adb +++ b/gcc/ada/sem_ch13.adb @@ -11359,9 +11359,11 @@ package body Sem_Ch13 is when Aspect_Predicate_Failure => T := Standard_String; - -- Here is the list of aspects that don't require delay analysis + -- As for some other aspects above, the expression of this aspect is + -- just an entity that does not need any resolution, so just analyze. when Aspect_Designated_Storage_Model => + Analyze (Expression (ASN)); return; when Aspect_Storage_Model_Type => @@ -11389,6 +11391,8 @@ package body Sem_Ch13 is return; + -- Here is the list of aspects that don't require delay analysis + when Aspect_Abstract_State | Aspect_Annotate | Aspect_Async_Readers diff --git a/gcc/ada/sem_ch3.adb b/gcc/ada/sem_ch3.adb index 133178f..054648b 100644 --- a/gcc/ada/sem_ch3.adb +++ b/gcc/ada/sem_ch3.adb @@ -5435,7 +5435,7 @@ package body Sem_Ch3 is -- Finally this happens in some complex cases when validity checks are -- enabled, where the same subtype declaration may be analyzed twice. -- This can happen if the subtype is created by the preanalysis of - -- an attribute tht gives the range of a loop statement, and the loop + -- an attribute that gives the range of a loop statement, and the loop -- itself appears within an if_statement that will be rewritten during -- expansion. @@ -16333,6 +16333,7 @@ package body Sem_Ch3 is if Ekind (New_Subp) = E_Function then Set_Mechanism (New_Subp, Mechanism (Parent_Subp)); + Set_Returns_By_Ref (New_Subp, Returns_By_Ref (Parent_Subp)); end if; -- Ada 2022 (AI12-0279): If a Yield aspect is specified True for a @@ -18278,7 +18279,7 @@ package body Sem_Ch3 is -- If In_Spec_Expression, for example within a pre/postcondition, -- provide enough information for use of the subtype without -- depending on full analysis and freezing, which will happen when - -- building the correspondiing subprogram. + -- building the corresponding subprogram. if In_Spec_Expression then Analyze (Subtype_Mark (Obj_Def)); diff --git a/gcc/ada/sem_ch4.adb b/gcc/ada/sem_ch4.adb index ca8e1cd..ad7448f 100644 --- a/gcc/ada/sem_ch4.adb +++ b/gcc/ada/sem_ch4.adb @@ -265,6 +265,22 @@ package body Sem_Ch4 is -- these aspects can be achieved without larger modifications to the -- two-pass resolution algorithm. + function Possible_Type_For_Conditional_Expression + (T1, T2 : Entity_Id) return Entity_Id; + -- Given two types T1 and T2 that are _not_ compatible, return a type that + -- may still be used as the possible type of a conditional expression whose + -- dependent expressions, or part thereof, have type T1 and T2 respectively + -- during the first phase of type resolution, or Empty if such a type does + -- not exist. + + -- The typical example is an if_expression whose then_expression is of a + -- tagged type and whose else_expresssion is of an extension of this type: + -- the types are not compatible but such an if_expression can be legal if + -- its expected type is the 'Class of the tagged type, so the function will + -- return the tagged type in this case. If the expected type turns out to + -- be something else, including the tagged type itself, then an error will + -- be given during the second phase of type resolution. + procedure Remove_Abstract_Operations (N : Node_Id); -- Ada 2005: implementation of AI-310. An abstract non-dispatching -- operation is not a candidate interpretation. @@ -1559,10 +1575,30 @@ package body Sem_Ch4 is ----------------------------- procedure Analyze_Case_Expression (N : Node_Id) is + Expr : constant Node_Id := Expression (N); + First_Alt : constant Node_Id := First (Alternatives (N)); + + First_Expr : Node_Id := Empty; + -- First expression in the case where there is some type information + -- available, i.e. there is not Any_Type everywhere, which can happen + -- because of some error. + + Second_Expr : Node_Id := Empty; + -- Second expression as above + + Wrong_Alt : Node_Id := Empty; + -- For error reporting + procedure Non_Static_Choice_Error (Choice : Node_Id); -- Error routine invoked by the generic instantiation below when -- the case expression has a non static choice. + procedure Check_Next_Expression (T : Entity_Id; Alt : Node_Id); + -- Check one interpretation of the next expression with type T + + procedure Check_Expression_Pair (T1, T2 : Entity_Id; Alt : Node_Id); + -- Check first expression with type T1 and next expression with type T2 + package Case_Choices_Analysis is new Generic_Analyze_Choices (Process_Associated_Node => No_OP); @@ -1585,23 +1621,81 @@ package body Sem_Ch4 is ("choice given in case expression is not static!", Choice); end Non_Static_Choice_Error; - -- Local variables + --------------------------- + -- Check_Next_Expression -- + --------------------------- - Expr : constant Node_Id := Expression (N); - Alt : Node_Id; - Exp_Type : Entity_Id; - Exp_Btype : Entity_Id; + procedure Check_Next_Expression (T : Entity_Id; Alt : Node_Id) is + Next_Expr : constant Node_Id := Expression (Alt); - FirstX : Node_Id := Empty; - -- First expression in the case for which there is some type information - -- available, i.e. it is not Any_Type, which can happen because of some - -- error, or from the use of e.g. raise Constraint_Error. + I : Interp_Index; + It : Interp; - Others_Present : Boolean; - -- Indicates if Others was present + begin + if Next_Expr = First_Expr then + Check_Next_Expression (T, Next (Alt)); + return; + end if; - Wrong_Alt : Node_Id := Empty; - -- For error reporting + -- Loop through the interpretations of the next expression + + if not Is_Overloaded (Next_Expr) then + Check_Expression_Pair (T, Etype (Next_Expr), Alt); + + else + Get_First_Interp (Next_Expr, I, It); + while Present (It.Typ) loop + Check_Expression_Pair (T, It.Typ, Alt); + Get_Next_Interp (I, It); + end loop; + end if; + end Check_Next_Expression; + + --------------------------- + -- Check_Expression_Pair -- + --------------------------- + + procedure Check_Expression_Pair (T1, T2 : Entity_Id; Alt : Node_Id) is + Next_Expr : constant Node_Id := Expression (Alt); + + T : Entity_Id; + + begin + if Covers (T1 => T1, T2 => T2) + or else Covers (T1 => T2, T2 => T1) + then + T := Specific_Type (T1, T2); + + elsif Is_User_Defined_Literal (First_Expr, T2) then + T := T2; + + elsif Is_User_Defined_Literal (Next_Expr, T1) then + T := T1; + + else + T := Possible_Type_For_Conditional_Expression (T1, T2); + + if No (T) then + Wrong_Alt := Alt; + return; + end if; + end if; + + if Present (Next (Alt)) then + Check_Next_Expression (T, Next (Alt)); + else + Add_One_Interp (N, T, T); + end if; + end Check_Expression_Pair; + + -- Local variables + + Alt : Node_Id; + Exp_Type : Entity_Id; + Exp_Btype : Entity_Id; + I : Interp_Index; + It : Interp; + Others_Present : Boolean; -- Start of processing for Analyze_Case_Expression @@ -1611,16 +1705,23 @@ package body Sem_Ch4 is Exp_Type := Etype (Expr); Exp_Btype := Base_Type (Exp_Type); - Alt := First (Alternatives (N)); + Set_Etype (N, Any_Type); + + Alt := First_Alt; while Present (Alt) loop if Error_Posted (Expression (Alt)) then return; end if; - Analyze (Expression (Alt)); + Analyze_Expression (Expression (Alt)); + + if Etype (Expression (Alt)) /= Any_Type then + if No (First_Expr) then + First_Expr := Expression (Alt); - if No (FirstX) and then Etype (Expression (Alt)) /= Any_Type then - FirstX := Expression (Alt); + elsif No (Second_Expr) then + Second_Expr := Expression (Alt); + end if; end if; Next (Alt); @@ -1629,47 +1730,33 @@ package body Sem_Ch4 is -- Get our initial type from the first expression for which we got some -- useful type information from the expression. - if No (FirstX) then + if No (First_Expr) then return; end if; - if not Is_Overloaded (FirstX) then - Set_Etype (N, Etype (FirstX)); + -- Loop through the interpretations of the first expression and check + -- the other expressions if present. - else - declare - I : Interp_Index; - It : Interp; - - begin - Set_Etype (N, Any_Type); - - Get_First_Interp (FirstX, I, It); - while Present (It.Nam) loop - - -- For each interpretation of the first expression, we only - -- add the interpretation if every other expression in the - -- case expression alternatives has a compatible type. - - Alt := Next (First (Alternatives (N))); - while Present (Alt) loop - exit when not Has_Compatible_Type (Expression (Alt), It.Typ); - Next (Alt); - end loop; + if not Is_Overloaded (First_Expr) then + if Present (Second_Expr) then + Check_Next_Expression (Etype (First_Expr), First_Alt); + else + Set_Etype (N, Etype (First_Expr)); + end if; - if No (Alt) then - Add_One_Interp (N, It.Typ, It.Typ); - else - Wrong_Alt := Alt; - end if; + else + Get_First_Interp (First_Expr, I, It); + while Present (It.Typ) loop + if Present (Second_Expr) then + Check_Next_Expression (It.Typ, First_Alt); + else + Add_One_Interp (N, It.Typ, It.Typ); + end if; - Get_Next_Interp (I, It); - end loop; - end; + Get_Next_Interp (I, It); + end loop; end if; - Exp_Btype := Base_Type (Exp_Type); - -- The expression must be of a discrete type which must be determinable -- independently of the context in which the expression occurs, but -- using the fact that the expression must be of a discrete type. @@ -1689,10 +1776,54 @@ package body Sem_Ch4 is return; end if; + -- If no possible interpretation has been found, the type of the wrong + -- alternative doesn't match any interpretation of the FIRST expression. + if Etype (N) = Any_Type and then Present (Wrong_Alt) then - Error_Msg_N - ("type incompatible with that of previous alternatives", - Expression (Wrong_Alt)); + Second_Expr := Expression (Wrong_Alt); + + if Is_Overloaded (First_Expr) then + if Is_Overloaded (Second_Expr) then + Error_Msg_N + ("no interpretation compatible with those of previous " + & "alternative", + Second_Expr); + else + Error_Msg_N + ("type incompatible with interpretations of previous " + & "alternative", + Second_Expr); + Error_Msg_NE + ("\this alternative has}!", + Second_Expr, + Etype (Second_Expr)); + end if; + + else + if Is_Overloaded (Second_Expr) then + Error_Msg_N + ("no interpretation compatible with type of previous " + & "alternative", + Second_Expr); + Error_Msg_NE + ("\previous alternative has}!", + Second_Expr, + Etype (First_Expr)); + else + Error_Msg_N + ("type incompatible with that of previous alternative", + Second_Expr); + Error_Msg_NE + ("\previous alternative has}!", + Second_Expr, + Etype (First_Expr)); + Error_Msg_NE + ("\this alternative has}!", + Second_Expr, + Etype (Second_Expr)); + end if; + end if; + return; end if; @@ -2311,9 +2442,76 @@ package body Sem_Ch4 is procedure Analyze_If_Expression (N : Node_Id) is Condition : constant Node_Id := First (Expressions (N)); + Then_Expr : Node_Id; Else_Expr : Node_Id; + procedure Check_Else_Expression (T : Entity_Id); + -- Check one interpretation of the THEN expression with type T + + procedure Check_Expression_Pair (T1, T2 : Entity_Id); + -- Check THEN expression with type T1 and ELSE expression with type T2 + + --------------------------- + -- Check_Else_Expression -- + --------------------------- + + procedure Check_Else_Expression (T : Entity_Id) is + I : Interp_Index; + It : Interp; + + begin + -- Loop through the interpretations of the ELSE expression + + if not Is_Overloaded (Else_Expr) then + Check_Expression_Pair (T, Etype (Else_Expr)); + + else + Get_First_Interp (Else_Expr, I, It); + while Present (It.Typ) loop + Check_Expression_Pair (T, It.Typ); + Get_Next_Interp (I, It); + end loop; + end if; + end Check_Else_Expression; + + --------------------------- + -- Check_Expression_Pair -- + --------------------------- + + procedure Check_Expression_Pair (T1, T2 : Entity_Id) is + T : Entity_Id; + + begin + if Covers (T1 => T1, T2 => T2) + or else Covers (T1 => T2, T2 => T1) + then + T := Specific_Type (T1, T2); + + elsif Is_User_Defined_Literal (Then_Expr, T2) then + T := T2; + + elsif Is_User_Defined_Literal (Else_Expr, T1) then + T := T1; + + else + T := Possible_Type_For_Conditional_Expression (T1, T2); + + if No (T) then + return; + end if; + end if; + + Add_One_Interp (N, T, T); + end Check_Expression_Pair; + + -- Local variables + + I : Interp_Index; + It : Interp; + + -- Start of processing for Analyze_If_Expression + begin -- Defend against error of missing expressions from previous error @@ -2322,6 +2520,8 @@ package body Sem_Ch4 is return; end if; + Set_Etype (N, Any_Type); + Then_Expr := Next (Condition); if No (Then_Expr) then @@ -2340,8 +2540,8 @@ package body Sem_Ch4 is Analyze_Expression (Condition); Resolve (Condition, Any_Boolean); - -- Analyze THEN expression and (if present) ELSE expression. For those - -- we delay resolution in the normal manner, because of overloading etc. + -- Analyze the THEN expression and (if present) the ELSE expression. For + -- them we delay resolution in the normal manner because of overloading. Analyze_Expression (Then_Expr); @@ -2349,49 +2549,65 @@ package body Sem_Ch4 is Analyze_Expression (Else_Expr); end if; - -- If then expression not overloaded, then that decides the type + -- Loop through the interpretations of the THEN expression and check the + -- ELSE expression if present. if not Is_Overloaded (Then_Expr) then - Set_Etype (N, Etype (Then_Expr)); - - -- Case where then expression is overloaded + if Present (Else_Expr) then + Check_Else_Expression (Etype (Then_Expr)); + else + Set_Etype (N, Etype (Then_Expr)); + end if; else - declare - I : Interp_Index; - It : Interp; - - begin - Set_Etype (N, Any_Type); - - -- Loop through interpretations of Then_Expr - - Get_First_Interp (Then_Expr, I, It); - while Present (It.Nam) loop - - -- Add possible interpretation of Then_Expr if no Else_Expr, or - -- Else_Expr is present and has a compatible type. + Get_First_Interp (Then_Expr, I, It); + while Present (It.Typ) loop + if Present (Else_Expr) then + Check_Else_Expression (It.Typ); + else + Add_One_Interp (N, It.Typ, It.Typ); + end if; - if No (Else_Expr) - or else Has_Compatible_Type (Else_Expr, It.Typ) - then - Add_One_Interp (N, It.Typ, It.Typ); - end if; + Get_Next_Interp (I, It); + end loop; + end if; - Get_Next_Interp (I, It); - end loop; + -- If no possible interpretation has been found, the type of the + -- ELSE expression does not match any interpretation of the THEN + -- expression. - -- If no valid interpretation has been found, then the type of the - -- ELSE expression does not match any interpretation of the THEN - -- expression. + if Etype (N) = Any_Type then + if Is_Overloaded (Then_Expr) then + if Is_Overloaded (Else_Expr) then + Error_Msg_N + ("no interpretation compatible with those of THEN expression", + Else_Expr); + else + Error_Msg_N + ("type of ELSE incompatible with interpretations of THEN " + & "expression", + Else_Expr); + Error_Msg_NE + ("\ELSE expression has}!", Else_Expr, Etype (Else_Expr)); + end if; - if Etype (N) = Any_Type then + else + if Is_Overloaded (Else_Expr) then Error_Msg_N - ("type incompatible with that of THEN expression", + ("no interpretation compatible with type of THEN expression", Else_Expr); - return; + Error_Msg_NE + ("\THEN expression has}!", Else_Expr, Etype (Then_Expr)); + else + Error_Msg_N + ("type of ELSE incompatible with that of THEN expression", + Else_Expr); + Error_Msg_NE + ("\THEN expression has}!", Else_Expr, Etype (Then_Expr)); + Error_Msg_NE + ("\ELSE expression has}!", Else_Expr, Etype (Else_Expr)); end if; - end; + end if; end if; end Analyze_If_Expression; @@ -6450,11 +6666,6 @@ package body Sem_Ch4 is Op_Id : Entity_Id; N : Node_Id) is - Index1 : Interp_Index; - Index2 : Interp_Index; - It1 : Interp; - It2 : Interp; - procedure Check_Right_Argument (T : Entity_Id); -- Check right operand of operator @@ -6463,19 +6674,27 @@ package body Sem_Ch4 is -------------------------- procedure Check_Right_Argument (T : Entity_Id) is + I : Interp_Index; + It : Interp; + begin if not Is_Overloaded (R) then Check_Arithmetic_Pair (T, Etype (R), Op_Id, N); else - Get_First_Interp (R, Index2, It2); - while Present (It2.Typ) loop - Check_Arithmetic_Pair (T, It2.Typ, Op_Id, N); - Get_Next_Interp (Index2, It2); + Get_First_Interp (R, I, It); + while Present (It.Typ) loop + Check_Arithmetic_Pair (T, It.Typ, Op_Id, N); + Get_Next_Interp (I, It); end loop; end if; end Check_Right_Argument; + -- Local variables + + I : Interp_Index; + It : Interp; + -- Start of processing for Find_Arithmetic_Types begin @@ -6483,10 +6702,10 @@ package body Sem_Ch4 is Check_Right_Argument (Etype (L)); else - Get_First_Interp (L, Index1, It1); - while Present (It1.Typ) loop - Check_Right_Argument (It1.Typ); - Get_Next_Interp (Index1, It1); + Get_First_Interp (L, I, It); + while Present (It.Typ) loop + Check_Right_Argument (It.Typ); + Get_Next_Interp (I, It); end loop; end if; end Find_Arithmetic_Types; @@ -6500,86 +6719,77 @@ package body Sem_Ch4 is Op_Id : Entity_Id; N : Node_Id) is - Index : Interp_Index; - It : Interp; + procedure Check_Boolean_Pair (T1, T2 : Entity_Id); + -- Check operand pair of operator - procedure Check_Numeric_Argument (T : Entity_Id); - -- Special case for logical operations one of whose operands is an - -- integer literal. If both are literal the result is any modular type. + procedure Check_Right_Argument (T : Entity_Id); + -- Check right operand of operator - ---------------------------- - -- Check_Numeric_Argument -- - ---------------------------- + ------------------------ + -- Check_Boolean_Pair -- + ------------------------ + + procedure Check_Boolean_Pair (T1, T2 : Entity_Id) is + T : Entity_Id; - procedure Check_Numeric_Argument (T : Entity_Id) is begin - if T = Universal_Integer then - Add_One_Interp (N, Op_Id, Any_Modular); + if Valid_Boolean_Arg (T1) + and then Valid_Boolean_Arg (T2) + and then (Covers (T1 => T1, T2 => T2) + or else Covers (T1 => T2, T2 => T1)) + then + T := Specific_Type (T1, T2); + + if T = Universal_Integer then + T := Any_Modular; + end if; - elsif Is_Modular_Integer_Type (T) then Add_One_Interp (N, Op_Id, T); end if; - end Check_Numeric_Argument; + end Check_Boolean_Pair; - -- Start of processing for Find_Boolean_Types + -------------------------- + -- Check_Right_Argument -- + -------------------------- - begin - if not Is_Overloaded (L) then - if Etype (L) = Universal_Integer - or else Etype (L) = Any_Modular - then - if not Is_Overloaded (R) then - Check_Numeric_Argument (Etype (R)); + procedure Check_Right_Argument (T : Entity_Id) is + I : Interp_Index; + It : Interp; - else - Get_First_Interp (R, Index, It); - while Present (It.Typ) loop - Check_Numeric_Argument (It.Typ); - Get_Next_Interp (Index, It); - end loop; - end if; + begin + -- Defend against previous error + + if Nkind (R) = N_Error then + null; - -- If operands are aggregates, we must assume that they may be - -- boolean arrays, and leave disambiguation for the second pass. - -- If only one is an aggregate, verify that the other one has an - -- interpretation as a boolean array + elsif not Is_Overloaded (R) then + Check_Boolean_Pair (T, Etype (R)); - elsif Nkind (L) = N_Aggregate then - if Nkind (R) = N_Aggregate then - Add_One_Interp (N, Op_Id, Etype (L)); + else + Get_First_Interp (R, I, It); + while Present (It.Typ) loop + Check_Boolean_Pair (T, It.Typ); + Get_Next_Interp (I, It); + end loop; + end if; + end Check_Right_Argument; - elsif not Is_Overloaded (R) then - if Valid_Boolean_Arg (Etype (R)) then - Add_One_Interp (N, Op_Id, Etype (R)); - end if; + -- Local variables - else - Get_First_Interp (R, Index, It); - while Present (It.Typ) loop - if Valid_Boolean_Arg (It.Typ) then - Add_One_Interp (N, Op_Id, It.Typ); - end if; + I : Interp_Index; + It : Interp; - Get_Next_Interp (Index, It); - end loop; - end if; + -- Start of processing for Find_Boolean_Types - elsif Valid_Boolean_Arg (Etype (L)) - and then Has_Compatible_Type (R, Etype (L)) - then - Add_One_Interp (N, Op_Id, Etype (L)); - end if; + begin + if not Is_Overloaded (L) then + Check_Right_Argument (Etype (L)); else - Get_First_Interp (L, Index, It); + Get_First_Interp (L, I, It); while Present (It.Typ) loop - if Valid_Boolean_Arg (It.Typ) - and then Has_Compatible_Type (R, It.Typ) - then - Add_One_Interp (N, Op_Id, It.Typ); - end if; - - Get_Next_Interp (Index, It); + Check_Right_Argument (It.Typ); + Get_Next_Interp (I, It); end loop; end if; end Find_Boolean_Types; @@ -7644,6 +7854,97 @@ package body Sem_Ch4 is return Etype (N) /= Any_Type; end Has_Possible_Literal_Aspects; + ---------------------------------------------- + -- Possible_Type_For_Conditional_Expression -- + ---------------------------------------------- + + function Possible_Type_For_Conditional_Expression + (T1, T2 : Entity_Id) return Entity_Id + is + function Is_Access_Protected_Subprogram_Attribute + (T : Entity_Id) return Boolean; + -- Return true if T is the type of an access-to-protected-subprogram + -- attribute. + + function Is_Access_Subprogram_Attribute (T : Entity_Id) return Boolean; + -- Return true if T is the type of an access-to-subprogram attribute + + ---------------------------------------------- + -- Is_Access_Protected_Subprogram_Attribute -- + ---------------------------------------------- + + function Is_Access_Protected_Subprogram_Attribute + (T : Entity_Id) return Boolean + is + begin + return Ekind (T) = E_Access_Protected_Subprogram_Type + and then Ekind (Designated_Type (T)) /= E_Subprogram_Type; + end Is_Access_Protected_Subprogram_Attribute; + + ------------------------------------ + -- Is_Access_Subprogram_Attribute -- + ------------------------------------ + + function Is_Access_Subprogram_Attribute (T : Entity_Id) return Boolean is + begin + return Ekind (T) = E_Access_Subprogram_Type + and then Ekind (Designated_Type (T)) /= E_Subprogram_Type; + end Is_Access_Subprogram_Attribute; + + -- Start of processing for Possible_Type_For_Conditional_Expression + + begin + -- If both types are those of similar access attributes or allocators, + -- pick one of them, for example the first. + + if Ekind (T1) in E_Access_Attribute_Type | E_Allocator_Type + and then Ekind (T2) in E_Access_Attribute_Type | E_Allocator_Type + then + return T1; + + elsif Is_Access_Subprogram_Attribute (T1) + and then Is_Access_Subprogram_Attribute (T2) + and then + Subtype_Conformant (Designated_Type (T1), Designated_Type (T2)) + then + return T1; + + elsif Is_Access_Protected_Subprogram_Attribute (T1) + and then Is_Access_Protected_Subprogram_Attribute (T2) + and then + Subtype_Conformant (Designated_Type (T1), Designated_Type (T2)) + then + return T1; + + -- The other case to be considered is a pair of tagged types + + elsif Is_Tagged_Type (T1) and then Is_Tagged_Type (T2) then + -- Covers performs the same checks when T1 or T2 are a CW type, so + -- we don't need to do them again here. + + if not Is_Class_Wide_Type (T1) and then Is_Ancestor (T1, T2) then + return T1; + + elsif not Is_Class_Wide_Type (T2) and then Is_Ancestor (T2, T1) then + return T2; + + -- Neither type is an ancestor of the other, but they may have one in + -- common, so we pick the first type as above. We could perform here + -- the computation of the nearest common ancestors of T1 and T2, but + -- this would require a significant amount of work and the practical + -- benefit would very likely be negligible. + + else + return T1; + end if; + + -- Otherwise no type is possible + + else + return Empty; + end if; + end Possible_Type_For_Conditional_Expression; + -------------------------------- -- Remove_Abstract_Operations -- -------------------------------- @@ -8947,19 +9248,6 @@ package body Sem_Ch4 is Save_Interps (Subprog, Node_To_Replace); else - -- The type of the subprogram may be a limited view obtained - -- transitively from another unit. If full view is available, - -- use it to analyze call. If there is no nonlimited view, then - -- this is diagnosed when analyzing the rewritten call. - - declare - T : constant Entity_Id := Etype (Subprog); - begin - if From_Limited_With (T) then - Set_Etype (Entity (Subprog), Available_View (T)); - end if; - end; - Analyze (Node_To_Replace); -- If the operation has been rewritten into a call, which may get diff --git a/gcc/ada/sem_ch5.adb b/gcc/ada/sem_ch5.adb index a0f2206..7fd5ab3 100644 --- a/gcc/ada/sem_ch5.adb +++ b/gcc/ada/sem_ch5.adb @@ -2761,9 +2761,21 @@ package body Sem_Ch5 is end; end if; - -- IN iterator, domain is a range, or a call to Iterate function + -- IN iterator, domain is a range, a call to Iterate function, + -- or an object/actual parameter of an iterator type. else + -- If the type of the name is class-wide and its root type is a + -- derived type, the primitive operations (First, Next, etc.) are + -- those inherited by its specific type. Calls to these primitives + -- will be dispatching. + + if Is_Class_Wide_Type (Typ) + and then Is_Derived_Type (Etype (Typ)) + then + Typ := Etype (Typ); + end if; + -- For an iteration of the form IN, the name must denote an -- iterator, typically the result of a call to Iterate. Give a -- useful error message when the name is a container by itself. @@ -3675,6 +3687,7 @@ package body Sem_Ch5 is begin return Present (Def_Iter) + and then Present (Etype (Def_Iter)) and then Requires_Transient_Scope (Etype (Def_Iter)); end Has_Sec_Stack_Default_Iterator; diff --git a/gcc/ada/sem_ch6.adb b/gcc/ada/sem_ch6.adb index 92e48fa..17e7d26 100644 --- a/gcc/ada/sem_ch6.adb +++ b/gcc/ada/sem_ch6.adb @@ -777,6 +777,12 @@ package body Sem_Ch6 is function First_Selector (Assoc : Node_Id) return Node_Id; -- Obtain the first selector or choice from a given association + function Is_Formal_Of_Current_Function + (Assoc_Expr : Entity_Id) return Boolean; + -- Predicate to test if a given expression associated with a + -- discriminant is a formal parameter to the function in which the + -- return construct we checking applies to. + -------------------- -- First_Selector -- -------------------- @@ -794,6 +800,19 @@ package body Sem_Ch6 is end if; end First_Selector; + ----------------------------------- + -- Is_Formal_Of_Current_Function -- + ----------------------------------- + + function Is_Formal_Of_Current_Function + (Assoc_Expr : Entity_Id) return Boolean is + begin + return Is_Entity_Name (Assoc_Expr) + and then Enclosing_Subprogram + (Entity (Assoc_Expr)) = Scope_Id + and then Is_Formal (Entity (Assoc_Expr)); + end Is_Formal_Of_Current_Function; + -- Local declarations Assoc : Node_Id := Empty; @@ -869,7 +888,10 @@ package body Sem_Ch6 is -- with all anonymous access discriminants, then generate a -- dynamic check or static error when relevant. - Unqual := Unqualify (Original_Node (Return_Con)); + -- Note the repeated use of Original_Node to avoid checking + -- expanded code. + + Unqual := Original_Node (Unqualify (Original_Node (Return_Con))); -- Get the corresponding declaration based on the return object's -- identifier. @@ -1052,8 +1074,6 @@ package body Sem_Ch6 is if Nkind (Assoc) = N_Component_Association and then Box_Present (Assoc) then - Assoc_Present := False; - if Nkind (First_Selector (Assoc)) = N_Others_Choice then Unseen_Disc_Count := 0; end if; @@ -1178,9 +1198,24 @@ package body Sem_Ch6 is if Present (Assoc_Expr) and then Present (Disc) and then Ekind (Etype (Disc)) = E_Anonymous_Access_Type + + -- We disable the check when we have a tagged return type and + -- the associated expression for the discriminant is a formal + -- parameter since the check would require us to compare the + -- accessibility level of Assoc_Expr to the level of the + -- Extra_Accessibility_Of_Result of the function - which is + -- currently disabled for functions with tagged return types. + -- This may change in the future ??? + + -- See Needs_Result_Accessibility_Level for details. + + and then not + (No (Extra_Accessibility_Of_Result (Scope_Id)) + and then Is_Formal_Of_Current_Function (Assoc_Expr) + and then Is_Tagged_Type (Etype (Scope_Id))) then -- Generate a dynamic check based on the extra accessibility of - -- the result or the scope. + -- the result or the scope of the current function. Check_Cond := Make_Op_Gt (Loc, @@ -1188,14 +1223,24 @@ package body Sem_Ch6 is (Expr => Assoc_Expr, Level => Dynamic_Level, In_Return_Context => True), - Right_Opnd => (if Present - (Extra_Accessibility_Of_Result - (Scope_Id)) - then - Extra_Accessibility_Of_Result (Scope_Id) - else - Make_Integer_Literal - (Loc, Scope_Depth (Scope (Scope_Id))))); + Right_Opnd => + (if Present (Extra_Accessibility_Of_Result (Scope_Id)) + + -- When Assoc_Expr is a formal we have to look at the + -- extra accessibility-level formal associated with + -- the result. + + and then Is_Formal_Of_Current_Function (Assoc_Expr) + then + New_Occurrence_Of + (Extra_Accessibility_Of_Result (Scope_Id), Loc) + + -- Otherwise, we compare the level of Assoc_Expr to the + -- scope of the current function. + + else + Make_Integer_Literal + (Loc, Scope_Depth (Scope (Scope_Id))))); Insert_Before_And_Analyze (Return_Stmt, Make_Raise_Program_Error (Loc, diff --git a/gcc/ada/sem_ch8.adb b/gcc/ada/sem_ch8.adb index 1818778..60c2ce6 100644 --- a/gcc/ada/sem_ch8.adb +++ b/gcc/ada/sem_ch8.adb @@ -9202,9 +9202,34 @@ package body Sem_Ch8 is (Clause1 : Entity_Id; Clause2 : Entity_Id) return Entity_Id is + function Determine_Package_Scope (Clause : Node_Id) return Entity_Id; + -- Given a use clause, determine which package it belongs to + + ----------------------------- + -- Determine_Package_Scope -- + ----------------------------- + + function Determine_Package_Scope (Clause : Node_Id) return Entity_Id is + begin + -- Check if the clause appears in the context area + + -- Note we cannot employ Enclosing_Packge for use clauses within + -- context clauses since they are not actually "enclosed." + + if Nkind (Parent (Clause)) = N_Compilation_Unit then + return Entity_Of_Unit (Unit (Parent (Clause))); + end if; + + -- Otherwise, obtain the enclosing package normally + + return Enclosing_Package (Clause); + end Determine_Package_Scope; + Scope1 : Entity_Id; Scope2 : Entity_Id; + -- Start of processing for Most_Descendant_Use_Clause + begin if Clause1 = Clause2 then return Clause1; @@ -9213,8 +9238,8 @@ package body Sem_Ch8 is -- We determine which one is the most descendant by the scope distance -- to the ultimate parent unit. - Scope1 := Entity_Of_Unit (Unit (Parent (Clause1))); - Scope2 := Entity_Of_Unit (Unit (Parent (Clause2))); + Scope1 := Determine_Package_Scope (Clause1); + Scope2 := Determine_Package_Scope (Clause2); while Scope1 /= Standard_Standard and then Scope2 /= Standard_Standard loop diff --git a/gcc/ada/sem_dist.adb b/gcc/ada/sem_dist.adb index ea9c7ef..3109408 100644 --- a/gcc/ada/sem_dist.adb +++ b/gcc/ada/sem_dist.adb @@ -394,11 +394,10 @@ package body Sem_Dist is (RTE (RE_Get_Local_Partition_Id), Loc); end if; - -- Get and store the String_Id corresponding to the name of the - -- library unit whose Partition_Id is needed. + -- Get the String_Id corresponding to the name of the library unit whose + -- Partition_Id is needed. - Get_Library_Unit_Name_String (Unit_Declaration_Node (Ety)); - Prefix_String := String_From_Name_Buffer; + Prefix_String := Get_Library_Unit_Name (Unit_Declaration_Node (Ety)); -- Build the function call which will replace the attribute diff --git a/gcc/ada/sem_res.adb b/gcc/ada/sem_res.adb index 125366b..4306e49 100644 --- a/gcc/ada/sem_res.adb +++ b/gcc/ada/sem_res.adb @@ -3868,8 +3868,13 @@ package body Sem_Res is when N_Identifier | N_Expanded_Name => Id := Entity (N); - if Present (Id) - and then Is_Object (Id) + -- Identifiers of components and discriminants are not names + -- in the sense of Ada RM 4.1. They can only occur as a + -- selector_name in selected_component or as a choice in + -- component_association. + + if Is_Object (Id) + and then Ekind (Id) not in E_Component | E_Discriminant and then Is_Effectively_Volatile_For_Reading (Id) and then not Is_OK_Volatile_Context (Context => Parent (N), @@ -4163,12 +4168,7 @@ package body Sem_Res is -- marked with Any_Type. Since the operation has been resolved to -- the user-defined operator, that is irrelevant, so reset Etype. - if Nkind (Original_Node (N)) in N_Op_Eq - | N_Op_Ge - | N_Op_Gt - | N_Op_Le - | N_Op_Lt - | N_Op_Ne + if Nkind (Original_Node (N)) in N_Op_Compare and then not Is_Boolean_Type (Etype (N)) then Set_Etype (A, Etype (F)); diff --git a/gcc/ada/sem_type.adb b/gcc/ada/sem_type.adb index d5ee20b..2fc82d1 100644 --- a/gcc/ada/sem_type.adb +++ b/gcc/ada/sem_type.adb @@ -3354,22 +3354,23 @@ package body Sem_Type is elsif T2 = Raise_Type then return B1; - -- ---------------------------------------------------------- - -- Special cases for equality operators (all other predefined - -- operators can never apply to tagged types) - -- ---------------------------------------------------------- - -- Ada 2005 (AI-251): T1 and T2 are class-wide types, and T2 is an - -- interface + -- interface, return T1, and vice versa. elsif Is_Class_Wide_Type (T1) and then Is_Class_Wide_Type (T2) and then Is_Interface (Etype (T2)) then - return T1; + return B1; + + elsif Is_Class_Wide_Type (T2) + and then Is_Class_Wide_Type (T1) + and then Is_Interface (Etype (T1)) + then + return B2; -- Ada 2005 (AI-251): T1 is a concrete type that implements the - -- class-wide interface T2 + -- class-wide interface T2, return T1, and vice versa. elsif Is_Tagged_Type (T1) and then Is_Class_Wide_Type (T2) @@ -3377,17 +3378,25 @@ package body Sem_Type is and then Interface_Present_In_Ancestor (Typ => T1, Iface => Etype (T2)) then - return T1; + return B1; + + elsif Is_Tagged_Type (T2) + and then Is_Class_Wide_Type (T1) + and then Is_Interface (Etype (T1)) + and then Interface_Present_In_Ancestor (Typ => T2, + Iface => Etype (T1)) + then + return B2; elsif Is_Class_Wide_Type (T1) and then Is_Ancestor (Root_Type (T1), T2) then - return T1; + return B1; elsif Is_Class_Wide_Type (T2) and then Is_Ancestor (Root_Type (T2), T1) then - return T2; + return B2; elsif Is_Access_Type (T1) and then Is_Access_Type (T2) @@ -3498,11 +3507,11 @@ package body Sem_Type is or else Is_Modular_Integer_Type (T) or else T = Universal_Integer or else T = Any_Composite + or else T = Raise_Type then return True; elsif Is_Array_Type (T) - and then T /= Any_String and then Number_Dimensions (T) = 1 and then Is_Boolean_Type (Component_Type (T)) and then diff --git a/gcc/ada/sem_util.adb b/gcc/ada/sem_util.adb index d3b8eac..b7ebd4a 100644 --- a/gcc/ada/sem_util.adb +++ b/gcc/ada/sem_util.adb @@ -327,9 +327,8 @@ package body Sem_Util is elsif Nkind (Node_Par) in N_Extended_Return_Statement | N_Simple_Return_Statement - and then Ekind (Current_Scope) = E_Function then - return Scope_Depth (Current_Scope); + return Scope_Depth (Enclosing_Subprogram (Node_Par)); -- Statements are counted as masters @@ -4813,6 +4812,9 @@ package body Sem_Util is -- and post-state. Prag is a [refined] postcondition or a contract-cases -- pragma. Result_Seen is set when the pragma mentions attribute 'Result + function Is_Trivial_Boolean (N : Node_Id) return Boolean; + -- Determine whether source node N denotes "True" or "False" + ------------------------------------------- -- Check_Result_And_Post_State_In_Pragma -- ------------------------------------------- @@ -4836,9 +4838,6 @@ package body Sem_Util is function Is_Function_Result (N : Node_Id) return Traverse_Result; -- Attempt to find attribute 'Result in a subtree denoted by N - function Is_Trivial_Boolean (N : Node_Id) return Boolean; - -- Determine whether source node N denotes "True" or "False" - function Mentions_Post_State (N : Node_Id) return Boolean; -- Determine whether a subtree denoted by N mentions any construct -- that denotes a post-state. @@ -5089,20 +5088,6 @@ package body Sem_Util is end if; end Is_Function_Result; - ------------------------ - -- Is_Trivial_Boolean -- - ------------------------ - - function Is_Trivial_Boolean (N : Node_Id) return Boolean is - begin - return - Comes_From_Source (N) - and then Is_Entity_Name (N) - and then (Entity (N) = Standard_True - or else - Entity (N) = Standard_False); - end Is_Trivial_Boolean; - ------------------------- -- Mentions_Post_State -- ------------------------- @@ -5202,6 +5187,20 @@ package body Sem_Util is end if; end Check_Result_And_Post_State_In_Pragma; + ------------------------ + -- Is_Trivial_Boolean -- + ------------------------ + + function Is_Trivial_Boolean (N : Node_Id) return Boolean is + begin + return + Comes_From_Source (N) + and then Is_Entity_Name (N) + and then (Entity (N) = Standard_True + or else + Entity (N) = Standard_False); + end Is_Trivial_Boolean; + -- Local variables Items : constant Node_Id := Contract (Subp_Id); @@ -5305,10 +5304,14 @@ package body Sem_Util is elsif Present (Case_Prag) and then not Seen_In_Case then Error_Msg_N ("contract cases do not mention result?.t?", Case_Prag); - -- The function has postconditions only and they do not mention - -- attribute 'Result. + -- The function has non-trivial postconditions only and they do not + -- mention attribute 'Result. - elsif Present (Post_Prag) and then not Seen_In_Post then + elsif Present (Post_Prag) + and then not Seen_In_Post + and then not Is_Trivial_Boolean + (Get_Pragma_Arg (First (Pragma_Argument_Associations (Post_Prag)))) + then Error_Msg_N ("postcondition does not mention function result?.t?", Post_Prag); end if; @@ -8283,10 +8286,32 @@ package body Sem_Util is -- Enclosing_Package -- ----------------------- - function Enclosing_Package (E : Entity_Id) return Entity_Id is - Dynamic_Scope : constant Entity_Id := Enclosing_Dynamic_Scope (E); + function Enclosing_Package (N : Node_Or_Entity_Id) return Entity_Id is + Dynamic_Scope : Entity_Id; begin + -- Obtain the enclosing scope when N is a Node_Id - taking care to + -- handle the case when the enclosing scope is already a package. + + if Nkind (N) not in N_Entity then + declare + Encl_Scop : constant Entity_Id := Find_Enclosing_Scope (N); + begin + if No (Encl_Scop) then + return Empty; + elsif Ekind (Encl_Scop) in + E_Generic_Package | E_Package | E_Package_Body + then + return Encl_Scop; + end if; + + return Enclosing_Package (Encl_Scop); + end; + end if; + + -- When N is already an Entity_Id proceed + + Dynamic_Scope := Enclosing_Dynamic_Scope (N); if Dynamic_Scope = Standard_Standard then return Standard_Standard; @@ -8330,10 +8355,29 @@ package body Sem_Util is -- Enclosing_Subprogram -- -------------------------- - function Enclosing_Subprogram (E : Entity_Id) return Entity_Id is - Dyn_Scop : constant Entity_Id := Enclosing_Dynamic_Scope (E); + function Enclosing_Subprogram (N : Node_Or_Entity_Id) return Entity_Id is + Dyn_Scop : Entity_Id; + Encl_Scop : Entity_Id; begin + -- Obtain the enclosing scope when N is a Node_Id - taking care to + -- handle the case when the enclosing scope is already a subprogram. + + if Nkind (N) not in N_Entity then + Encl_Scop := Find_Enclosing_Scope (N); + + if No (Encl_Scop) then + return Empty; + elsif Ekind (Encl_Scop) in Subprogram_Kind then + return Encl_Scop; + end if; + + return Enclosing_Subprogram (Encl_Scop); + end if; + + -- When N is already an Entity_Id proceed + + Dyn_Scop := Enclosing_Dynamic_Scope (N); if Dyn_Scop = Standard_Standard then return Empty; @@ -11390,21 +11434,23 @@ package body Sem_Util is end if; end Get_Iterable_Type_Primitive; - ---------------------------------- - -- Get_Library_Unit_Name_String -- - ---------------------------------- + --------------------------- + -- Get_Library_Unit_Name -- + --------------------------- - procedure Get_Library_Unit_Name_String (Decl_Node : Node_Id) is + function Get_Library_Unit_Name (Decl_Node : Node_Id) return String_Id is Unit_Name_Id : constant Unit_Name_Type := Get_Unit_Name (Decl_Node); - + Buf : Bounded_String; begin - Get_Unit_Name_String (Unit_Name_Id); + Get_Unit_Name_String (Buf, Unit_Name_Id); + + -- Remove the last seven characters (" (spec)" or " (body)") - -- Remove seven last character (" (spec)" or " (body)") + Buf.Length := Buf.Length - 7; + pragma Assert (Buf.Chars (Buf.Length + 1) = ' '); - Name_Len := Name_Len - 7; - pragma Assert (Name_Buffer (Name_Len + 1) = ' '); - end Get_Library_Unit_Name_String; + return String_From_Name_Buffer (Buf); + end Get_Library_Unit_Name; -------------------------- -- Get_Max_Queue_Length -- @@ -14183,9 +14229,7 @@ package body Sem_Util is begin pragma Assert (Relaxed_RM_Semantics); - pragma Assert - (Nkind (N) in - N_Null | N_Op_Eq | N_Op_Ge | N_Op_Gt | N_Op_Le | N_Op_Lt | N_Op_Ne); + pragma Assert (Nkind (N) in N_Null | N_Op_Compare); if Nkind (N) = N_Null then Rewrite (N, New_Occurrence_Of (RTE (RE_Null_Address), Sloc (N))); @@ -20966,37 +21010,6 @@ package body Sem_Util is return False; end Is_Reversible_Iterator; - ---------------------- - -- Is_Selector_Name -- - ---------------------- - - function Is_Selector_Name (N : Node_Id) return Boolean is - begin - if not Is_List_Member (N) then - declare - P : constant Node_Id := Parent (N); - begin - return Nkind (P) in N_Expanded_Name - | N_Generic_Association - | N_Parameter_Association - | N_Selected_Component - and then Selector_Name (P) = N; - end; - - else - declare - L : constant List_Id := List_Containing (N); - P : constant Node_Id := Parent (L); - begin - return (Nkind (P) = N_Discriminant_Association - and then Selector_Names (P) = L) - or else - (Nkind (P) = N_Component_Association - and then Choices (P) = L); - end; - end if; - end Is_Selector_Name; - --------------------------------- -- Is_Single_Concurrent_Object -- --------------------------------- @@ -23096,8 +23109,8 @@ package body Sem_Util is if not Is_Limited_Type (Comp_Typ) then return False; - -- Only limited types can have access discriminants with - -- defaults. + -- Only limited types can have access discriminants with + -- defaults. elsif Has_Unconstrained_Access_Discriminants (Comp_Typ) then return True; @@ -23127,16 +23140,18 @@ package body Sem_Util is return False; end Has_Unconstrained_Access_Discriminant_Component; - Disable_Coextension_Cases : constant Boolean := True; - -- Flag used to temporarily disable a "True" result for types with - -- access discriminants and related coextension cases. + Disable_Tagged_Cases : constant Boolean := True; + -- Flag used to temporarily disable a "True" result for tagged types. + -- See comments further below for details. -- Start of processing for Needs_Result_Accessibility_Level begin - -- False if completion unavailable (how does this happen???) + -- False if completion unavailable, which can happen when we are + -- analyzing an abstract subprogram or if the subprogram has + -- delayed freezing. - if not Present (Func_Typ) then + if No (Func_Typ) then return False; -- False if not a function, also handle enum-lit renames case @@ -23169,14 +23184,6 @@ package body Sem_Util is elsif Ekind (Func_Typ) = E_Anonymous_Access_Type then return True; - -- The following cases are related to coextensions and do not fully - -- cover everything mentioned in RM 3.10.2 (12) ??? - - -- Temporarily disabled ??? - - elsif Disable_Coextension_Cases then - return False; - -- In the case of, say, a null tagged record result type, the need for -- this extra parameter might not be obvious so this function returns -- True for all tagged types for compatibility reasons. @@ -23193,8 +23200,11 @@ package body Sem_Util is -- solve these issues by introducing wrappers, but that is not the -- approach that was chosen. + -- Note: Despite the reasoning noted above, the extra accessibility + -- parameter for tagged types is disabled for performance reasons. + elsif Is_Tagged_Type (Func_Typ) then - return True; + return not Disable_Tagged_Cases; elsif Has_Unconstrained_Access_Discriminants (Func_Typ) then return True; @@ -26104,9 +26114,7 @@ package body Sem_Util is if Nkind (N) = N_Null then return Present (Typ) and then Is_Descendant_Of_Address (Typ); - elsif Nkind (N) in - N_Op_Eq | N_Op_Ge | N_Op_Gt | N_Op_Le | N_Op_Lt | N_Op_Ne - then + elsif Nkind (N) in N_Op_Compare then declare L : constant Node_Id := Left_Opnd (N); R : constant Node_Id := Right_Opnd (N); @@ -30366,6 +30374,9 @@ package body Sem_Util is Found_Type : constant Entity_Id := First_Subtype (Etype (Expr)); Expec_Type : constant Entity_Id := First_Subtype (Expected_Type); + Err_Msg_Exp_Typ : Entity_Id := Expected_Type; + -- Type entity used when printing errors concerning the expected type + Matching_Field : Entity_Id; -- Entity to give a more precise suggestion on how to write a one- -- element positional aggregate. @@ -30523,6 +30534,15 @@ package body Sem_Util is end if; end if; + -- Avoid printing internally generated subtypes in error messages and + -- instead use the corresponding first subtype in such cases. + + if not Comes_From_Source (Err_Msg_Exp_Typ) + or else not Comes_From_Source (Declaration_Node (Err_Msg_Exp_Typ)) + then + Err_Msg_Exp_Typ := First_Subtype (Err_Msg_Exp_Typ); + end if; + -- An interesting special check. If the expression is parenthesized -- and its type corresponds to the type of the sole component of the -- expected record type, or to the component type of the expected one @@ -30560,7 +30580,7 @@ package body Sem_Util is Error_Msg_N ("result must be general access type!", Expr); Error_Msg_NE -- CODEFIX - ("\add ALL to }!", Expr, Expec_Type); + ("\add ALL to }!", Expr, Err_Msg_Exp_Typ); -- Another special check, if the expected type is an integer type, -- but the expression is of type System.Address, and the parent is @@ -30652,7 +30672,7 @@ package body Sem_Util is Error_Msg_NE ("expected}!", Expr, Corresponding_Remote_Type (Expec_Type)); else - Error_Msg_NE ("expected}!", Expr, Expec_Type); + Error_Msg_NE ("expected}!", Expr, Err_Msg_Exp_Typ); end if; if Is_Entity_Name (Expr) diff --git a/gcc/ada/sem_util.ads b/gcc/ada/sem_util.ads index caa28eb..e5e1d01 100644 --- a/gcc/ada/sem_util.ads +++ b/gcc/ada/sem_util.ads @@ -816,17 +816,17 @@ package Sem_Util is -- Enclosing_Comp_Unit_Node returns a subunit, then the corresponding -- library unit. If no such item is found, returns Empty. - function Enclosing_Package (E : Entity_Id) return Entity_Id; + function Enclosing_Package (N : Node_Or_Entity_Id) return Entity_Id; -- Utility function to return the Ada entity of the package enclosing - -- the entity E, if any. Returns Empty if no enclosing package. + -- the entity or node N, if any. Returns Empty if no enclosing package. function Enclosing_Package_Or_Subprogram (E : Entity_Id) return Entity_Id; -- Returns the entity of the package or subprogram enclosing E, if any. -- Returns Empty if no enclosing package or subprogram. - function Enclosing_Subprogram (E : Entity_Id) return Entity_Id; + function Enclosing_Subprogram (N : Node_Or_Entity_Id) return Entity_Id; -- Utility function to return the Ada entity of the subprogram enclosing - -- the entity E, if any. Returns Empty if no enclosing subprogram. + -- N, 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, @@ -1258,9 +1258,8 @@ package Sem_Util is -- Retrieve one of the primitives First, Last, Next, Previous, Has_Element, -- Element from the value of the Iterable aspect of a type. - procedure Get_Library_Unit_Name_String (Decl_Node : Node_Id); - -- Retrieve the fully expanded name of the library unit declared by - -- Decl_Node into the name buffer. + function Get_Library_Unit_Name (Decl_Node : Node_Id) return String_Id; + -- Return the full expanded name of the library unit declared by Decl_Node function Get_Max_Queue_Length (Id : Entity_Id) return Uint; -- Return the argument of pragma Max_Queue_Length or zero if the annotation @@ -2338,12 +2337,6 @@ package Sem_Util is -- AI05-0139-2: Check whether Typ is derived from the predefined interface -- Ada.Iterator_Interfaces.Reversible_Iterator. - function Is_Selector_Name (N : Node_Id) return Boolean; - -- Given an N_Identifier node N, determines if it is a Selector_Name. - -- As described in Sinfo, Selector_Names are special because they - -- represent use of the N_Identifier node for a true identifier, when - -- normally such nodes represent a direct name. - function Is_Single_Concurrent_Object (Id : Entity_Id) return Boolean; -- Determine whether arbitrary entity Id denotes the anonymous object -- created for a single protected or single task type. diff --git a/gcc/ada/sem_warn.adb b/gcc/ada/sem_warn.adb index 4d34522..c8d00a5 100644 --- a/gcc/ada/sem_warn.adb +++ b/gcc/ada/sem_warn.adb @@ -2872,7 +2872,9 @@ package body Sem_Warn is Match ("dummy") or else Match ("ignore") or else Match ("junk") or else - Match ("unused"); + Match ("unuse") or else + Match ("tmp") or else + Match ("temp"); end Has_Junk_Name; -------------------------------------- diff --git a/gcc/ada/set_targ.adb b/gcc/ada/set_targ.adb index dcb2fd0..160f510 100644 --- a/gcc/ada/set_targ.adb +++ b/gcc/ada/set_targ.adb @@ -31,7 +31,7 @@ with Output; use Output; with System; use System; with System.OS_Lib; use System.OS_Lib; -with Unchecked_Conversion; +with Ada.Unchecked_Conversion; package body Set_Targ is @@ -404,7 +404,7 @@ package body Set_Targ is -- Pointer to Nat or Pos value (it is harmless to treat Pos values and -- Nat values as Natural via Unchecked_Conversion). - function To_ANat is new Unchecked_Conversion (Address, ANat); + function To_ANat is new Ada.Unchecked_Conversion (Address, ANat); procedure AddC (C : Character); -- Add one character to buffer @@ -566,7 +566,7 @@ package body Set_Targ is -- Pointer to Nat or Pos value (it is harmless to treat Pos values -- as Nat via Unchecked_Conversion). - function To_ANat is new Unchecked_Conversion (Address, ANat); + function To_ANat is new Ada.Unchecked_Conversion (Address, ANat); VP : ANat; diff --git a/gcc/ada/sinput.adb b/gcc/ada/sinput.adb index 4df735c..8e80213 100644 --- a/gcc/ada/sinput.adb +++ b/gcc/ada/sinput.adb @@ -41,8 +41,8 @@ with System.Storage_Elements; with System.Memory; with System.WCh_Con; use System.WCh_Con; -with Unchecked_Conversion; -with Unchecked_Deallocation; +with Ada.Unchecked_Conversion; +with Ada.Unchecked_Deallocation; package body Sinput is @@ -56,16 +56,16 @@ package body Sinput is -- used to construct improperly aliased pointer values. function To_Address is - new Unchecked_Conversion (Lines_Table_Ptr, Address); + new Ada.Unchecked_Conversion (Lines_Table_Ptr, Address); function To_Address is - new Unchecked_Conversion (Logical_Lines_Table_Ptr, Address); + new Ada.Unchecked_Conversion (Logical_Lines_Table_Ptr, Address); function To_Pointer is - new Unchecked_Conversion (Address, Lines_Table_Ptr); + new Ada.Unchecked_Conversion (Address, Lines_Table_Ptr); function To_Pointer is - new Unchecked_Conversion (Address, Logical_Lines_Table_Ptr); + new Ada.Unchecked_Conversion (Address, Logical_Lines_Table_Ptr); pragma Warnings (On); @@ -319,10 +319,10 @@ package body Sinput is -- Clear_Source_File_Table -- ----------------------------- - procedure Free is new Unchecked_Deallocation + procedure Free is new Ada.Unchecked_Deallocation (Lines_Table_Type, Lines_Table_Ptr); - procedure Free is new Unchecked_Deallocation + procedure Free is new Ada.Unchecked_Deallocation (Logical_Lines_Table_Type, Logical_Lines_Table_Ptr); procedure Clear_Source_File_Table is @@ -378,12 +378,12 @@ package body Sinput is -- to first Unchecked_Convert to access-to-variable. function To_Source_Buffer_Ptr_Var is new - Unchecked_Conversion (Source_Buffer_Ptr, Source_Buffer_Ptr_Var); + Ada.Unchecked_Conversion (Source_Buffer_Ptr, Source_Buffer_Ptr_Var); Temp : Source_Buffer_Ptr_Var := To_Source_Buffer_Ptr_Var (Src); procedure Free_Ptr is new - Unchecked_Deallocation (Source_Buffer, Source_Buffer_Ptr_Var); + Ada.Unchecked_Deallocation (Source_Buffer, Source_Buffer_Ptr_Var); begin Free_Ptr (Temp); Src := null; @@ -922,7 +922,7 @@ package body Sinput is pragma Import (Ada, Dope); use System.Storage_Elements; for Dope'Address use Src + System.Address'Size / 8; - procedure Free is new Unchecked_Deallocation (Dope_Rec, Dope_Ptr); + procedure Free is new Ada.Unchecked_Deallocation (Dope_Rec, Dope_Ptr); begin Free (Dope); end Free_Dope; @@ -1023,7 +1023,7 @@ package body Sinput is SI : constant Source_File_Index := Get_Source_File_Index (P); begin - Write_Name (Debug_Source_Name (SI)); + Write_Name_For_Debug (Debug_Source_Name (SI)); Write_Char (':'); Write_Int (Int (Get_Logical_Line_Number (P))); Write_Char (':'); diff --git a/gcc/ada/sinput.ads b/gcc/ada/sinput.ads index 2890563..af2fec7 100644 --- a/gcc/ada/sinput.ads +++ b/gcc/ada/sinput.ads @@ -693,14 +693,11 @@ package Sinput is -- names in some situations. procedure Write_Location (P : Source_Ptr); - -- Writes out a string of the form fff:nn:cc, where fff, nn, cc are the - -- file name, line number and column corresponding to the given source - -- location. No_Location and Standard_Location appear as the strings - -- <no location> and <standard location>. If the location is within an - -- instantiation, then the instance location is appended, enclosed in - -- square brackets (which can nest if necessary). Note that this routine - -- is used only for internal compiler debugging output purposes (which - -- is why the somewhat cryptic use of brackets is acceptable). + -- Writes P, in the form fff:nn:cc, where fff, nn, cc are the file name, + -- line number and column corresponding to the given source location. If + -- the location is within an instantiation, then the instance location is + -- appended, enclosed in square brackets, which can nest if necessary. This + -- is used only for debugging output. procedure wl (P : Source_Ptr); pragma Export (Ada, wl); diff --git a/gcc/ada/style.ads b/gcc/ada/style.ads index 814bb2b..209dff8 100644 --- a/gcc/ada/style.ads +++ b/gcc/ada/style.ads @@ -147,9 +147,10 @@ package Style is -- is that the starting column is appropriate to the indentation rules if -- Token_Ptr is the first token on the line. - procedure Check_Left_Paren - renames Style_Inst.Check_Left_Paren; - -- Called after scanning out a left parenthesis to check spacing + procedure Check_Left_Paren_Square_Bracket + renames Style_Inst.Check_Left_Paren_Square_Bracket; + -- Called after scanning out a left parenthesis to check spacing. If + -- Ada_Version >= Ada_2022 then called similarly for a left square bracket. procedure Check_Line_Terminator (Len : Int) renames Style_Inst.Check_Line_Terminator; diff --git a/gcc/ada/styleg.adb b/gcc/ada/styleg.adb index 205bad0..6a785b5 100644 --- a/gcc/ada/styleg.adb +++ b/gcc/ada/styleg.adb @@ -721,15 +721,16 @@ package body Styleg is end if; end Check_Indentation; - ---------------------- - -- Check_Left_Paren -- - ---------------------- + ------------------------------------- + -- Check_Left_Paren_Square_Bracket -- + ------------------------------------- -- In check token mode (-gnatyt), left paren must not be preceded by an -- identifier character or digit (a separating space is required) and may -- never be followed by a space. + -- Same applies for the left square bracket starting from Ada version 2022. - procedure Check_Left_Paren is + procedure Check_Left_Paren_Square_Bracket is begin if Style_Check_Tokens then if Token_Ptr > Source_First (Current_Source_File) @@ -740,7 +741,7 @@ package body Styleg is Check_No_Space_After; end if; - end Check_Left_Paren; + end Check_Left_Paren_Square_Bracket; --------------------------- -- Check_Line_Max_Length -- diff --git a/gcc/ada/styleg.ads b/gcc/ada/styleg.ads index 116d6ef..23a1ee4 100644 --- a/gcc/ada/styleg.ads +++ b/gcc/ada/styleg.ads @@ -111,8 +111,9 @@ package Styleg is -- is that the starting column is appropriate to the indentation rules if -- Token_Ptr is the first token on the line. - procedure Check_Left_Paren; - -- Called after scanning out a left parenthesis to check spacing + procedure Check_Left_Paren_Square_Bracket; + -- Called after scanning out a left parenthesis to check spacing. If + -- Ada_Version >= Ada_2022 then called similarly for a left square bracket. procedure Check_Line_Max_Length (Len : Nat); -- Called with Scan_Ptr pointing to the first line terminator character diff --git a/gcc/ada/switch-b.adb b/gcc/ada/switch-b.adb index 780a071..10feb23 100644 --- a/gcc/ada/switch-b.adb +++ b/gcc/ada/switch-b.adb @@ -158,6 +158,9 @@ package body Switch.B is elsif Underscore then Set_Underscored_Debug_Flag (C); + if Debug_Flag_Underscore_C then + Enable_CUDA_Expansion := True; + end if; Underscore := False; -- letter diff --git a/gcc/ada/switch-c.adb b/gcc/ada/switch-c.adb index a34e841..522cdf6 100644 --- a/gcc/ada/switch-c.adb +++ b/gcc/ada/switch-c.adb @@ -390,6 +390,9 @@ package body Switch.C is elsif Underscore then Set_Underscored_Debug_Flag (C); Store_Compilation_Switch ("-gnatd_" & C); + if Debug_Flag_Underscore_C then + Enable_CUDA_Expansion := True; + end if; -- Normal flag diff --git a/gcc/ada/table.adb b/gcc/ada/table.adb index ce558cd..df467f4 100644 --- a/gcc/ada/table.adb +++ b/gcc/ada/table.adb @@ -30,7 +30,7 @@ with System; use System; with System.Memory; use System.Memory; -with Unchecked_Conversion; +with Ada.Unchecked_Conversion; pragma Elaborate_All (Output); @@ -58,8 +58,8 @@ package body Table is -- internally in this package, and cannot never result in any instances -- of improperly aliased pointers for the client of the package. - function To_Address is new Unchecked_Conversion (Table_Ptr, Address); - function To_Pointer is new Unchecked_Conversion (Address, Table_Ptr); + function To_Address is new Ada.Unchecked_Conversion (Table_Ptr, Address); + function To_Pointer is new Ada.Unchecked_Conversion (Address, Table_Ptr); pragma Warnings (On); diff --git a/gcc/ada/targparm.adb b/gcc/ada/targparm.adb index cbf9944..fe436c0 100644 --- a/gcc/ada/targparm.adb +++ b/gcc/ada/targparm.adb @@ -48,7 +48,6 @@ package body Targparm is D32, -- Duration_32_Bits DEN, -- Denorm EXS, -- Exit_Status_Supported - FEX, -- Frontend_Exceptions MOV, -- Machine_Overflows MRN, -- Machine_Rounds PAS, -- Preallocated_Stacks @@ -79,7 +78,6 @@ package body Targparm is D32_Str : aliased constant Source_Buffer := "Duration_32_Bits"; DEN_Str : aliased constant Source_Buffer := "Denorm"; EXS_Str : aliased constant Source_Buffer := "Exit_Status_Supported"; - FEX_Str : aliased constant Source_Buffer := "Frontend_Exceptions"; MOV_Str : aliased constant Source_Buffer := "Machine_Overflows"; MRN_Str : aliased constant Source_Buffer := "Machine_Rounds"; PAS_Str : aliased constant Source_Buffer := "Preallocated_Stacks"; @@ -110,7 +108,6 @@ package body Targparm is D32 => D32_Str'Access, DEN => DEN_Str'Access, EXS => EXS_Str'Access, - FEX => FEX_Str'Access, MOV => MOV_Str'Access, MRN => MRN_Str'Access, PAS => PAS_Str'Access, @@ -800,7 +797,6 @@ package body Targparm is when D32 => Duration_32_Bits_On_Target := Result; when DEN => Denorm_On_Target := Result; when EXS => Exit_Status_Supported_On_Target := Result; - when FEX => Frontend_Exceptions_On_Target := Result; when MOV => Machine_Overflows_On_Target := Result; when MRN => Machine_Rounds_On_Target := Result; when PAS => Preallocated_Stacks_On_Target := Result; diff --git a/gcc/ada/targparm.ads b/gcc/ada/targparm.ads index 9353d92..3d3290b 100644 --- a/gcc/ada/targparm.ads +++ b/gcc/ada/targparm.ads @@ -263,9 +263,6 @@ package Targparm is ZCX_By_Default_On_Target : Boolean := False; -- Indicates if zero cost scheme for exceptions - Frontend_Exceptions_On_Target : Boolean := True; - -- Indicates if we're using a front-end scheme for exceptions - ------------------------------------ -- Run-Time Library Configuration -- ------------------------------------ diff --git a/gcc/ada/treepr.adb b/gcc/ada/treepr.adb index 3173668..32f6e81 100644 --- a/gcc/ada/treepr.adb +++ b/gcc/ada/treepr.adb @@ -23,6 +23,7 @@ -- -- ------------------------------------------------------------------------------ +with Ada.Unchecked_Conversion; with Aspects; use Aspects; with Atree; use Atree; with Debug; use Debug; @@ -49,7 +50,6 @@ with SCIL_LL; use SCIL_LL; with Uintp; use Uintp; with Urealp; use Urealp; with Uname; use Uname; -with Unchecked_Conversion; package body Treepr is @@ -132,8 +132,8 @@ package body Treepr is -- Local Procedures -- ---------------------- - function From_Union is new Unchecked_Conversion (Union_Id, Uint); - function From_Union is new Unchecked_Conversion (Union_Id, Ureal); + function From_Union is new Ada.Unchecked_Conversion (Union_Id, Uint); + function From_Union is new Ada.Unchecked_Conversion (Union_Id, Ureal); function To_Mixed (S : String) return String; -- Turns an identifier into Mixed_Case. For bootstrap reasons, we cannot @@ -260,7 +260,7 @@ package body Treepr is ---------- function Hash (Key : Int) return GNAT.Bucket_Range_Type is - function Cast is new Unchecked_Conversion + function Cast is new Ada.Unchecked_Conversion (Source => Int, Target => GNAT.Bucket_Range_Type); begin return Cast (Key); @@ -880,7 +880,7 @@ package body Treepr is when Uint_Field => declare Val : constant Uint := Get_Uint (N, FD.Offset); - function Cast is new Unchecked_Conversion (Uint, Int); + function Cast is new Ada.Unchecked_Conversion (Uint, Int); begin if Present (Val) then Print_Initial; @@ -895,7 +895,7 @@ package body Treepr is | Nonzero_Uint_Field => declare Val : constant Uint := Get_Valid_Uint (N, FD.Offset); - function Cast is new Unchecked_Conversion (Uint, Int); + function Cast is new Ada.Unchecked_Conversion (Uint, Int); begin Print_Initial; UI_Write (Val, Format); @@ -916,7 +916,7 @@ package body Treepr is when Ureal_Field => declare Val : constant Ureal := Get_Ureal (N, FD.Offset); - function Cast is new Unchecked_Conversion (Ureal, Int); + function Cast is new Ada.Unchecked_Conversion (Ureal, Int); begin if Val /= No_Ureal then Print_Initial; @@ -980,7 +980,8 @@ package body Treepr is exception when others => declare - function Cast is new Unchecked_Conversion (Field_Size_32_Bit, Int); + function Cast is new + Ada.Unchecked_Conversion (Field_Size_32_Bit, Int); begin Write_Eol; Print_Initial; @@ -1142,21 +1143,7 @@ package body Treepr is procedure Print_Name (N : Name_Id) is begin if Phase = Printing then - if N = No_Name then - Print_Str ("<No_Name>"); - - elsif N = Error_Name then - Print_Str ("<Error_Name>"); - - elsif Is_Valid_Name (N) then - Get_Name_String (N); - Print_Char ('"'); - Write_Name (N); - Print_Char ('"'); - - else - Print_Str ("<invalid name>"); - end if; + Write_Name_For_Debug (N, Quote => """"); end if; end Print_Name; @@ -1878,7 +1865,7 @@ package body Treepr is Write_Eol; Write_Str ("Tree created for "); - Write_Unit_Name (Unit_Name (Main_Unit)); + Write_Unit_Name_For_Debug (Unit_Name (Main_Unit)); Underline; Print_Node_Subtree (Cunit (Main_Unit)); Write_Eol; diff --git a/gcc/ada/types.ads b/gcc/ada/types.ads index a44aa13..3b226e1 100644 --- a/gcc/ada/types.ads +++ b/gcc/ada/types.ads @@ -39,9 +39,9 @@ -- 2s-complement. If there are any machines for which this is not a correct -- assumption, a significant number of changes will be required. +with Ada.Unchecked_Conversion; +with Ada.Unchecked_Deallocation; with System; -with Unchecked_Conversion; -with Unchecked_Deallocation; package Types is pragma Preelaborate; @@ -117,7 +117,7 @@ package Types is type String_Ptr_Const is access constant String; -- Standard character and string pointers - procedure Free is new Unchecked_Deallocation (String, String_Ptr); + procedure Free is new Ada.Unchecked_Deallocation (String, String_Ptr); -- Procedure for freeing dynamically allocated String values subtype Big_String is String (Positive); @@ -127,7 +127,7 @@ package Types is -- size of zero, since there are legitimate deallocations going on. function To_Big_String_Ptr is - new Unchecked_Conversion (System.Address, Big_String_Ptr); + new Ada.Unchecked_Conversion (System.Address, Big_String_Ptr); -- Used to obtain Big_String_Ptr values from external addresses subtype Word_Hex_String is String (1 .. 8); @@ -155,7 +155,8 @@ package Types is -- Text buffers for input files are allocated dynamically and this type -- is used to reference these text buffers. - procedure Free is new Unchecked_Deallocation (Text_Buffer, Text_Buffer_Ptr); + procedure Free is + new Ada.Unchecked_Deallocation (Text_Buffer, Text_Buffer_Ptr); -- Procedure for freeing dynamically allocated text buffers ------------------------------------------ diff --git a/gcc/ada/uname.adb b/gcc/ada/uname.adb index 82bc7dc..60ef2b6 100644 --- a/gcc/ada/uname.adb +++ b/gcc/ada/uname.adb @@ -411,51 +411,42 @@ package body Uname is -------------------------- procedure Get_Unit_Name_String - (N : Unit_Name_Type; + (Buf : in out Bounded_String; + N : Unit_Name_Type; Suffix : Boolean := True) is - Unit_Is_Body : Boolean; - begin - Get_Decoded_Name_String (N); - Unit_Is_Body := Name_Buffer (Name_Len) = 'b'; - Set_Casing (Identifier_Casing (Source_Index (Main_Unit))); - - -- A special fudge, normally we don't have operator symbols present, - -- since it is always an error to do so. However, if we do, at this - -- stage it has the form: + Buf.Length := 0; + Append_Decoded (Buf, N); - -- "and" + -- Buf always ends with "%s" or "%b", which we either remove, or replace + -- with " (spec)" or " (body)". Set_Casing of Buf after checking for + -- (lower case) 's'/'b', and before appending (lower case) "spec" or + -- "body". - -- and the %s or %b has already been eliminated so put 2 chars back + pragma Assert (Buf.Length >= 3); + pragma Assert (Buf.Chars (1) /= '"'); + pragma Assert (Buf.Chars (Buf.Length) in 's' | 'b'); - if Name_Buffer (1) = '"' then - Name_Len := Name_Len + 2; - end if; - - -- Now adjust the %s or %b to (spec) or (body) + declare + S : constant String := + (if Buf.Chars (Buf.Length) = 's' then " (spec)" else " (body)"); + begin + Buf.Length := Buf.Length - 1; -- remove 's' or 'b' + pragma Assert (Buf.Chars (Buf.Length) = '%'); + Buf.Length := Buf.Length - 1; -- remove '%' + Set_Casing (Buf, Identifier_Casing (Source_Index (Main_Unit))); - if Suffix then - if Unit_Is_Body then - Name_Buffer (Name_Len - 1 .. Name_Len + 5) := " (body)"; - else - Name_Buffer (Name_Len - 1 .. Name_Len + 5) := " (spec)"; + if Suffix then + Append (Buf, S); end if; - end if; + end; - for J in 1 .. Name_Len loop - if Name_Buffer (J) = '-' then - Name_Buffer (J) := '.'; + for J in 1 .. Buf.Length loop + if Buf.Chars (J) = '-' then + Buf.Chars (J) := '.'; end if; end loop; - - -- Adjust Name_Len - - if Suffix then - Name_Len := Name_Len + (7 - 2); - else - Name_Len := Name_Len - 2; - end if; end Get_Unit_Name_String; ---------------- @@ -721,9 +712,23 @@ package body Uname is --------------------- procedure Write_Unit_Name (N : Unit_Name_Type) is + Buf : Bounded_String; begin - Get_Unit_Name_String (N); - Write_Str (Name_Buffer (1 .. Name_Len)); + Get_Unit_Name_String (Buf, N); + Write_Str (Buf.chars (1 .. Buf.Length)); end Write_Unit_Name; + ------------------------------- + -- Write_Unit_Name_For_Debug -- + ------------------------------- + + procedure Write_Unit_Name_For_Debug (N : Unit_Name_Type) is + begin + if Is_Valid_Name (N) then + Write_Unit_Name (N); + else + Write_Name_For_Debug (N); + end if; + end Write_Unit_Name_For_Debug; + end Uname; diff --git a/gcc/ada/uname.ads b/gcc/ada/uname.ads index 3f9aabe..35d62a2 100644 --- a/gcc/ada/uname.ads +++ b/gcc/ada/uname.ads @@ -57,7 +57,7 @@ package Uname is -- For display purposes, unit names are printed out with the suffix -- " (body)" for a body and " (spec)" for a spec. These formats are - -- used for the Write_Unit_Name and Get_Unit_Name_String subprograms. + -- used for Write_Unit_Name and Get_Unit_Name_String. ----------------- -- Subprograms -- @@ -111,13 +111,11 @@ package Uname is -- N_Subunit procedure Get_Unit_Name_String - (N : Unit_Name_Type; + (Buf : in out Bounded_String; + N : Unit_Name_Type; Suffix : Boolean := True); - -- Places the display name of the unit in Name_Buffer and sets Name_Len to - -- the length of the stored name, i.e. it uses the same interface as the - -- Get_Name_String routine in the Namet package. The name is decoded and - -- contains an indication of spec or body if Boolean parameter Suffix is - -- True. + -- Puts the display name for N in Buf. The name is decoded and contains an + -- indication of spec or body if Suffix is True. function Is_Body_Name (N : Unit_Name_Type) return Boolean; -- Returns True iff the given name is the unit name of a body (i.e. if @@ -161,7 +159,7 @@ package Uname is -- result = A.R.C (body) -- -- See spec of Load_Unit for extensive discussion of why this routine - -- needs to be used (the call in the body of Load_Unit is the only one). + -- needs to be used (the calls in Load_Unit are the only ones). function Uname_Ge (Left, Right : Unit_Name_Type) return Boolean; function Uname_Gt (Left, Right : Unit_Name_Type) return Boolean; @@ -175,8 +173,10 @@ package Uname is -- are the same, they always have the same Name_Id value. procedure Write_Unit_Name (N : Unit_Name_Type); - -- Given a unit name, this procedure writes the display name to the - -- standard output file. Name_Buffer and Name_Len are set as described - -- above for the Get_Unit_Name_String call on return. + -- Writes the display form of N to standard output + + procedure Write_Unit_Name_For_Debug (N : Unit_Name_Type); + -- Like Write_Unit_Name, except it tries to be robust in the presence of + -- invalid data. end Uname; diff --git a/gcc/ada/xref_lib.adb b/gcc/ada/xref_lib.adb index a215467..3cb7bcb 100644 --- a/gcc/ada/xref_lib.adb +++ b/gcc/ada/xref_lib.adb @@ -29,10 +29,9 @@ with Osint; with Output; use Output; with Types; use Types; -with Unchecked_Deallocation; - with Ada.Strings.Fixed; use Ada.Strings.Fixed; with Ada.Text_IO; +with Ada.Unchecked_Deallocation; with GNAT.Command_Line; use GNAT.Command_Line; with GNAT.IO_Aux; use GNAT.IO_Aux; @@ -1718,7 +1717,7 @@ package body Xref_Lib is Type_Tree : Boolean) is type String_Access is access String; - procedure Free is new Unchecked_Deallocation (String, String_Access); + procedure Free is new Ada.Unchecked_Deallocation (String, String_Access); ALIfile : ALI_File; File_Ref : File_Reference; diff --git a/gcc/analyzer/ChangeLog b/gcc/analyzer/ChangeLog index 9f8c381..5a9551b 100644 --- a/gcc/analyzer/ChangeLog +++ b/gcc/analyzer/ChangeLog @@ -1,3 +1,7 @@ +2022-05-13 Richard Biener <rguenther@suse.de> + + * supergraph.cc: Re-order gimple-fold.h include. + 2022-05-11 David Malcolm <dmalcolm@redhat.com> * checker-path.cc (state_change_event::get_desc): Call maybe_free diff --git a/gcc/analyzer/supergraph.cc b/gcc/analyzer/supergraph.cc index 466f924..f023c53 100644 --- a/gcc/analyzer/supergraph.cc +++ b/gcc/analyzer/supergraph.cc @@ -29,13 +29,13 @@ along with GCC; see the file COPYING3. If not see #include "ggc.h" #include "basic-block.h" #include "function.h" +#include "gimple.h" +#include "gimple-iterator.h" #include "gimple-fold.h" #include "tree-eh.h" #include "gimple-expr.h" #include "is-a.h" #include "timevar.h" -#include "gimple.h" -#include "gimple-iterator.h" #include "gimple-pretty-print.h" #include "tree-pretty-print.h" #include "graphviz.h" diff --git a/gcc/builtins.cc b/gcc/builtins.cc index 5b085e3..5fc89ad 100644 --- a/gcc/builtins.cc +++ b/gcc/builtins.cc @@ -67,13 +67,13 @@ along with GCC; see the file COPYING3. If not see #include "asan.h" #include "internal-fn.h" #include "case-cfn-macros.h" +#include "gimple-iterator.h" #include "gimple-fold.h" #include "intl.h" #include "file-prefix-map.h" /* remap_macro_filename() */ #include "gomp-constants.h" #include "omp-general.h" #include "tree-dfa.h" -#include "gimple-iterator.h" #include "gimple-ssa.h" #include "tree-ssa-live.h" #include "tree-outof-ssa.h" diff --git a/gcc/c-family/ChangeLog b/gcc/c-family/ChangeLog index 88c92d0..0d2b277 100644 --- a/gcc/c-family/ChangeLog +++ b/gcc/c-family/ChangeLog @@ -1,3 +1,13 @@ +2022-05-13 Richard Biener <rguenther@suse.de> + + * c-omp.cc: Remove gimple-fold.h include. + +2022-05-12 Jakub Jelinek <jakub@redhat.com> + + * c-common.h (enum rid): Add RID_OMP_ALL_MEMORY. + * c-omp.cc (c_finish_omp_depobj): Don't build_fold_addr_expr + if null_pointer_node. + 2022-05-11 Martin Liska <mliska@suse.cz> PR target/105355 diff --git a/gcc/c-family/c-omp.cc b/gcc/c-family/c-omp.cc index 987ba7d..01ef4ee 100644 --- a/gcc/c-family/c-omp.cc +++ b/gcc/c-family/c-omp.cc @@ -36,7 +36,6 @@ along with GCC; see the file COPYING3. If not see #include "gimplify.h" #include "langhooks.h" #include "bitmap.h" -#include "gimple-fold.h" /* Complete a #pragma oacc wait construct. LOC is the location of diff --git a/gcc/c/ChangeLog b/gcc/c/ChangeLog index f697867..6db1152d 100644 --- a/gcc/c/ChangeLog +++ b/gcc/c/ChangeLog @@ -1,3 +1,15 @@ +2022-05-12 Jakub Jelinek <jakub@redhat.com> + + * c-parser.cc (c_parse_init): Register omp_all_memory as keyword + if flag_openmp. + (c_parser_postfix_expression): Diagnose uses of omp_all_memory + in postfix expressions. + (c_parser_omp_variable_list): Handle omp_all_memory in depend + clause. + * c-typeck.cc (c_finish_omp_clauses): Handle omp_all_memory + keyword in depend clause as null_pointer_node, diagnose invalid + uses. + 2022-05-09 Martin Liska <mliska@suse.cz> * c-parser.cc (c_parser_conditional_expression): Use {,UN}LIKELY diff --git a/gcc/calls.cc b/gcc/calls.cc index 4d0bc45..bbaf69c 100644 --- a/gcc/calls.cc +++ b/gcc/calls.cc @@ -55,6 +55,7 @@ along with GCC; see the file COPYING3. If not see #include "hash-traits.h" #include "attribs.h" #include "builtins.h" +#include "gimple-iterator.h" #include "gimple-fold.h" #include "attr-fnspec.h" #include "value-query.h" diff --git a/gcc/cgraphbuild.cc b/gcc/cgraphbuild.cc index 138484c..fdd17aa 100644 --- a/gcc/cgraphbuild.cc +++ b/gcc/cgraphbuild.cc @@ -26,8 +26,8 @@ along with GCC; see the file COPYING3. If not see #include "gimple.h" #include "tree-pass.h" #include "cgraph.h" -#include "gimple-fold.h" #include "gimple-iterator.h" +#include "gimple-fold.h" #include "gimple-walk.h" #include "ipa-utils.h" #include "except.h" diff --git a/gcc/cgraphunit.cc b/gcc/cgraphunit.cc index bc3dc75..e77bf97 100644 --- a/gcc/cgraphunit.cc +++ b/gcc/cgraphunit.cc @@ -179,9 +179,9 @@ along with GCC; see the file COPYING3. If not see #include "stor-layout.h" #include "output.h" #include "cfgcleanup.h" +#include "gimple-iterator.h" #include "gimple-fold.h" #include "gimplify.h" -#include "gimple-iterator.h" #include "gimplify-me.h" #include "tree-cfg.h" #include "tree-into-ssa.h" diff --git a/gcc/config/aarch64/aarch64-protos.h b/gcc/config/aarch64/aarch64-protos.h index 2ac781d..df31181 100644 --- a/gcc/config/aarch64/aarch64-protos.h +++ b/gcc/config/aarch64/aarch64-protos.h @@ -1065,7 +1065,7 @@ bool aarch64_high_bits_all_ones_p (HOST_WIDE_INT); struct atomic_ool_names { - const char *str[5][4]; + const char *str[5][5]; }; rtx aarch64_atomic_ool_func(machine_mode mode, rtx model_rtx, diff --git a/gcc/config/aarch64/aarch64.cc b/gcc/config/aarch64/aarch64.cc index f650abb..f4d2a80 100644 --- a/gcc/config/aarch64/aarch64.cc +++ b/gcc/config/aarch64/aarch64.cc @@ -22678,14 +22678,14 @@ aarch64_emit_unlikely_jump (rtx insn) add_reg_br_prob_note (jump, profile_probability::very_unlikely ()); } -/* We store the names of the various atomic helpers in a 5x4 array. +/* We store the names of the various atomic helpers in a 5x5 array. Return the libcall function given MODE, MODEL and NAMES. */ rtx aarch64_atomic_ool_func(machine_mode mode, rtx model_rtx, const atomic_ool_names *names) { - memmodel model = memmodel_base (INTVAL (model_rtx)); + memmodel model = memmodel_from_int (INTVAL (model_rtx)); int mode_idx, model_idx; switch (mode) @@ -22725,6 +22725,11 @@ aarch64_atomic_ool_func(machine_mode mode, rtx model_rtx, case MEMMODEL_SEQ_CST: model_idx = 3; break; + case MEMMODEL_SYNC_ACQUIRE: + case MEMMODEL_SYNC_RELEASE: + case MEMMODEL_SYNC_SEQ_CST: + model_idx = 4; + break; default: gcc_unreachable (); } @@ -22737,7 +22742,8 @@ aarch64_atomic_ool_func(machine_mode mode, rtx model_rtx, { "__aarch64_" #B #N "_relax", \ "__aarch64_" #B #N "_acq", \ "__aarch64_" #B #N "_rel", \ - "__aarch64_" #B #N "_acq_rel" } + "__aarch64_" #B #N "_acq_rel", \ + "__aarch64_" #B #N "_sync" } #define DEF4(B) DEF0(B, 1), DEF0(B, 2), DEF0(B, 4), DEF0(B, 8), \ { NULL, NULL, NULL, NULL } diff --git a/gcc/config/arm/arm.cc b/gcc/config/arm/arm.cc index 69a18c2..2afe044 100644 --- a/gcc/config/arm/arm.cc +++ b/gcc/config/arm/arm.cc @@ -13527,7 +13527,7 @@ mve_vector_mem_operand (machine_mode mode, rtx op, bool strict) int reg_no = REGNO (op); return (((mode == E_V8QImode || mode == E_V4QImode || mode == E_V4HImode) ? reg_no <= LAST_LO_REGNUM - :(reg_no < LAST_ARM_REGNUM && reg_no != SP_REGNUM)) + : reg_no < LAST_ARM_REGNUM) || (!strict && reg_no >= FIRST_PSEUDO_REGISTER)); } code = GET_CODE (op); @@ -13536,10 +13536,10 @@ mve_vector_mem_operand (machine_mode mode, rtx op, bool strict) || code == PRE_INC || code == POST_DEC) { reg_no = REGNO (XEXP (op, 0)); - return ((mode == E_V8QImode || mode == E_V4QImode || mode == E_V4HImode) - ? reg_no <= LAST_LO_REGNUM - :(reg_no < LAST_ARM_REGNUM && reg_no != SP_REGNUM)) - || reg_no >= FIRST_PSEUDO_REGISTER; + return (((mode == E_V8QImode || mode == E_V4QImode || mode == E_V4HImode) + ? reg_no <= LAST_LO_REGNUM + :(reg_no < LAST_ARM_REGNUM && reg_no != SP_REGNUM)) + || (!strict && reg_no >= FIRST_PSEUDO_REGISTER)); } else if (((code == POST_MODIFY || code == PRE_MODIFY) && GET_CODE (XEXP (op, 1)) == PLUS @@ -13580,10 +13580,11 @@ mve_vector_mem_operand (machine_mode mode, rtx op, bool strict) default: return FALSE; } - return reg_no >= FIRST_PSEUDO_REGISTER - || (MVE_STN_LDW_MODE (mode) - ? reg_no <= LAST_LO_REGNUM - : (reg_no < LAST_ARM_REGNUM && reg_no != SP_REGNUM)); + return ((!strict && reg_no >= FIRST_PSEUDO_REGISTER) + || (MVE_STN_LDW_MODE (mode) + ? reg_no <= LAST_LO_REGNUM + : (reg_no < LAST_ARM_REGNUM + && (code == PLUS || reg_no != SP_REGNUM)))); } return FALSE; } diff --git a/gcc/config/arm/mve.md b/gcc/config/arm/mve.md index 369d7a7..f16991c 100644 --- a/gcc/config/arm/mve.md +++ b/gcc/config/arm/mve.md @@ -10462,7 +10462,7 @@ ) (define_insn "*movmisalign<mode>_mve_store" - [(set (match_operand:MVE_VLD_ST 0 "neon_permissive_struct_operand" "=Ux") + [(set (match_operand:MVE_VLD_ST 0 "mve_memory_operand" "=Ux") (unspec:MVE_VLD_ST [(match_operand:MVE_VLD_ST 1 "s_register_operand" " w")] UNSPEC_MISALIGNED_ACCESS))] "((TARGET_HAVE_MVE && VALID_MVE_SI_MODE (<MODE>mode)) @@ -10475,7 +10475,7 @@ (define_insn "*movmisalign<mode>_mve_load" [(set (match_operand:MVE_VLD_ST 0 "s_register_operand" "=w") - (unspec:MVE_VLD_ST [(match_operand:MVE_VLD_ST 1 "neon_permissive_struct_operand" " Ux")] + (unspec:MVE_VLD_ST [(match_operand:MVE_VLD_ST 1 "mve_memory_operand" " Ux")] UNSPEC_MISALIGNED_ACCESS))] "((TARGET_HAVE_MVE && VALID_MVE_SI_MODE (<MODE>mode)) || (TARGET_HAVE_MVE_FLOAT && VALID_MVE_SF_MODE (<MODE>mode))) diff --git a/gcc/config/arm/vec-common.md b/gcc/config/arm/vec-common.md index fd878cba..1fd68f3 100644 --- a/gcc/config/arm/vec-common.md +++ b/gcc/config/arm/vec-common.md @@ -280,29 +280,81 @@ DONE; }) -(define_expand "movmisalign<mode>" - [(set (match_operand:VDQ 0 "neon_perm_struct_or_reg_operand") - (unspec:VDQ [(match_operand:VDQ 1 "neon_perm_struct_or_reg_operand")] +(define_expand "@movmisalign<mode>" + [(set (match_operand:VDQ 0 "nonimmediate_operand") + (unspec:VDQ [(match_operand:VDQ 1 "general_operand")] UNSPEC_MISALIGNED_ACCESS))] "ARM_HAVE_<MODE>_LDST && !BYTES_BIG_ENDIAN && unaligned_access && !TARGET_REALLY_IWMMXT" { - rtx adjust_mem; - /* This pattern is not permitted to fail during expansion: if both arguments - are non-registers (e.g. memory := constant, which can be created by the - auto-vectorizer), force operand 1 into a register. */ - if (!s_register_operand (operands[0], <MODE>mode) - && !s_register_operand (operands[1], <MODE>mode)) - operands[1] = force_reg (<MODE>mode, operands[1]); - - if (s_register_operand (operands[0], <MODE>mode)) - adjust_mem = operands[1]; - else - adjust_mem = operands[0]; - - /* Legitimize address. */ - if (!neon_vector_mem_operand (adjust_mem, 2, true)) - XEXP (adjust_mem, 0) = force_reg (Pmode, XEXP (adjust_mem, 0)); + rtx *memloc; + bool for_store = false; + /* This pattern is not permitted to fail during expansion: if both arguments + are non-registers (e.g. memory := constant, which can be created by the + auto-vectorizer), force operand 1 into a register. */ + if (!s_register_operand (operands[0], <MODE>mode) + && !s_register_operand (operands[1], <MODE>mode)) + operands[1] = force_reg (<MODE>mode, operands[1]); + + if (s_register_operand (operands[0], <MODE>mode)) + memloc = &operands[1]; + else + { + memloc = &operands[0]; + for_store = true; + } + + /* For MVE, vector loads/stores must be aligned to the element size. If the + alignment is less than that convert the load/store to a suitable mode. */ + if (TARGET_HAVE_MVE + && (MEM_ALIGN (*memloc) + < GET_MODE_ALIGNMENT (GET_MODE_INNER (<MODE>mode)))) + { + scalar_mode new_smode; + switch (MEM_ALIGN (*memloc)) + { + case 64: + case 32: + new_smode = SImode; + break; + case 16: + new_smode = HImode; + break; + default: + new_smode = QImode; + break; + } + machine_mode new_mode + = mode_for_vector (new_smode, + GET_MODE_SIZE (<MODE>mode) + / GET_MODE_SIZE (new_smode)).require (); + rtx new_mem = adjust_address (*memloc, new_mode, 0); + + if (!for_store) + { + rtx reg = gen_reg_rtx (new_mode); + emit_insn (gen_movmisalign (new_mode, reg, new_mem)); + emit_move_insn (operands[0], gen_lowpart (<MODE>mode, reg)); + DONE; + } + emit_insn (gen_movmisalign (new_mode, new_mem, + gen_lowpart (new_mode, operands[1]))); + DONE; + } + + /* Legitimize address. */ + if ((TARGET_HAVE_MVE + && !mve_vector_mem_operand (<MODE>mode, XEXP (*memloc, 0), false)) + || (!TARGET_HAVE_MVE + && !neon_vector_mem_operand (*memloc, 2, false))) + { + rtx new_mem + = replace_equiv_address (*memloc, + force_reg (Pmode, XEXP (*memloc, 0)), + false); + gcc_assert (MEM_ALIGN (new_mem) == MEM_ALIGN (*memloc)); + *memloc = new_mem; + } }) (define_insn "mve_vshlq_<supf><mode>" diff --git a/gcc/config/i386/sse.md b/gcc/config/i386/sse.md index a63df0d..88fc521 100644 --- a/gcc/config/i386/sse.md +++ b/gcc/config/i386/sse.md @@ -4390,13 +4390,57 @@ (match_operator:V2DI 1 "" [(match_operand:V2DI 2 "register_operand") (match_operand:V2DI 3 "vector_operand")]))] - "TARGET_SSE4_1" + "TARGET_SSE2" { - bool ok = ix86_expand_int_vec_cmp (operands); + bool ok; + if (!TARGET_SSE4_1) + { + rtx ops[4]; + ops[0] = gen_reg_rtx (V4SImode); + ops[2] = gen_lowpart (V4SImode, force_reg (V2DImode, operands[2])); + ops[3] = gen_lowpart (V4SImode, force_reg (V2DImode, operands[3])); + ops[1] = gen_rtx_fmt_ee (GET_CODE (operands[1]), V4SImode, + ops[2], ops[3]); + ok = ix86_expand_int_vec_cmp (ops); + + rtx tmp1 = gen_reg_rtx (V4SImode); + emit_insn (gen_sse2_pshufd (tmp1, ops[0], GEN_INT (0xb1))); + + rtx tmp2 = gen_reg_rtx (V4SImode); + emit_insn (gen_andv4si3 (tmp2, tmp1, ops[0])); + + emit_move_insn (operands[0], gen_lowpart (V2DImode, tmp2)); + } + else + ok = ix86_expand_int_vec_cmp (operands); gcc_assert (ok); DONE; }) +(define_expand "vec_cmpeqv1tiv1ti" + [(set (match_operand:V1TI 0 "register_operand") + (match_operator:V1TI 1 "" + [(match_operand:V1TI 2 "register_operand") + (match_operand:V1TI 3 "vector_operand")]))] + "TARGET_SSE2" +{ + rtx dst = gen_reg_rtx (V2DImode); + rtx op1 = gen_lowpart (V2DImode, force_reg (V1TImode, operands[2])); + rtx op2 = gen_lowpart (V2DImode, force_reg (V1TImode, operands[3])); + rtx cmp = gen_rtx_fmt_ee (GET_CODE (operands[1]), V2DImode, op1, op2); + emit_insn (gen_vec_cmpeqv2div2di (dst, cmp, op1, op2)); + + rtx tmp1 = gen_reg_rtx (V4SImode); + rtx tmp2 = gen_lowpart (V4SImode, dst); + emit_insn (gen_sse2_pshufd (tmp1, tmp2, GEN_INT (0x4e))); + + rtx tmp3 = gen_reg_rtx (V4SImode); + emit_insn (gen_andv4si3 (tmp3, tmp2, tmp1)); + + emit_move_insn (operands[0], gen_lowpart (V1TImode, tmp3)); + DONE; +}) + (define_expand "vcond<V_512:mode><VF_512:mode>" [(set (match_operand:V_512 0 "register_operand") (if_then_else:V_512 @@ -20177,6 +20221,24 @@ (set_attr "prefix" "maybe_vex") (set_attr "mode" "SI")]) +;; Optimize pxor/pcmpeqb/pmovmskb/cmp 0xffff to ptest. +(define_mode_attr vi1avx2const + [(V32QI "0xffffffff") (V16QI "0xffff")]) + +(define_split + [(set (reg:CCZ FLAGS_REG) + (compare:CCZ (unspec:SI + [(eq:VI1_AVX2 + (match_operand:VI1_AVX2 0 "vector_operand") + (match_operand:VI1_AVX2 1 "const0_operand"))] + UNSPEC_MOVMSK) + (match_operand 2 "const_int_operand")))] + "TARGET_SSE4_1 && (INTVAL (operands[2]) == (int) (<vi1avx2const>))" + [(set (reg:CC FLAGS_REG) + (unspec:CC [(match_dup 0) + (match_dup 0)] + UNSPEC_PTEST))]) + (define_expand "sse2_maskmovdqu" [(set (match_operand:V16QI 0 "memory_operand") (unspec:V16QI [(match_operand:V16QI 1 "register_operand") diff --git a/gcc/config/riscv/riscv.h b/gcc/config/riscv/riscv.h index 8a4d2cf..b191606 100644 --- a/gcc/config/riscv/riscv.h +++ b/gcc/config/riscv/riscv.h @@ -1004,4 +1004,9 @@ extern void riscv_remove_unneeded_save_restore_calls (void); #define HARD_REGNO_RENAME_OK(FROM, TO) riscv_hard_regno_rename_ok (FROM, TO) +#define CLZ_DEFINED_VALUE_AT_ZERO(MODE, VALUE) \ + ((VALUE) = GET_MODE_UNIT_BITSIZE (MODE), 2) +#define CTZ_DEFINED_VALUE_AT_ZERO(MODE, VALUE) \ + ((VALUE) = GET_MODE_UNIT_BITSIZE (MODE), 2) + #endif /* ! GCC_RISCV_H */ diff --git a/gcc/config/rs6000/rs6000-builtin.cc b/gcc/config/rs6000/rs6000-builtin.cc index e925ba9..b60dde9 100644 --- a/gcc/config/rs6000/rs6000-builtin.cc +++ b/gcc/config/rs6000/rs6000-builtin.cc @@ -45,8 +45,8 @@ #include "expr.h" #include "langhooks.h" #include "gimplify.h" -#include "gimple-fold.h" #include "gimple-iterator.h" +#include "gimple-fold.h" #include "ssa.h" #include "tree-ssa-propagate.h" #include "builtins.h" diff --git a/gcc/config/rs6000/rs6000-call.cc b/gcc/config/rs6000/rs6000-call.cc index f06c692..6011fe8 100644 --- a/gcc/config/rs6000/rs6000-call.cc +++ b/gcc/config/rs6000/rs6000-call.cc @@ -55,8 +55,8 @@ #include "common/common-target.h" #include "langhooks.h" #include "gimplify.h" -#include "gimple-fold.h" #include "gimple-iterator.h" +#include "gimple-fold.h" #include "ssa.h" #include "tree-ssa-propagate.h" #include "builtins.h" diff --git a/gcc/config/rs6000/rs6000.cc b/gcc/config/rs6000/rs6000.cc index 5cb8a53..d4defc8 100644 --- a/gcc/config/rs6000/rs6000.cc +++ b/gcc/config/rs6000/rs6000.cc @@ -58,8 +58,8 @@ #include "reload.h" #include "sched-int.h" #include "gimplify.h" -#include "gimple-fold.h" #include "gimple-iterator.h" +#include "gimple-fold.h" #include "gimple-walk.h" #include "ssa.h" #include "tree-vectorizer.h" diff --git a/gcc/config/s390/s390.cc b/gcc/config/s390/s390.cc index 7c3bd6c..45bbb6c 100644 --- a/gcc/config/s390/s390.cc +++ b/gcc/config/s390/s390.cc @@ -70,6 +70,7 @@ along with GCC; see the file COPYING3. If not see #include "debug.h" #include "langhooks.h" #include "internal-fn.h" +#include "gimple-iterator.h" #include "gimple-fold.h" #include "tree-eh.h" #include "gimplify.h" diff --git a/gcc/config/xtensa/xtensa.h b/gcc/config/xtensa/xtensa.h index 00e2930..d25594f 100644 --- a/gcc/config/xtensa/xtensa.h +++ b/gcc/config/xtensa/xtensa.h @@ -75,6 +75,11 @@ along with GCC; see the file COPYING3. If not see #define HAVE_AS_TLS 0 #endif +/* Define this if the target has no hardware divide instructions. */ +#if !TARGET_DIV32 +#define TARGET_HAS_NO_HW_DIVIDE +#endif + /* Target CPU builtins. */ #define TARGET_CPU_CPP_BUILTINS() \ diff --git a/gcc/config/xtensa/xtensa.md b/gcc/config/xtensa/xtensa.md index 3b61e5d..96e043b 100644 --- a/gcc/config/xtensa/xtensa.md +++ b/gcc/config/xtensa/xtensa.md @@ -631,7 +631,7 @@ ;; Field extract instructions. -(define_expand "extv" +(define_expand "extvsi" [(set (match_operand:SI 0 "register_operand" "") (sign_extract:SI (match_operand:SI 1 "register_operand" "") (match_operand:SI 2 "const_int_operand" "") @@ -646,12 +646,12 @@ if (!lsbitnum_operand (operands[3], SImode)) FAIL; - emit_insn (gen_extv_internal (operands[0], operands[1], - operands[2], operands[3])); + emit_insn (gen_extvsi_internal (operands[0], operands[1], + operands[2], operands[3])); DONE; }) -(define_insn "extv_internal" +(define_insn "extvsi_internal" [(set (match_operand:SI 0 "register_operand" "=a") (sign_extract:SI (match_operand:SI 1 "register_operand" "r") (match_operand:SI 2 "sext_fldsz_operand" "i") @@ -666,7 +666,7 @@ (set_attr "mode" "SI") (set_attr "length" "3")]) -(define_expand "extzv" +(define_expand "extzvsi" [(set (match_operand:SI 0 "register_operand" "") (zero_extract:SI (match_operand:SI 1 "register_operand" "") (match_operand:SI 2 "const_int_operand" "") @@ -675,12 +675,12 @@ { if (!extui_fldsz_operand (operands[2], SImode)) FAIL; - emit_insn (gen_extzv_internal (operands[0], operands[1], - operands[2], operands[3])); + emit_insn (gen_extzvsi_internal (operands[0], operands[1], + operands[2], operands[3])); DONE; }) -(define_insn "extzv_internal" +(define_insn "extzvsi_internal" [(set (match_operand:SI 0 "register_operand" "=a") (zero_extract:SI (match_operand:SI 1 "register_operand" "r") (match_operand:SI 2 "extui_fldsz_operand" "i") diff --git a/gcc/cp/ChangeLog b/gcc/cp/ChangeLog index 5c1ee2f..090124f 100644 --- a/gcc/cp/ChangeLog +++ b/gcc/cp/ChangeLog @@ -1,3 +1,37 @@ +2022-05-13 Nathan Sidwell <nathan@acm.org> + + * mangle.cc (maybe_write_module): Check external linkage. + +2022-05-13 Richard Biener <rguenther@suse.de> + + * constexpr.cc: Remove gimple-fold.h include. + +2022-05-12 Patrick Palka <ppalka@redhat.com> + + * cp-tree.h (TMPL_ARGS_LEVEL): Assert LEVEL is 1 when + TMPL_ARGS_HAVE_MULTIPLE_LEVELS is false. + * pt.cc (try_class_unification): Correctly copy multidimensional + targs. Free the copy of targs. + (unify_pack_expansion): Fix level comparison. + +2022-05-12 Nathan Sidwell <nathan@acm.org> + + * parser.cc (cp_parser_linkage_specification): Implement + global module attachment semantics. + +2022-05-12 Jakub Jelinek <jakub@redhat.com> + + * lex.cc (init_reswords): Register omp_all_memory as keyword + if flag_openmp. + * parser.cc (cp_parser_primary_expression): Diagnose uses of + omp_all_memory in postfix expressions. + (cp_parser_omp_var_list_no_open): Handle omp_all_memory in depend + clause. + * semantics.cc (finish_omp_clauses): Handle omp_all_memory + keyword in depend clause as null_pointer_node, diagnose invalid + uses. + * pt.cc (tsubst_omp_clause_decl): Pass through omp_all_memory. + 2022-05-11 Patrick Palka <ppalka@redhat.com> * constraint.cc (tsubst_parameter_mapping): Convert loop over diff --git a/gcc/cp/constexpr.cc b/gcc/cp/constexpr.cc index e560d84..433fa76 100644 --- a/gcc/cp/constexpr.cc +++ b/gcc/cp/constexpr.cc @@ -31,7 +31,6 @@ along with GCC; see the file COPYING3. If not see #include "builtins.h" #include "tree-inline.h" #include "ubsan.h" -#include "gimple-fold.h" #include "timevar.h" #include "fold-const-call.h" #include "stor-layout.h" diff --git a/gcc/cp/cp-tree.h b/gcc/cp/cp-tree.h index b6961a7..b2df6fc 100644 --- a/gcc/cp/cp-tree.h +++ b/gcc/cp/cp-tree.h @@ -3783,7 +3783,8 @@ struct GTY(()) lang_decl { args is level 1, not level 0. */ #define TMPL_ARGS_LEVEL(ARGS, LEVEL) \ (TMPL_ARGS_HAVE_MULTIPLE_LEVELS (ARGS) \ - ? TREE_VEC_ELT (ARGS, (LEVEL) - 1) : (ARGS)) + ? TREE_VEC_ELT (ARGS, (LEVEL) - 1) \ + : (gcc_checking_assert ((LEVEL) == 1), (ARGS))) /* Set the LEVELth level of the template ARGS to VAL. This macro does not work with single-level argument vectors. */ diff --git a/gcc/cp/mangle.cc b/gcc/cp/mangle.cc index eb53e0e..75388e9 100644 --- a/gcc/cp/mangle.cc +++ b/gcc/cp/mangle.cc @@ -916,7 +916,10 @@ maybe_write_module (tree decl) if (!DECL_NAMESPACE_SCOPE_P (decl)) return; - if (TREE_CODE (decl) == NAMESPACE_DECL && DECL_NAME (decl)) + if (!TREE_PUBLIC (STRIP_TEMPLATE (decl))) + return; + + if (TREE_CODE (decl) == NAMESPACE_DECL) return; int m = get_originating_module (decl, true); diff --git a/gcc/cp/parser.cc b/gcc/cp/parser.cc index 84f379c..8969ed0 100644 --- a/gcc/cp/parser.cc +++ b/gcc/cp/parser.cc @@ -16189,6 +16189,8 @@ cp_parser_linkage_specification (cp_parser* parser, tree prefix_attr) linkage = get_identifier (TREE_STRING_POINTER (linkage)); /* We're now using the new linkage. */ + unsigned saved_module = module_kind; + module_kind &= ~MK_ATTACH; push_lang_context (linkage); /* Preserve the location of the innermost linkage specification, @@ -16235,6 +16237,7 @@ cp_parser_linkage_specification (cp_parser* parser, tree prefix_attr) /* We're done with the linkage-specification. */ pop_lang_context (); + module_kind = saved_module; /* Restore location of parent linkage specification, if any. */ parser->innermost_linkage_specification_location = saved_location; diff --git a/gcc/cp/pt.cc b/gcc/cp/pt.cc index 06b4a7d..fa05e91 100644 --- a/gcc/cp/pt.cc +++ b/gcc/cp/pt.cc @@ -23398,8 +23398,6 @@ static tree try_class_unification (tree tparms, tree targs, tree parm, tree arg, bool explain_p) { - tree copy_of_targs; - if (!CLASSTYPE_SPECIALIZATION_OF_PRIMARY_TEMPLATE_P (arg)) return NULL_TREE; else if (TREE_CODE (parm) == BOUND_TEMPLATE_TEMPLATE_PARM) @@ -23438,21 +23436,23 @@ try_class_unification (tree tparms, tree targs, tree parm, tree arg, because there are two ways to unify base classes of S<0, 1, 2> with S<I, I, I>. If we kept the already deduced knowledge, we would reject the possibility I=1. */ - copy_of_targs = make_tree_vec (TREE_VEC_LENGTH (targs)); + targs = copy_template_args (targs); + for (tree& targ : tree_vec_range (INNERMOST_TEMPLATE_ARGS (targs))) + targ = NULL_TREE; + int err; if (TREE_CODE (parm) == BOUND_TEMPLATE_TEMPLATE_PARM) - { - if (unify_bound_ttp_args (tparms, copy_of_targs, parm, arg, explain_p)) - return NULL_TREE; - return arg; - } + err = unify_bound_ttp_args (tparms, targs, parm, arg, explain_p); + else + err = unify (tparms, targs, CLASSTYPE_TI_ARGS (parm), + CLASSTYPE_TI_ARGS (arg), UNIFY_ALLOW_NONE, explain_p); - /* If unification failed, we're done. */ - if (unify (tparms, copy_of_targs, CLASSTYPE_TI_ARGS (parm), - CLASSTYPE_TI_ARGS (arg), UNIFY_ALLOW_NONE, explain_p)) - return NULL_TREE; + if (TMPL_ARGS_HAVE_MULTIPLE_LEVELS (targs)) + for (tree level : tree_vec_range (targs)) + ggc_free (level); + ggc_free (targs); - return arg; + return err ? NULL_TREE : arg; } /* Given a template type PARM and a class type ARG, find the unique @@ -23649,7 +23649,7 @@ unify_pack_expansion (tree tparms, tree targs, tree packed_parms, /* Determine the index and level of this parameter pack. */ template_parm_level_and_index (parm_pack, &level, &idx); - if (level < levels) + if (level > levels) continue; /* Keep track of the parameter packs and their corresponding diff --git a/gcc/doc/sourcebuild.texi b/gcc/doc/sourcebuild.texi index 3f234d1..c603afd 100644 --- a/gcc/doc/sourcebuild.texi +++ b/gcc/doc/sourcebuild.texi @@ -2425,6 +2425,18 @@ PowerPC target pre-defines macro _ARCH_PWR9 which means the @code{-mcpu} setting is Power9 or later. @end table +@subsection RISC-V specific attributes + +@table @code + +@item rv32 +Test system has an integer register width of 32 bits. + +@item rv64 +Test system has an integer register width of 64 bits. + +@end table + @subsubsection Other hardware attributes @c Please keep this table sorted alphabetically. @@ -3682,6 +3682,16 @@ rest_of_handle_dse (void) dse_step0 (); dse_step1 (); + /* DSE can eliminate potentially-trapping MEMs. + Remove any EH edges associated with them, since otherwise + DF_LR_RUN_DCE will complain later. */ + if ((locally_deleted || globally_deleted) + && cfun->can_throw_non_call_exceptions + && purge_all_dead_edges ()) + { + free_dominance_info (CDI_DOMINATORS); + delete_unreachable_blocks (); + } dse_step2_init (); if (dse_step2 ()) { diff --git a/gcc/expr.cc b/gcc/expr.cc index 5f7142b..1806091 100644 --- a/gcc/expr.cc +++ b/gcc/expr.cc @@ -60,6 +60,7 @@ along with GCC; see the file COPYING3. If not see #include "tree-ssa-address.h" #include "builtins.h" #include "ccmp.h" +#include "gimple-iterator.h" #include "gimple-fold.h" #include "rtx-vector-builder.h" #include "tree-pretty-print.h" diff --git a/gcc/fold-const.cc b/gcc/fold-const.cc index a57ad07..7bf1231 100644 --- a/gcc/fold-const.cc +++ b/gcc/fold-const.cc @@ -70,6 +70,7 @@ along with GCC; see the file COPYING3. If not see #include "tree-dfa.h" #include "builtins.h" #include "generic-match.h" +#include "gimple-iterator.h" #include "gimple-fold.h" #include "tree-into-ssa.h" #include "md5.h" diff --git a/gcc/fold-const.h b/gcc/fold-const.h index a4ff554..fe78a4d 100644 --- a/gcc/fold-const.h +++ b/gcc/fold-const.h @@ -245,6 +245,11 @@ extern tree fold_build_pointer_plus_hwi_loc (location_t loc, tree ptr, HOST_WIDE #define fold_build_pointer_plus_hwi(p,o) \ fold_build_pointer_plus_hwi_loc (UNKNOWN_LOCATION, p, o) +/* In gimple-fold.cc. */ +extern void clear_type_padding_in_mask (tree, unsigned char *); +extern bool clear_padding_type_may_have_padding_p (tree); +extern bool arith_overflowed_p (enum tree_code, const_tree, const_tree, + const_tree); /* Class used to compare gimple operands. */ diff --git a/gcc/fortran/ChangeLog b/gcc/fortran/ChangeLog index 395fad9..b4f2ff8 100644 --- a/gcc/fortran/ChangeLog +++ b/gcc/fortran/ChangeLog @@ -1,3 +1,9 @@ +2022-05-13 Tobias Burnus <tobias@codesourcery.com> + + * trans-openmp.cc (gfc_trans_omp_clauses): When mapping nondescriptor + array sections, use GOMP_MAP_FIRSTPRIVATE_POINTER instead of + GOMP_MAP_POINTER for the pointer attachment. + 2022-05-11 Harald Anlauf <anlauf@gmx.de> Steven G. Kargl <kargl@gcc.gnu.org> diff --git a/gcc/fortran/trans-openmp.cc b/gcc/fortran/trans-openmp.cc index baa45f7..eb5870c 100644 --- a/gcc/fortran/trans-openmp.cc +++ b/gcc/fortran/trans-openmp.cc @@ -3312,9 +3312,15 @@ gfc_trans_omp_clauses (stmtblock_t *block, gfc_omp_clauses *clauses, /* An array element or array section which is not part of a derived type, etc. */ bool element = n->expr->ref->u.ar.type == AR_ELEMENT; - gfc_trans_omp_array_section (block, n, decl, element, - GOMP_MAP_POINTER, node, node2, - node3, node4); + tree type = TREE_TYPE (decl); + gomp_map_kind k = GOMP_MAP_POINTER; + if (!openacc + && !GFC_DESCRIPTOR_TYPE_P (type) + && !(POINTER_TYPE_P (type) + && GFC_DESCRIPTOR_TYPE_P (TREE_TYPE (type)))) + k = GOMP_MAP_FIRSTPRIVATE_POINTER; + gfc_trans_omp_array_section (block, n, decl, element, k, + node, node2, node3, node4); } else if (n->expr && n->expr->expr_type == EXPR_VARIABLE diff --git a/gcc/function-tests.cc b/gcc/function-tests.cc index 7d77615..1f983e8 100644 --- a/gcc/function-tests.cc +++ b/gcc/function-tests.cc @@ -47,6 +47,8 @@ along with GCC; see the file COPYING3. If not see #include "basic-block.h" #include "tree-ssa-alias.h" #include "internal-fn.h" +#include "gimple.h" +#include "gimple-iterator.h" #include "gimple-fold.h" #include "gimple-expr.h" #include "toplev.h" @@ -67,7 +69,6 @@ along with GCC; see the file COPYING3. If not see #include "internal-fn.h" #include "gimple-expr.h" #include "is-a.h" -#include "gimple.h" #include "tree-pass.h" #include "context.h" #include "hash-map.h" diff --git a/gcc/gengtype.cc b/gcc/gengtype.cc index e11da9e..1967625 100644 --- a/gcc/gengtype.cc +++ b/gcc/gengtype.cc @@ -1703,9 +1703,9 @@ open_base_files (void) "alias.h", "insn-config.h", "flags.h", "expmed.h", "dojump.h", "explow.h", "calls.h", "memmodel.h", "emit-rtl.h", "varasm.h", "stmt.h", "expr.h", "alloc-pool.h", "cselib.h", "insn-addr.h", - "optabs.h", "libfuncs.h", "debug.h", "internal-fn.h", "gimple-fold.h", - "value-range.h", - "tree-eh.h", "gimple-iterator.h", "gimple-ssa.h", "tree-cfg.h", + "optabs.h", "libfuncs.h", "debug.h", "internal-fn.h", + "gimple-iterator.h", "gimple-fold.h", "value-range.h", + "tree-eh.h", "gimple-ssa.h", "tree-cfg.h", "tree-vrp.h", "tree-phinodes.h", "ssa-iterators.h", "stringpool.h", "tree-ssanames.h", "tree-ssa-loop.h", "tree-ssa-loop-ivopts.h", "tree-ssa-loop-manip.h", "tree-ssa-loop-niter.h", "tree-into-ssa.h", diff --git a/gcc/gimple-fold.cc b/gcc/gimple-fold.cc index 7baec11..e086b03 100644 --- a/gcc/gimple-fold.cc +++ b/gcc/gimple-fold.cc @@ -37,9 +37,9 @@ along with GCC; see the file COPYING3. If not see #include "expr.h" #include "stor-layout.h" #include "dumpfile.h" +#include "gimple-iterator.h" #include "gimple-fold.h" #include "gimplify.h" -#include "gimple-iterator.h" #include "tree-into-ssa.h" #include "tree-dfa.h" #include "tree-object-size.h" @@ -8669,14 +8669,23 @@ gimple_build_valueize (tree op) /* Build the expression CODE OP0 of type TYPE with location LOC, simplifying it first if possible. Returns the built - expression value and appends statements possibly defining it - to SEQ. */ + expression value and inserts statements possibly defining it + before GSI if BEFORE is true or after GSI if false and advance + the iterator accordingly. + If gsi refers to a basic block simplifying is allowed to look + at all SSA defs while when it does not it is restricted to + SSA defs that are not associated with a basic block yet, + indicating they belong to the currently building sequence. */ tree -gimple_build (gimple_seq *seq, location_t loc, - enum tree_code code, tree type, tree op0) +gimple_build (gimple_stmt_iterator *gsi, + bool before, gsi_iterator_update update, + location_t loc, enum tree_code code, tree type, tree op0) { - tree res = gimple_simplify (code, type, op0, seq, gimple_build_valueize); + gimple_seq seq = NULL; + tree res + = gimple_simplify (code, type, op0, &seq, + gsi->bb ? follow_all_ssa_edges : gimple_build_valueize); if (!res) { res = create_tmp_reg_or_ssa_name (type); @@ -8688,7 +8697,21 @@ gimple_build (gimple_seq *seq, location_t loc, else stmt = gimple_build_assign (res, code, op0); gimple_set_location (stmt, loc); - gimple_seq_add_stmt_without_update (seq, stmt); + gimple_seq_add_stmt_without_update (&seq, stmt); + } + if (before) + { + if (gsi->bb) + gsi_insert_seq_before (gsi, seq, update); + else + gsi_insert_seq_before_without_update (gsi, seq, update); + } + else + { + if (gsi->bb) + gsi_insert_seq_after (gsi, seq, update); + else + gsi_insert_seq_after_without_update (gsi, seq, update); } return res; } @@ -8699,16 +8722,35 @@ gimple_build (gimple_seq *seq, location_t loc, to SEQ. */ tree -gimple_build (gimple_seq *seq, location_t loc, - enum tree_code code, tree type, tree op0, tree op1) +gimple_build (gimple_stmt_iterator *gsi, + bool before, gsi_iterator_update update, + location_t loc, enum tree_code code, tree type, + tree op0, tree op1) { - tree res = gimple_simplify (code, type, op0, op1, seq, gimple_build_valueize); + gimple_seq seq = NULL; + tree res + = gimple_simplify (code, type, op0, op1, &seq, + gsi->bb ? follow_all_ssa_edges : gimple_build_valueize); if (!res) { res = create_tmp_reg_or_ssa_name (type); gimple *stmt = gimple_build_assign (res, code, op0, op1); gimple_set_location (stmt, loc); - gimple_seq_add_stmt_without_update (seq, stmt); + gimple_seq_add_stmt_without_update (&seq, stmt); + } + if (before) + { + if (gsi->bb) + gsi_insert_seq_before (gsi, seq, update); + else + gsi_insert_seq_before_without_update (gsi, seq, update); + } + else + { + if (gsi->bb) + gsi_insert_seq_after (gsi, seq, update); + else + gsi_insert_seq_after_without_update (gsi, seq, update); } return res; } @@ -8719,11 +8761,16 @@ gimple_build (gimple_seq *seq, location_t loc, to SEQ. */ tree -gimple_build (gimple_seq *seq, location_t loc, - enum tree_code code, tree type, tree op0, tree op1, tree op2) +gimple_build (gimple_stmt_iterator *gsi, + bool before, gsi_iterator_update update, + location_t loc, enum tree_code code, tree type, + tree op0, tree op1, tree op2) { - tree res = gimple_simplify (code, type, op0, op1, op2, - seq, gimple_build_valueize); + + gimple_seq seq = NULL; + tree res + = gimple_simplify (code, type, op0, op1, op2, &seq, + gsi->bb ? follow_all_ssa_edges : gimple_build_valueize); if (!res) { res = create_tmp_reg_or_ssa_name (type); @@ -8734,7 +8781,21 @@ gimple_build (gimple_seq *seq, location_t loc, else stmt = gimple_build_assign (res, code, op0, op1, op2); gimple_set_location (stmt, loc); - gimple_seq_add_stmt_without_update (seq, stmt); + gimple_seq_add_stmt_without_update (&seq, stmt); + } + if (before) + { + if (gsi->bb) + gsi_insert_seq_before (gsi, seq, update); + else + gsi_insert_seq_before_without_update (gsi, seq, update); + } + else + { + if (gsi->bb) + gsi_insert_seq_after (gsi, seq, update); + else + gsi_insert_seq_after_without_update (gsi, seq, update); } return res; } diff --git a/gcc/gimple-fold.h b/gcc/gimple-fold.h index 850f917..520fde8 100644 --- a/gcc/gimple-fold.h +++ b/gcc/gimple-fold.h @@ -38,12 +38,8 @@ extern tree maybe_fold_and_comparisons (tree, enum tree_code, tree, tree, extern tree maybe_fold_or_comparisons (tree, enum tree_code, tree, tree, enum tree_code, tree, tree, basic_block = nullptr); -extern bool clear_padding_type_may_have_padding_p (tree); -extern void clear_type_padding_in_mask (tree, unsigned char *); extern bool optimize_atomic_compare_exchange_p (gimple *); extern void fold_builtin_atomic_compare_exchange (gimple_stmt_iterator *); -extern bool arith_overflowed_p (enum tree_code, const_tree, const_tree, - const_tree); extern tree no_follow_ssa_edges (tree); extern tree follow_single_use_edges (tree); extern tree follow_all_ssa_edges (tree); @@ -71,19 +67,35 @@ extern tree tree_vec_extract (gimple_stmt_iterator *, tree, tree, tree, tree); /* gimple_build, functionally matching fold_buildN, outputs stmts int the provided sequence, matching and simplifying them on-the-fly. Supposed to replace force_gimple_operand (fold_buildN (...), ...). */ -extern tree gimple_build (gimple_seq *, location_t, - enum tree_code, tree, tree); -extern tree gimple_build (gimple_seq *, location_t, - enum tree_code, tree, tree, tree); -extern tree gimple_build (gimple_seq *, location_t, - enum tree_code, tree, tree, tree, tree); +extern tree gimple_build (gimple_stmt_iterator *, bool, + enum gsi_iterator_update, + location_t, enum tree_code, tree, tree); +extern tree gimple_build (gimple_stmt_iterator *, bool, + enum gsi_iterator_update, + location_t, enum tree_code, tree, tree, tree); +extern tree gimple_build (gimple_stmt_iterator *, bool, + enum gsi_iterator_update, + location_t, enum tree_code, tree, tree, tree, tree); +template<class ...Args> +inline tree +gimple_build (gimple_seq *seq, location_t loc, + enum tree_code code, tree type, Args ...ops) +{ + static_assert (sizeof...(ops) > 0 && sizeof...(ops) <= 3, + "Number of operands must be from one to three"); + gimple_stmt_iterator gsi = gsi_last (*seq); + return gimple_build (&gsi, false, GSI_CONTINUE_LINKING, + loc, code, type, ops...); +} template<class ...Args> inline tree gimple_build (gimple_seq *seq, enum tree_code code, tree type, Args ...ops) { static_assert (sizeof...(ops) > 0 && sizeof...(ops) <= 3, "Number of operands must be from one to three"); - return gimple_build (seq, UNKNOWN_LOCATION, code, type, ops...); + gimple_stmt_iterator gsi = gsi_last (*seq); + return gimple_build (&gsi, false, GSI_CONTINUE_LINKING, + UNKNOWN_LOCATION, code, type, ops...); } extern tree gimple_build (gimple_seq *, location_t, combined_fn, tree); diff --git a/gcc/gimple-harden-conditionals.cc b/gcc/gimple-harden-conditionals.cc index c7e5e07..79c0a57 100644 --- a/gcc/gimple-harden-conditionals.cc +++ b/gcc/gimple-harden-conditionals.cc @@ -36,6 +36,7 @@ along with GCC; see the file COPYING3. If not see #include "cfghooks.h" #include "cfgloop.h" #include "tree-eh.h" +#include "sbitmap.h" #include "diagnostic.h" #include "intl.h" @@ -254,8 +255,10 @@ insert_check_and_trap (location_t loc, gimple_stmt_iterator *gsip, equality. */ single_succ_edge (chk)->flags &= ~EDGE_FALLTHRU; single_succ_edge (chk)->flags |= neg_true_false_flag; + single_succ_edge (chk)->probability = profile_probability::always (); edge e = make_edge (chk, trp, true_false_flag); e->goto_locus = loc; + e->probability = profile_probability::never (); if (dom_info_available_p (CDI_DOMINATORS)) set_immediate_dominator (CDI_DOMINATORS, trp, chk); @@ -301,9 +304,21 @@ insert_edge_check_and_trap (location_t loc, edge e, unsigned int pass_harden_conditional_branches::execute (function *fun) { + /* Record the preexisting blocks, to avoid visiting newly-created + blocks. */ + auto_sbitmap to_visit (last_basic_block_for_fn (fun)); + bitmap_clear (to_visit); + basic_block bb; - FOR_EACH_BB_REVERSE_FN (bb, fun) + FOR_EACH_BB_FN (bb, fun) + bitmap_set_bit (to_visit, bb->index); + + sbitmap_iterator it; + unsigned i; + EXECUTE_IF_SET_IN_BITMAP (to_visit, 0, i, it) { + bb = BASIC_BLOCK_FOR_FN (fun, i); + gimple_stmt_iterator gsi = gsi_last_bb (bb); if (gsi_end_p (gsi)) @@ -383,205 +398,215 @@ non_eh_succ_edge (basic_block bb, edge *ehp = NULL) unsigned int pass_harden_compares::execute (function *fun) { + /* Record the preexisting blocks, to avoid visiting newly-created + blocks. */ + auto_sbitmap to_visit (last_basic_block_for_fn (fun)); + bitmap_clear (to_visit); + basic_block bb; - /* Go backwards over BBs and stmts, so that, even if we split the - block multiple times to insert a cond_expr after each compare we - find, we remain in the same block, visiting every preexisting - stmt exactly once, and not visiting newly-added blocks or - stmts. */ - FOR_EACH_BB_REVERSE_FN (bb, fun) - for (gimple_stmt_iterator gsi = gsi_last_bb (bb); - !gsi_end_p (gsi); gsi_prev (&gsi)) - { - gassign *asgn = dyn_cast <gassign *> (gsi_stmt (gsi)); - if (!asgn) - continue; - - /* Turn: - - z = x op y; - - into: - - z = x op y; - z' = x' cop y'; - if (z == z') __builtin_trap (); - - where cop is a complementary boolean operation to op; and x' - and y' hold the same value as x and y, but in a way that does - not enable the compiler to optimize the redundant compare - away. - */ - - enum tree_code op = gimple_assign_rhs_code (asgn); - - enum tree_code cop; - - switch (op) - { - case EQ_EXPR: - case NE_EXPR: - case GT_EXPR: - case GE_EXPR: - case LT_EXPR: - case LE_EXPR: - case LTGT_EXPR: - case UNEQ_EXPR: - case UNGT_EXPR: - case UNGE_EXPR: - case UNLT_EXPR: - case UNLE_EXPR: - case ORDERED_EXPR: - case UNORDERED_EXPR: - cop = invert_tree_comparison (op, - HONOR_NANS - (gimple_assign_rhs1 (asgn))); - - if (cop == ERROR_MARK) - /* ??? Can we do better? */ - continue; + FOR_EACH_BB_FN (bb, fun) + bitmap_set_bit (to_visit, bb->index); + + sbitmap_iterator it; + unsigned i; + EXECUTE_IF_SET_IN_BITMAP (to_visit, 0, i, it) + { + bb = BASIC_BLOCK_FOR_FN (fun, i); - break; - - /* ??? Maybe handle these too? */ - case TRUTH_NOT_EXPR: - /* ??? The code below assumes binary ops, it would have to - be adjusted for TRUTH_NOT_EXPR, since it's unary. */ - case TRUTH_ANDIF_EXPR: - case TRUTH_ORIF_EXPR: - case TRUTH_AND_EXPR: - case TRUTH_OR_EXPR: - case TRUTH_XOR_EXPR: - default: + for (gimple_stmt_iterator gsi = gsi_last_bb (bb); + !gsi_end_p (gsi); gsi_prev (&gsi)) + { + gassign *asgn = dyn_cast <gassign *> (gsi_stmt (gsi)); + if (!asgn) + continue; + + /* Turn: + + z = x op y; + + into: + + z = x op y; + z' = x' cop y'; + if (z == z') __builtin_trap (); + + where cop is a complementary boolean operation to op; and x' + and y' hold the same value as x and y, but in a way that does + not enable the compiler to optimize the redundant compare + away. + */ + + enum tree_code op = gimple_assign_rhs_code (asgn); + + enum tree_code cop; + + switch (op) + { + case EQ_EXPR: + case NE_EXPR: + case GT_EXPR: + case GE_EXPR: + case LT_EXPR: + case LE_EXPR: + case LTGT_EXPR: + case UNEQ_EXPR: + case UNGT_EXPR: + case UNGE_EXPR: + case UNLT_EXPR: + case UNLE_EXPR: + case ORDERED_EXPR: + case UNORDERED_EXPR: + cop = invert_tree_comparison (op, + HONOR_NANS + (gimple_assign_rhs1 (asgn))); + + if (cop == ERROR_MARK) + /* ??? Can we do better? */ + continue; + + break; + + /* ??? Maybe handle these too? */ + case TRUTH_NOT_EXPR: + /* ??? The code below assumes binary ops, it would have to + be adjusted for TRUTH_NOT_EXPR, since it's unary. */ + case TRUTH_ANDIF_EXPR: + case TRUTH_ORIF_EXPR: + case TRUTH_AND_EXPR: + case TRUTH_OR_EXPR: + case TRUTH_XOR_EXPR: + default: + continue; + } + + /* These are the operands for the verification. */ + tree lhs = gimple_assign_lhs (asgn); + tree op1 = gimple_assign_rhs1 (asgn); + tree op2 = gimple_assign_rhs2 (asgn); + location_t loc = gimple_location (asgn); + + /* Vector booleans can't be used in conditional branches. ??? + Can we do better? How to reduce compare and + reversed-compare result vectors to a single boolean? */ + if (VECTOR_TYPE_P (TREE_TYPE (op1))) continue; - } - - /* These are the operands for the verification. */ - tree lhs = gimple_assign_lhs (asgn); - tree op1 = gimple_assign_rhs1 (asgn); - tree op2 = gimple_assign_rhs2 (asgn); - location_t loc = gimple_location (asgn); - - /* Vector booleans can't be used in conditional branches. ??? - Can we do better? How to reduce compare and - reversed-compare result vectors to a single boolean? */ - if (VECTOR_TYPE_P (TREE_TYPE (op1))) - continue; - - /* useless_type_conversion_p enables conversions from 1-bit - integer types to boolean to be discarded. */ - gcc_checking_assert (TREE_CODE (TREE_TYPE (lhs)) == BOOLEAN_TYPE - || (INTEGRAL_TYPE_P (TREE_TYPE (lhs)) - && TYPE_PRECISION (TREE_TYPE (lhs)) == 1)); - - tree rhs = copy_ssa_name (lhs); - - gimple_stmt_iterator gsi_split = gsi; - /* Don't separate the original assignment from debug stmts - that might be associated with it, and arrange to split the - block after debug stmts, so as to make sure the split block - won't be debug stmts only. */ - gsi_next_nondebug (&gsi_split); - - bool throwing_compare_p = stmt_ends_bb_p (asgn); - if (throwing_compare_p) - { - basic_block nbb = split_edge (non_eh_succ_edge - (gimple_bb (asgn))); - gsi_split = gsi_start_bb (nbb); - - if (dump_file) - fprintf (dump_file, - "Splitting non-EH edge from block %i into %i" - " after a throwing compare\n", - gimple_bb (asgn)->index, nbb->index); - } - - bool same_p = (op1 == op2); - op1 = detach_value (loc, &gsi_split, op1); - op2 = same_p ? op1 : detach_value (loc, &gsi_split, op2); - - gassign *asgnck = gimple_build_assign (rhs, cop, op1, op2); - gimple_set_location (asgnck, loc); - gsi_insert_before (&gsi_split, asgnck, GSI_SAME_STMT); - - /* We wish to insert a cond_expr after the compare, so arrange - for it to be at the end of a block if it isn't, and for it - to have a single successor in case there's more than - one, as in PR104975. */ - if (!gsi_end_p (gsi_split) - || !single_succ_p (gsi_bb (gsi_split))) - { - if (!gsi_end_p (gsi_split)) - gsi_prev (&gsi_split); - else - gsi_split = gsi_last_bb (gsi_bb (gsi_split)); - basic_block obb = gsi_bb (gsi_split); - basic_block nbb = split_block (obb, gsi_stmt (gsi_split))->dest; - gsi_next (&gsi_split); - gcc_checking_assert (gsi_end_p (gsi_split)); - - single_succ_edge (bb)->goto_locus = loc; - - if (dump_file) - fprintf (dump_file, - "Splitting block %i into %i" - " before the conditional trap branch\n", - obb->index, nbb->index); - } - - /* If the check assignment must end a basic block, we can't - insert the conditional branch in the same block, so split - the block again, and prepare to insert the conditional - branch in the new block. - - Also assign an EH region to the compare. Even though it's - unlikely that the hardening compare will throw after the - original compare didn't, the compiler won't even know that - it's the same compare operands, so add the EH edge anyway. */ - if (throwing_compare_p) - { - add_stmt_to_eh_lp (asgnck, lookup_stmt_eh_lp (asgn)); - make_eh_edges (asgnck); - - edge ckeh; - basic_block nbb = split_edge (non_eh_succ_edge - (gimple_bb (asgnck), &ckeh)); - gsi_split = gsi_start_bb (nbb); - - if (dump_file) - fprintf (dump_file, - "Splitting non-EH edge from block %i into %i after" - " the newly-inserted reversed throwing compare\n", - gimple_bb (asgnck)->index, nbb->index); - - if (!gimple_seq_empty_p (phi_nodes (ckeh->dest))) - { - edge aseh; - non_eh_succ_edge (gimple_bb (asgn), &aseh); - - gcc_checking_assert (aseh->dest == ckeh->dest); - - for (gphi_iterator psi = gsi_start_phis (ckeh->dest); - !gsi_end_p (psi); gsi_next (&psi)) - { - gphi *phi = psi.phi (); - add_phi_arg (phi, PHI_ARG_DEF_FROM_EDGE (phi, aseh), ckeh, - gimple_phi_arg_location_from_edge (phi, aseh)); - } - - if (dump_file) - fprintf (dump_file, - "Copying PHI args in EH block %i from %i to %i\n", - aseh->dest->index, aseh->src->index, ckeh->src->index); - } - } - - gcc_checking_assert (single_succ_p (gsi_bb (gsi_split))); - - insert_check_and_trap (loc, &gsi_split, EDGE_TRUE_VALUE, - EQ_EXPR, lhs, rhs); - } + + /* useless_type_conversion_p enables conversions from 1-bit + integer types to boolean to be discarded. */ + gcc_checking_assert (TREE_CODE (TREE_TYPE (lhs)) == BOOLEAN_TYPE + || (INTEGRAL_TYPE_P (TREE_TYPE (lhs)) + && TYPE_PRECISION (TREE_TYPE (lhs)) == 1)); + + tree rhs = copy_ssa_name (lhs); + + gimple_stmt_iterator gsi_split = gsi; + /* Don't separate the original assignment from debug stmts + that might be associated with it, and arrange to split the + block after debug stmts, so as to make sure the split block + won't be debug stmts only. */ + gsi_next_nondebug (&gsi_split); + + bool throwing_compare_p = stmt_ends_bb_p (asgn); + if (throwing_compare_p) + { + basic_block nbb = split_edge (non_eh_succ_edge + (gimple_bb (asgn))); + gsi_split = gsi_start_bb (nbb); + + if (dump_file) + fprintf (dump_file, + "Splitting non-EH edge from block %i into %i" + " after a throwing compare\n", + gimple_bb (asgn)->index, nbb->index); + } + + bool same_p = (op1 == op2); + op1 = detach_value (loc, &gsi_split, op1); + op2 = same_p ? op1 : detach_value (loc, &gsi_split, op2); + + gassign *asgnck = gimple_build_assign (rhs, cop, op1, op2); + gimple_set_location (asgnck, loc); + gsi_insert_before (&gsi_split, asgnck, GSI_SAME_STMT); + + /* We wish to insert a cond_expr after the compare, so arrange + for it to be at the end of a block if it isn't, and for it + to have a single successor in case there's more than + one, as in PR104975. */ + if (!gsi_end_p (gsi_split) + || !single_succ_p (gsi_bb (gsi_split))) + { + if (!gsi_end_p (gsi_split)) + gsi_prev (&gsi_split); + else + gsi_split = gsi_last_bb (gsi_bb (gsi_split)); + basic_block obb = gsi_bb (gsi_split); + basic_block nbb = split_block (obb, gsi_stmt (gsi_split))->dest; + gsi_next (&gsi_split); + gcc_checking_assert (gsi_end_p (gsi_split)); + + single_succ_edge (bb)->goto_locus = loc; + + if (dump_file) + fprintf (dump_file, + "Splitting block %i into %i" + " before the conditional trap branch\n", + obb->index, nbb->index); + } + + /* If the check assignment must end a basic block, we can't + insert the conditional branch in the same block, so split + the block again, and prepare to insert the conditional + branch in the new block. + + Also assign an EH region to the compare. Even though it's + unlikely that the hardening compare will throw after the + original compare didn't, the compiler won't even know that + it's the same compare operands, so add the EH edge anyway. */ + if (throwing_compare_p) + { + add_stmt_to_eh_lp (asgnck, lookup_stmt_eh_lp (asgn)); + make_eh_edges (asgnck); + + edge ckeh; + basic_block nbb = split_edge (non_eh_succ_edge + (gimple_bb (asgnck), &ckeh)); + gsi_split = gsi_start_bb (nbb); + + if (dump_file) + fprintf (dump_file, + "Splitting non-EH edge from block %i into %i after" + " the newly-inserted reversed throwing compare\n", + gimple_bb (asgnck)->index, nbb->index); + + if (!gimple_seq_empty_p (phi_nodes (ckeh->dest))) + { + edge aseh; + non_eh_succ_edge (gimple_bb (asgn), &aseh); + + gcc_checking_assert (aseh->dest == ckeh->dest); + + for (gphi_iterator psi = gsi_start_phis (ckeh->dest); + !gsi_end_p (psi); gsi_next (&psi)) + { + gphi *phi = psi.phi (); + add_phi_arg (phi, PHI_ARG_DEF_FROM_EDGE (phi, aseh), ckeh, + gimple_phi_arg_location_from_edge (phi, aseh)); + } + + if (dump_file) + fprintf (dump_file, + "Copying PHI args in EH block %i from %i to %i\n", + aseh->dest->index, aseh->src->index, + ckeh->src->index); + } + } + + gcc_checking_assert (single_succ_p (gsi_bb (gsi_split))); + + insert_check_and_trap (loc, &gsi_split, EDGE_TRUE_VALUE, + EQ_EXPR, lhs, rhs); + } + } return 0; } diff --git a/gcc/gimple-match-head.cc b/gcc/gimple-match-head.cc index 1c74d38..4c80d77 100644 --- a/gcc/gimple-match-head.cc +++ b/gcc/gimple-match-head.cc @@ -31,6 +31,7 @@ along with GCC; see the file COPYING3. If not see #include "fold-const.h" #include "fold-const-call.h" #include "stor-layout.h" +#include "gimple-iterator.h" #include "gimple-fold.h" #include "calls.h" #include "tree-dfa.h" diff --git a/gcc/gimple-range-cache.cc b/gcc/gimple-range-cache.cc index 421ea1a..d3cf8be 100644 --- a/gcc/gimple-range-cache.cc +++ b/gcc/gimple-range-cache.cc @@ -864,6 +864,7 @@ ranger_cache::ranger_cache (int not_executable_flag) { m_workback.create (0); m_workback.safe_grow_cleared (last_basic_block_for_fn (cfun)); + m_workback.truncate (0); m_temporal = new temporal_cache; // If DOM info is available, spawn an oracle as well. if (dom_info_available_p (CDI_DOMINATORS)) @@ -950,7 +951,7 @@ ranger_cache::get_global_range (irange &r, tree name, bool ¤t_p) // If the existing value was not current, mark it as always current. if (!current_p) m_temporal->set_always_current (name); - return current_p; + return had_global; } // Set the global range of NAME to R and give it a timestamp. @@ -1008,10 +1009,12 @@ ranger_cache::range_of_def (irange &r, tree name, basic_block bb) } } -// Get the range of NAME as it occurs on entry to block BB. +// Get the range of NAME as it occurs on entry to block BB. Use MODE for +// lookups. void -ranger_cache::entry_range (irange &r, tree name, basic_block bb) +ranger_cache::entry_range (irange &r, tree name, basic_block bb, + enum rfd_mode mode) { if (bb == ENTRY_BLOCK_PTR_FOR_FN (cfun)) { @@ -1022,13 +1025,16 @@ ranger_cache::entry_range (irange &r, tree name, basic_block bb) // Look for the on-entry value of name in BB from the cache. // Otherwise pick up the best available global value. if (!m_on_entry.get_bb_range (r, name, bb)) - range_of_def (r, name); + if (!range_from_dom (r, name, bb, mode)) + range_of_def (r, name); } -// Get the range of NAME as it occurs on exit from block BB. +// Get the range of NAME as it occurs on exit from block BB. Use MODE for +// lookups. void -ranger_cache::exit_range (irange &r, tree name, basic_block bb) +ranger_cache::exit_range (irange &r, tree name, basic_block bb, + enum rfd_mode mode) { if (bb == ENTRY_BLOCK_PTR_FOR_FN (cfun)) { @@ -1041,8 +1047,25 @@ ranger_cache::exit_range (irange &r, tree name, basic_block bb) if (def_bb == bb) range_of_def (r, name, bb); else - entry_range (r, name, bb); - } + entry_range (r, name, bb, mode); +} + +// Get the range of NAME on edge E using MODE, return the result in R. +// Always returns a range and true. + +bool +ranger_cache::edge_range (irange &r, edge e, tree name, enum rfd_mode mode) +{ + exit_range (r, name, e->src, mode); + // If this is not an abnormal edge, check for a non-null exit. + if ((e->flags & (EDGE_EH | EDGE_ABNORMAL)) == 0) + m_non_null.adjust_range (r, name, e->src, false); + int_range_max er; + if (m_gori.outgoing_edge_range_p (er, e, name, *this)) + r.intersect (er); + return true; +} + // Implement range_of_expr. @@ -1063,32 +1086,22 @@ ranger_cache::range_of_expr (irange &r, tree name, gimple *stmt) if (bb == def_bb) range_of_def (r, name, bb); else - entry_range (r, name, bb); + entry_range (r, name, bb, RFD_NONE); return true; } -// Implement range_on_edge. Always return the best available range. - - bool - ranger_cache::range_on_edge (irange &r, edge e, tree expr) - { - if (gimple_range_ssa_p (expr)) - { - exit_range (r, expr, e->src); - // If this is not an abnormal edge, check for a non-null exit. - if ((e->flags & (EDGE_EH | EDGE_ABNORMAL)) == 0) - m_non_null.adjust_range (r, expr, e->src, false); - int_range_max edge_range; - if (m_gori.outgoing_edge_range_p (edge_range, e, expr, *this)) - r.intersect (edge_range); - return true; - } +// Implement range_on_edge. Always return the best available range using +// the current cache values. +bool +ranger_cache::range_on_edge (irange &r, edge e, tree expr) +{ + if (gimple_range_ssa_p (expr)) + return edge_range (r, e, expr, RFD_NONE); return get_tree_range (r, expr, NULL); } - // Return a static range for NAME on entry to basic block BB in R. If // calc is true, fill any cache entries required between BB and the // def block for NAME. Otherwise, return false if the cache is empty. @@ -1281,20 +1294,12 @@ ranger_cache::fill_block_cache (tree name, basic_block bb, basic_block def_bb) // At this point we shouldn't be looking at the def, entry or exit block. gcc_checking_assert (bb != def_bb && bb != ENTRY_BLOCK_PTR_FOR_FN (cfun) && bb != EXIT_BLOCK_PTR_FOR_FN (cfun)); + gcc_checking_assert (m_workback.length () == 0); // If the block cache is set, then we've already visited this block. if (m_on_entry.bb_range_p (name, bb)) return; - // Visit each block back to the DEF. Initialize each one to UNDEFINED. - // m_visited at the end will contain all the blocks that we needed to set - // the range_on_entry cache for. - m_workback.truncate (0); - m_workback.quick_push (bb); - undefined.set_undefined (); - m_on_entry.set_bb_range (name, bb, undefined); - gcc_checking_assert (m_update->empty_p ()); - if (DEBUG_RANGE_CACHE) { fprintf (dump_file, "\n"); @@ -1302,9 +1307,8 @@ ranger_cache::fill_block_cache (tree name, basic_block bb, basic_block def_bb) fprintf (dump_file, " : "); } - // If there are dominators, check if a dominators can supply the range. - if (dom_info_available_p (CDI_DOMINATORS) - && range_from_dom (block_result, name, bb)) + // Check if a dominators can supply the range. + if (range_from_dom (block_result, name, bb, RFD_FILL)) { m_on_entry.set_bb_range (name, bb, block_result); if (DEBUG_RANGE_CACHE) @@ -1313,9 +1317,18 @@ ranger_cache::fill_block_cache (tree name, basic_block bb, basic_block def_bb) block_result.dump (dump_file); fprintf (dump_file, "\n"); } + gcc_checking_assert (m_workback.length () == 0); return; } + // Visit each block back to the DEF. Initialize each one to UNDEFINED. + // m_visited at the end will contain all the blocks that we needed to set + // the range_on_entry cache for. + m_workback.quick_push (bb); + undefined.set_undefined (); + m_on_entry.set_bb_range (name, bb, undefined); + gcc_checking_assert (m_update->empty_p ()); + while (m_workback.length () > 0) { basic_block node = m_workback.pop (); @@ -1399,12 +1412,14 @@ ranger_cache::fill_block_cache (tree name, basic_block bb, basic_block def_bb) } -// Get the range of NAME from dominators of BB and return it in R. +// Get the range of NAME from dominators of BB and return it in R. Search the +// dominator tree based on MODE. bool -ranger_cache::range_from_dom (irange &r, tree name, basic_block start_bb) +ranger_cache::range_from_dom (irange &r, tree name, basic_block start_bb, + enum rfd_mode mode) { - if (!dom_info_available_p (CDI_DOMINATORS)) + if (mode == RFD_NONE || !dom_info_available_p (CDI_DOMINATORS)) return false; // Search back to the definition block or entry block. @@ -1419,7 +1434,7 @@ ranger_cache::range_from_dom (irange &r, tree name, basic_block start_bb) // Range on entry to the DEF block should not be queried. gcc_checking_assert (start_bb != def_bb); - m_workback.truncate (0); + unsigned start_limit = m_workback.length (); // Default value is global range. get_global_range (r, name); @@ -1436,10 +1451,36 @@ ranger_cache::range_from_dom (irange &r, tree name, basic_block start_bb) if (m_gori.has_edge_range_p (name, bb)) { // Only outgoing ranges to single_pred blocks are dominated by - // outgoing edge ranges, so only those need to be considered. + // outgoing edge ranges, so those can be simply adjusted on the fly. edge e = find_edge (bb, prev_bb); if (e && single_pred_p (prev_bb)) m_workback.quick_push (prev_bb); + else if (mode == RFD_FILL) + { + // Multiple incoming edges, so recursively satisfy this block, + // store the range, then calculate the incoming range for PREV_BB. + if (def_bb != bb) + { + range_from_dom (r, name, bb, RFD_FILL); + // If the range can't be store, don't try to accumulate + // the range in PREV_BB due to excessive recalculations. + if (!m_on_entry.set_bb_range (name, bb, r)) + break; + } + // With the dominator set, we should be able to cheaply query + // each incoming edge now and accumulate the results. + r.set_undefined (); + edge_iterator ei; + int_range_max er; + FOR_EACH_EDGE (e, ei, prev_bb->preds) + { + edge_range (er, e, name, RFD_READ_ONLY); + r.union_ (er); + } + // Set the cache in PREV_BB so it is not calculated again. + m_on_entry.set_bb_range (name, prev_bb, r); + break; + } } if (def_bb == bb) @@ -1460,16 +1501,16 @@ ranger_cache::range_from_dom (irange &r, tree name, basic_block start_bb) } // Now process any outgoing edges that we seen along the way. - while (m_workback.length () > 0) + while (m_workback.length () > start_limit) { - int_range_max edge_range; + int_range_max er; prev_bb = m_workback.pop (); edge e = single_pred_edge (prev_bb); bb = e->src; - if (m_gori.outgoing_edge_range_p (edge_range, e, name, *this)) + if (m_gori.outgoing_edge_range_p (er, e, name, *this)) { - r.intersect (edge_range); + r.intersect (er); if (r.varying_p () && ((e->flags & (EDGE_EH | EDGE_ABNORMAL)) == 0)) { if (m_non_null.non_null_deref_p (name, bb, false)) @@ -1518,7 +1559,7 @@ ranger_cache::update_to_nonnull (basic_block bb, tree name) // Update the on-entry cache for BB to be non-zero. Note this can set // the on entry value in the DEF block, which can override the def. int_range_max r; - exit_range (r, name, bb); + exit_range (r, name, bb, RFD_READ_ONLY); if (r.varying_p ()) { r.set_nonzero (type); diff --git a/gcc/gimple-range-cache.h b/gcc/gimple-range-cache.h index a0244e4..560403b 100644 --- a/gcc/gimple-range-cache.h +++ b/gcc/gimple-range-cache.h @@ -129,7 +129,6 @@ public: virtual bool range_of_expr (irange &r, tree name, gimple *stmt); virtual bool range_on_edge (irange &r, edge e, tree expr); bool block_range (irange &r, basic_block bb, tree name, bool calc = true); - bool range_from_dom (irange &r, tree name, basic_block bb); bool get_global_range (irange &r, tree name) const; bool get_global_range (irange &r, tree name, bool ¤t_p); @@ -151,9 +150,17 @@ private: void fill_block_cache (tree name, basic_block bb, basic_block def_bb); void propagate_cache (tree name); + enum rfd_mode + { + RFD_NONE, // Only look at current block cache. + RFD_READ_ONLY, // Scan DOM tree, do not write to cache. + RFD_FILL // Scan DOM tree, updating important nodes. + }; + bool range_from_dom (irange &r, tree name, basic_block bb, enum rfd_mode); void range_of_def (irange &r, tree name, basic_block bb = NULL); - void entry_range (irange &r, tree expr, basic_block bb); - void exit_range (irange &r, tree expr, basic_block bb); + void entry_range (irange &r, tree expr, basic_block bb, enum rfd_mode); + void exit_range (irange &r, tree expr, basic_block bb, enum rfd_mode); + bool edge_range (irange &r, edge e, tree name, enum rfd_mode); vec<basic_block> m_workback; class update_list *m_update; diff --git a/gcc/gimple-range-edge.cc b/gcc/gimple-range-edge.cc index 6caa07c..0bee38b 100644 --- a/gcc/gimple-range-edge.cc +++ b/gcc/gimple-range-edge.cc @@ -154,7 +154,9 @@ gimple_outgoing_range::calc_switch_ranges (gswitch *sw) irange *&slot = m_edge_table->get_or_insert (e, &existed); if (existed) { - case_range.union_ (*slot); + // If this doesn't change the value, move on. + if (!case_range.union_ (*slot)) + continue; if (slot->fits_p (case_range)) { *slot = case_range; diff --git a/gcc/gimple-range-fold.cc b/gcc/gimple-range-fold.cc index 3169e29..5f1b3b9 100644 --- a/gcc/gimple-range-fold.cc +++ b/gcc/gimple-range-fold.cc @@ -29,6 +29,7 @@ along with GCC; see the file COPYING3. If not see #include "ssa.h" #include "gimple-pretty-print.h" #include "optabs-tree.h" +#include "gimple-iterator.h" #include "gimple-fold.h" #include "wide-int.h" #include "fold-const.h" @@ -79,7 +80,7 @@ relation_kind fur_source::query_relation (tree op1 ATTRIBUTE_UNUSED, tree op2 ATTRIBUTE_UNUSED) { - return VREL_NONE; + return VREL_VARYING; } // Default registers nothing. @@ -612,14 +613,14 @@ fold_using_range::range_of_range_op (irange &r, gimple *s, fur_source &src) src.gori ()->register_dependency (lhs, op1); relation_kind rel; rel = handler->lhs_op1_relation (r, range1, range1); - if (rel != VREL_NONE) + if (rel != VREL_VARYING) src.register_relation (s, rel, lhs, op1); } } else if (src.get_operand (range2, op2)) { relation_kind rel = src.query_relation (op1, op2); - if (dump_file && (dump_flags & TDF_DETAILS) && rel != VREL_NONE) + if (dump_file && (dump_flags & TDF_DETAILS) && rel != VREL_VARYING) { fprintf (dump_file, " folding with relation "); print_generic_expr (dump_file, op1, TDF_SLIM); @@ -639,14 +640,14 @@ fold_using_range::range_of_range_op (irange &r, gimple *s, fur_source &src) } if (gimple_range_ssa_p (op1)) { - rel = handler->lhs_op1_relation (r, range1, range2); - if (rel != VREL_NONE) + rel = handler->lhs_op1_relation (r, range1, range2, rel); + if (rel != VREL_VARYING) src.register_relation (s, rel, lhs, op1); } if (gimple_range_ssa_p (op2)) { - rel= handler->lhs_op2_relation (r, range1, range2); - if (rel != VREL_NONE) + rel= handler->lhs_op2_relation (r, range1, range2, rel); + if (rel != VREL_VARYING) src.register_relation (s, rel, lhs, op2); } } @@ -803,7 +804,7 @@ fold_using_range::range_of_phi (irange &r, gphi *phi, fur_source &src) // Likewise, if the incoming PHI argument is equivalent to this // PHI definition, it provides no new info. Accumulate these ranges // in case all arguments are equivalences. - if (src.query ()->query_relation (e, arg, phi_def, false) == EQ_EXPR) + if (src.query ()->query_relation (e, arg, phi_def, false) == VREL_EQ) equiv_range.union_(arg_range); else r.union_ (arg_range); @@ -836,7 +837,7 @@ fold_using_range::range_of_phi (irange &r, gphi *phi, fur_source &src) { // Symbolic arguments are equivalences. if (gimple_range_ssa_p (single_arg)) - src.register_relation (phi, EQ_EXPR, phi_def, single_arg); + src.register_relation (phi, VREL_EQ, phi_def, single_arg); else if (src.get_operand (arg_range, single_arg) && arg_range.singleton_p ()) { @@ -1401,18 +1402,18 @@ fold_using_range::relation_fold_and_or (irange& lhs_range, gimple *s, relation_kind relation1 = handler1->op1_op2_relation (bool_one); relation_kind relation2 = handler2->op1_op2_relation (bool_one); - if (relation1 == VREL_NONE || relation2 == VREL_NONE) + if (relation1 == VREL_VARYING || relation2 == VREL_VARYING) return; if (reverse_op2) relation2 = relation_negate (relation2); // x && y is false if the relation intersection of the true cases is NULL. - if (is_and && relation_intersect (relation1, relation2) == VREL_EMPTY) + if (is_and && relation_intersect (relation1, relation2) == VREL_UNDEFINED) lhs_range = int_range<2> (boolean_false_node, boolean_false_node); // x || y is true if the union of the true cases is NO-RELATION.. // ie, one or the other being true covers the full range of possibilties. - else if (!is_and && relation_union (relation1, relation2) == VREL_NONE) + else if (!is_and && relation_union (relation1, relation2) == VREL_VARYING) lhs_range = bool_one; else return; @@ -1476,13 +1477,13 @@ fur_source::register_outgoing_edges (gcond *s, irange &lhs_range, edge e0, edge if (e0) { relation_kind relation = handler->op1_op2_relation (e0_range); - if (relation != VREL_NONE) + if (relation != VREL_VARYING) register_relation (e0, relation, ssa1, ssa2); } if (e1) { relation_kind relation = handler->op1_op2_relation (e1_range); - if (relation != VREL_NONE) + if (relation != VREL_VARYING) register_relation (e1, relation, ssa1, ssa2); } } @@ -1511,14 +1512,14 @@ fur_source::register_outgoing_edges (gcond *s, irange &lhs_range, edge e0, edge && r.singleton_p ()) { relation_kind relation = handler->op1_op2_relation (r); - if (relation != VREL_NONE) + if (relation != VREL_VARYING) register_relation (e0, relation, ssa1, ssa2); } if (e1 && gori ()->outgoing_edge_range_p (r, e1, name, *m_query) && r.singleton_p ()) { relation_kind relation = handler->op1_op2_relation (r); - if (relation != VREL_NONE) + if (relation != VREL_VARYING) register_relation (e1, relation, ssa1, ssa2); } } diff --git a/gcc/gimple-range-path.cc b/gcc/gimple-range-path.cc index 483bcd2..ff39833 100644 --- a/gcc/gimple-range-path.cc +++ b/gcc/gimple-range-path.cc @@ -740,10 +740,10 @@ relation_kind jt_fur_source::query_relation (tree op1, tree op2) { if (!m_oracle) - return VREL_NONE; + return VREL_VARYING; if (TREE_CODE (op1) != SSA_NAME || TREE_CODE (op2) != SSA_NAME) - return VREL_NONE; + return VREL_VARYING; return m_oracle->query_relation (m_entry, op1, op2); } @@ -799,7 +799,7 @@ path_range_query::maybe_register_phi_relation (gphi *phi, edge e) fprintf (dump_file, "maybe_register_phi_relation in bb%d:", bb->index); get_path_oracle ()->killing_def (result); - m_oracle->register_relation (entry_bb (), EQ_EXPR, arg, result); + m_oracle->register_relation (entry_bb (), VREL_EQ, arg, result); } // Compute relations for each PHI in BB. For example: diff --git a/gcc/gimple-range.cc b/gcc/gimple-range.cc index f0caefc..1fdee02 100644 --- a/gcc/gimple-range.cc +++ b/gcc/gimple-range.cc @@ -458,6 +458,28 @@ gimple_ranger::fold_stmt (gimple_stmt_iterator *gsi, tree (*valueize) (tree)) void gimple_ranger::register_side_effects (gimple *s) { + // First, export the LHS if it is a new global range. + tree lhs = gimple_get_lhs (s); + if (lhs) + { + int_range_max tmp; + if (range_of_stmt (tmp, s, lhs) && !tmp.varying_p () + && update_global_range (tmp, lhs) && dump_file) + { + value_range vr = tmp; + fprintf (dump_file, "Global Exported: "); + print_generic_expr (dump_file, lhs, TDF_SLIM); + fprintf (dump_file, " = "); + vr.dump (dump_file); + int_range_max same = vr; + if (same != tmp) + { + fprintf (dump_file, " ... irange was : "); + tmp.dump (dump_file); + } + fputc ('\n', dump_file); + } + } m_cache.block_apply_nonnull (s); } diff --git a/gcc/gimple-ssa-evrp-analyze.cc b/gcc/gimple-ssa-evrp-analyze.cc index fec6e87..16e5a75 100644 --- a/gcc/gimple-ssa-evrp-analyze.cc +++ b/gcc/gimple-ssa-evrp-analyze.cc @@ -27,9 +27,9 @@ along with GCC; see the file COPYING3. If not see #include "ssa.h" #include "gimple-pretty-print.h" #include "cfganal.h" +#include "gimple-iterator.h" #include "gimple-fold.h" #include "tree-eh.h" -#include "gimple-iterator.h" #include "tree-cfg.h" #include "tree-ssa-loop-manip.h" #include "tree-ssa-loop.h" diff --git a/gcc/gimple-ssa-evrp.cc b/gcc/gimple-ssa-evrp.cc index 2baaed6..92dbdd5 100644 --- a/gcc/gimple-ssa-evrp.cc +++ b/gcc/gimple-ssa-evrp.cc @@ -27,9 +27,9 @@ along with GCC; see the file COPYING3. If not see #include "ssa.h" #include "gimple-pretty-print.h" #include "cfganal.h" +#include "gimple-iterator.h" #include "gimple-fold.h" #include "tree-eh.h" -#include "gimple-iterator.h" #include "tree-cfg.h" #include "tree-ssa-loop-manip.h" #include "tree-ssa-loop.h" diff --git a/gcc/gimple-ssa-sprintf.cc b/gcc/gimple-ssa-sprintf.cc index 9a84fff..961c1b7 100644 --- a/gcc/gimple-ssa-sprintf.cc +++ b/gcc/gimple-ssa-sprintf.cc @@ -53,11 +53,11 @@ along with GCC; see the file COPYING3. If not see #include "gimple.h" #include "tree-pass.h" #include "ssa.h" +#include "gimple-iterator.h" #include "gimple-fold.h" #include "gimple-pretty-print.h" #include "diagnostic-core.h" #include "fold-const.h" -#include "gimple-iterator.h" #include "tree-ssa.h" #include "tree-object-size.h" #include "tree-cfg.h" diff --git a/gcc/gimple-ssa-warn-access.cc b/gcc/gimple-ssa-warn-access.cc index 39aa818..c420424 100644 --- a/gcc/gimple-ssa-warn-access.cc +++ b/gcc/gimple-ssa-warn-access.cc @@ -36,8 +36,8 @@ #include "gimple-ssa-warn-restrict.h" #include "diagnostic-core.h" #include "fold-const.h" -#include "gimple-fold.h" #include "gimple-iterator.h" +#include "gimple-fold.h" #include "langhooks.h" #include "memmodel.h" #include "target.h" diff --git a/gcc/gimplify.cc b/gcc/gimplify.cc index 13413d0..2f6d995 100644 --- a/gcc/gimplify.cc +++ b/gcc/gimplify.cc @@ -42,10 +42,10 @@ along with GCC; see the file COPYING3. If not see #include "varasm.h" #include "stmt.h" #include "expr.h" +#include "gimple-iterator.h" #include "gimple-fold.h" #include "tree-eh.h" #include "gimplify.h" -#include "gimple-iterator.h" #include "stor-layout.h" #include "print-tree.h" #include "tree-iterator.h" diff --git a/gcc/go/gofrontend/MERGE b/gcc/go/gofrontend/MERGE index 3ec315f..daa725f 100644 --- a/gcc/go/gofrontend/MERGE +++ b/gcc/go/gofrontend/MERGE @@ -1,4 +1,4 @@ -6a33e7e30c89edc12340dc470b44791bb1066feb +f5bc28a30b7503015bbef38afb5812313184e822 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/export.cc b/gcc/go/gofrontend/export.cc index 3d11334..70d3f70 100644 --- a/gcc/go/gofrontend/export.cc +++ b/gcc/go/gofrontend/export.cc @@ -360,16 +360,6 @@ Collect_export_references::type(Type* type) if (type->is_abstract()) return TRAVERSE_SKIP_COMPONENTS; - // For interfaces make sure that embedded methods are sorted, since the - // comparison function we use for indexing types relies on it (this call has - // to happen before the record_type call below). - if (type->classification() == Type::TYPE_INTERFACE) - { - Interface_type* it = type->interface_type(); - if (it != NULL) - it->sort_embedded(); - } - if (!this->exp_->record_type(type)) { // We've already seen this type. @@ -501,6 +491,11 @@ should_export(Named_object* no) return true; } +// Compare Typed_identifier_list's. + +static int +compare_til(const Typed_identifier_list*, const Typed_identifier_list*); + // A functor to sort Named_object pointers by name. struct Sort_bindings @@ -514,10 +509,57 @@ struct Sort_bindings return true; if (n2->package() == NULL) return false; - return n1->package()->pkgpath() < n2->package()->pkgpath(); + + // Make sure we don't see the same pkgpath twice. + const std::string& p1(n1->package()->pkgpath()); + const std::string& p2(n2->package()->pkgpath()); + go_assert(p1 != p2); + + return p1 < p2; } - return n1->name() < n2->name(); + if (n1->name() != n2->name()) + return n1->name() < n2->name(); + + // We shouldn't see the same name twice, but it can happen for + // nested type names. + + go_assert(n1->is_type() && n2->is_type()); + + unsigned int ind1; + const Named_object* g1 = n1->type_value()->in_function(&ind1); + unsigned int ind2; + const Named_object* g2 = n2->type_value()->in_function(&ind2); + + if (g1 == NULL) + { + go_assert(g2 != NULL); + return true; + } + else if (g2 == NULL) + return false; + else if (g1 == g2) + { + go_assert(ind1 != ind2); + return ind1 < ind2; + } + else if ((g1->package() != g2->package()) || (g1->name() != g2->name())) + return Sort_bindings()(g1, g2); + else + { + // This case can happen if g1 or g2 is a method. + if (g1 != NULL && g1->func_value()->is_method()) + { + const Typed_identifier* r = g1->func_value()->type()->receiver(); + g1 = r->type()->named_type()->named_object(); + } + if (g2 != NULL && g2->func_value()->is_method()) + { + const Typed_identifier* r = g2->func_value()->type()->receiver(); + g2 = r->type()->named_type()->named_object(); + } + return Sort_bindings()(g1, g2); + } } }; @@ -528,17 +570,20 @@ struct Sort_types bool operator()(const Type* t1, const Type* t2) const { + t1 = t1->forwarded(); + t2 = t2->forwarded(); + const Named_type* nt1 = t1->named_type(); const Named_type* nt2 = t2->named_type(); if (nt1 != NULL) { - if (nt2 != NULL) - { - Sort_bindings sb; - return sb(nt1->named_object(), nt2->named_object()); - } - else - return true; + if (nt2 != NULL) + { + Sort_bindings sb; + return sb(nt1->named_object(), nt2->named_object()); + } + else + return true; } else if (nt2 != NULL) return false; @@ -549,10 +594,218 @@ struct Sort_types gogo->type_descriptor_backend_name(t1, NULL, &b1); Backend_name b2; gogo->type_descriptor_backend_name(t2, NULL, &b2); - return b1.name() < b2.name(); + + std::string n1 = b1.name(); + std::string n2 = b2.name(); + if (n1 != n2) + return n1 < n2; + + // We should never see equal types here. If we do, we may not + // generate an identical output file for identical input. But the + // backend names can be equal because we want to treat aliases + // differently while type_descriptor_backend_name does not. In + // that case we need to traverse the type elements. + + // t1 == t2 in case std::sort compares elements to themselves. + if (t1 == t2) + return false; + + Sort_types sort; + Type_alias_identical identical; + go_assert(!identical(t1, t2)); + + switch (t1->classification()) + { + case Type::TYPE_ERROR: + return false; + + case Type::TYPE_VOID: + case Type::TYPE_BOOLEAN: + case Type::TYPE_INTEGER: + case Type::TYPE_FLOAT: + case Type::TYPE_COMPLEX: + case Type::TYPE_STRING: + case Type::TYPE_SINK: + case Type::TYPE_NIL: + case Type::TYPE_CALL_MULTIPLE_RESULT: + case Type::TYPE_NAMED: + case Type::TYPE_FORWARD: + default: + go_unreachable(); + + case Type::TYPE_FUNCTION: + { + const Function_type* ft1 = t1->function_type(); + const Function_type* ft2 = t2->function_type(); + const Typed_identifier* r1 = ft1->receiver(); + const Typed_identifier* r2 = ft2->receiver(); + if (r1 == NULL) + go_assert(r2 == NULL); + else + { + go_assert(r2 != NULL); + const Type* rt1 = r1->type()->forwarded(); + const Type* rt2 = r2->type()->forwarded(); + if (!identical(rt1, rt2)) + return sort(rt1, rt2); + } + + const Typed_identifier_list* p1 = ft1->parameters(); + const Typed_identifier_list* p2 = ft2->parameters(); + if (p1 == NULL || p1->empty()) + go_assert(p2 == NULL || p2->empty()); + else + { + go_assert(p2 != NULL && !p2->empty()); + int i = compare_til(p1, p2); + if (i < 0) + return false; + else if (i > 0) + return true; + } + + p1 = ft1->results(); + p2 = ft2->results(); + if (p1 == NULL || p1->empty()) + go_assert(p2 == NULL || p2->empty()); + else + { + go_assert(p2 != NULL && !p2->empty()); + int i = compare_til(p1, p2); + if (i < 0) + return false; + else if (i > 0) + return true; + } + + go_unreachable(); + } + + case Type::TYPE_POINTER: + { + const Type* p1 = t1->points_to()->forwarded(); + const Type* p2 = t2->points_to()->forwarded(); + go_assert(!identical(p1, p2)); + return sort(p1, p2); + } + + case Type::TYPE_STRUCT: + { + const Struct_type* s1 = t1->struct_type(); + const Struct_type* s2 = t2->struct_type(); + const Struct_field_list* f1 = s1->fields(); + const Struct_field_list* f2 = s2->fields(); + go_assert(f1 != NULL && f2 != NULL); + Struct_field_list::const_iterator p1 = f1->begin(); + Struct_field_list::const_iterator p2 = f2->begin(); + for (; p2 != f2->end(); ++p1, ++p2) + { + go_assert(p1 != f1->end()); + go_assert(p1->field_name() == p2->field_name()); + go_assert(p1->is_anonymous() == p2->is_anonymous()); + const Type* ft1 = p1->type()->forwarded(); + const Type* ft2 = p2->type()->forwarded(); + if (!identical(ft1, ft2)) + return sort(ft1, ft2); + } + go_assert(p1 == f1->end()); + go_unreachable(); + } + + case Type::TYPE_ARRAY: + { + const Type* e1 = t1->array_type()->element_type()->forwarded(); + const Type* e2 = t2->array_type()->element_type()->forwarded(); + go_assert(!identical(e1, e2)); + return sort(e1, e2); + } + + case Type::TYPE_MAP: + { + const Map_type* m1 = t1->map_type(); + const Map_type* m2 = t2->map_type(); + const Type* k1 = m1->key_type()->forwarded(); + const Type* k2 = m2->key_type()->forwarded(); + if (!identical(k1, k2)) + return sort(k1, k2); + const Type* v1 = m1->val_type()->forwarded(); + const Type* v2 = m2->val_type()->forwarded(); + go_assert(!identical(v1, v2)); + return sort(v1, v2); + } + + case Type::TYPE_CHANNEL: + { + const Type* e1 = t1->channel_type()->element_type()->forwarded(); + const Type* e2 = t2->channel_type()->element_type()->forwarded(); + go_assert(!identical(e1, e2)); + return sort(e1, e2); + } + + case Type::TYPE_INTERFACE: + { + const Interface_type* it1 = t1->interface_type(); + const Interface_type* it2 = t2->interface_type(); + const Typed_identifier_list* m1 = it1->local_methods(); + const Typed_identifier_list* m2 = it2->local_methods(); + + // We know the full method lists are the same, because the + // mangled type names were the same, but here we are looking + // at the local method lists, which include embedded + // interfaces, and we can have an embedded empty interface. + if (m1 == NULL || m1->empty()) + { + go_assert(m2 != NULL && !m2->empty()); + return true; + } + else if (m2 == NULL || m2->empty()) + { + go_assert(m1 != NULL && !m1->empty()); + return false; + } + + int i = compare_til(m1, m2); + if (i < 0) + return false; + else if (i > 0) + return true; + else + go_unreachable(); + } + } } }; +// Compare Typed_identifier_list's with Sort_types, returning -1, 0, +1. + +static int +compare_til( + const Typed_identifier_list* til1, + const Typed_identifier_list* til2) +{ + Type_alias_identical identical; + Sort_types sort; + Typed_identifier_list::const_iterator p1 = til1->begin(); + Typed_identifier_list::const_iterator p2 = til2->begin(); + for (; p2 != til2->end(); ++p1, ++p2) + { + if (p1 == til1->end()) + return -1; + const Type* t1 = p1->type()->forwarded(); + const Type* t2 = p2->type()->forwarded(); + if (!identical(t1, t2)) + { + if (sort(t1, t2)) + return -1; + else + return +1; + } + } + if (p1 != til1->end()) + return +1; + return 0; +} + // Export those identifiers marked for exporting. void @@ -714,17 +967,9 @@ bool Export::record_type(Type* type) { type = type->forwarded(); - std::pair<Type_refs::iterator, bool> ins = this->impl_->type_refs.insert(std::make_pair(type, 0)); - if (!ins.second) - { - // We've already seen this type. - return false; - } - ins.first->second = 0; - - return true; + return ins.second; } // Assign the specified type an index. @@ -733,13 +978,12 @@ void Export::set_type_index(const Type* type) { type = type->forwarded(); - std::pair<Type_refs::iterator, bool> ins = - this->impl_->type_refs.insert(std::make_pair(type, 0)); - go_assert(!ins.second); + Type_refs::iterator p = this->impl_->type_refs.find(type); + go_assert(p != this->impl_->type_refs.end()); int index = this->type_index_; ++this->type_index_; - go_assert(ins.first->second == 0); - ins.first->second = index; + go_assert(p->second == 0); + p->second = index; } // This helper assigns type indices to all types mentioned directly or @@ -758,9 +1002,6 @@ Export::assign_type_indices(const std::vector<Named_object*>& sorted_exports) { if (!(*p)->is_type()) continue; - Interface_type* it = (*p)->type_value()->interface_type(); - if (it != NULL) - it->sort_embedded(); this->record_type((*p)->type_value()); this->set_type_index((*p)->type_value()); } diff --git a/gcc/go/gofrontend/types.cc b/gcc/go/gofrontend/types.cc index ef65670..a8e3090 100644 --- a/gcc/go/gofrontend/types.cc +++ b/gcc/go/gofrontend/types.cc @@ -9031,6 +9031,9 @@ Interface_type::finalize_methods() if (this->parse_methods_ == NULL) return; + // The exporter uses parse_methods_. + this->parse_methods_->sort_by_name(); + this->all_methods_ = new Typed_identifier_list(); this->all_methods_->reserve(this->parse_methods_->size()); Typed_identifier_list inherit; @@ -9318,15 +9321,17 @@ Interface_type::is_compatible_for_assign(const Interface_type* t, // Hash code. unsigned int -Interface_type::do_hash_for_method(Gogo*, int) const +Interface_type::do_hash_for_method(Gogo*, int flags) const { go_assert(this->methods_are_finalized_); + Typed_identifier_list* methods = (((flags & COMPARE_EMBEDDED_INTERFACES) != 0) + ? this->parse_methods_ + : this->all_methods_); unsigned int ret = 0; - if (this->all_methods_ != NULL) + if (methods != NULL) { - for (Typed_identifier_list::const_iterator p = - this->all_methods_->begin(); - p != this->all_methods_->end(); + for (Typed_identifier_list::const_iterator p = methods->begin(); + p != methods->end(); ++p) { ret = Gogo::hash_string(p->name(), ret); diff --git a/gcc/go/gofrontend/types.h b/gcc/go/gofrontend/types.h index 6d72e09..49404bd 100644 --- a/gcc/go/gofrontend/types.h +++ b/gcc/go/gofrontend/types.h @@ -3272,15 +3272,6 @@ class Interface_type : public Type methods_are_finalized() const { return this->methods_are_finalized_; } - // Sort embedded interfaces by name. Needed when we are preparing - // to emit types into the export data. - void - sort_embedded() - { - if (parse_methods_ != NULL) - parse_methods_->sort_by_name(); - } - protected: int do_traverse(Traverse*); diff --git a/gcc/graphite-isl-ast-to-gimple.cc b/gcc/graphite-isl-ast-to-gimple.cc index ea1129f..45ed770 100644 --- a/gcc/graphite-isl-ast-to-gimple.cc +++ b/gcc/graphite-isl-ast-to-gimple.cc @@ -32,8 +32,8 @@ along with GCC; see the file COPYING3. If not see #include "gimple.h" #include "ssa.h" #include "fold-const.h" -#include "gimple-fold.h" #include "gimple-iterator.h" +#include "gimple-fold.h" #include "gimplify.h" #include "gimplify-me.h" #include "tree-eh.h" diff --git a/gcc/ipa-cp.cc b/gcc/ipa-cp.cc index 11f4a32..152fe72 100644 --- a/gcc/ipa-cp.cc +++ b/gcc/ipa-cp.cc @@ -113,6 +113,7 @@ along with GCC; see the file COPYING3. If not see #include "cgraph.h" #include "diagnostic.h" #include "fold-const.h" +#include "gimple-iterator.h" #include "gimple-fold.h" #include "symbol-summary.h" #include "tree-vrp.h" diff --git a/gcc/ipa-devirt.cc b/gcc/ipa-devirt.cc index 6cba208..9f1442d 100644 --- a/gcc/ipa-devirt.cc +++ b/gcc/ipa-devirt.cc @@ -120,6 +120,7 @@ along with GCC; see the file COPYING3. If not see #include "print-tree.h" #include "calls.h" #include "ipa-utils.h" +#include "gimple-iterator.h" #include "gimple-fold.h" #include "symbol-summary.h" #include "tree-vrp.h" diff --git a/gcc/ipa-prop.cc b/gcc/ipa-prop.cc index 80e67e9..c6c745f 100644 --- a/gcc/ipa-prop.cc +++ b/gcc/ipa-prop.cc @@ -31,13 +31,13 @@ along with GCC; see the file COPYING3. If not see #include "cgraph.h" #include "diagnostic.h" #include "fold-const.h" +#include "gimple-iterator.h" #include "gimple-fold.h" #include "tree-eh.h" #include "calls.h" #include "stor-layout.h" #include "print-tree.h" #include "gimplify.h" -#include "gimple-iterator.h" #include "gimplify-me.h" #include "gimple-walk.h" #include "symbol-summary.h" diff --git a/gcc/omp-low.cc b/gcc/omp-low.cc index e7818a9..8aebaee 100644 --- a/gcc/omp-low.cc +++ b/gcc/omp-low.cc @@ -37,9 +37,9 @@ along with GCC; see the file COPYING3. If not see #include "fold-const.h" #include "stor-layout.h" #include "internal-fn.h" +#include "gimple-iterator.h" #include "gimple-fold.h" #include "gimplify.h" -#include "gimple-iterator.h" #include "gimplify-me.h" #include "gimple-walk.h" #include "tree-iterator.h" diff --git a/gcc/pointer-query.cc b/gcc/pointer-query.cc index d93657f..646606e 100644 --- a/gcc/pointer-query.cc +++ b/gcc/pointer-query.cc @@ -33,6 +33,7 @@ #include "langhooks.h" #include "stringpool.h" #include "attribs.h" +#include "gimple-iterator.h" #include "gimple-fold.h" #include "gimple-ssa.h" #include "intl.h" diff --git a/gcc/range-op.cc b/gcc/range-op.cc index 47c6dff..c88da8c 100644 --- a/gcc/range-op.cc +++ b/gcc/range-op.cc @@ -38,9 +38,9 @@ along with GCC; see the file COPYING3. If not see #include "stor-layout.h" #include "calls.h" #include "cfganal.h" +#include "gimple-iterator.h" #include "gimple-fold.h" #include "tree-eh.h" -#include "gimple-iterator.h" #include "gimple-walk.h" #include "tree-cfg.h" #include "wide-int.h" @@ -244,28 +244,30 @@ range_operator::op2_range (irange &r ATTRIBUTE_UNUSED, return false; } -// The default relation routines return VREL_NONE. +// The default relation routines return VREL_VARYING. -enum tree_code +relation_kind range_operator::lhs_op1_relation (const irange &lhs ATTRIBUTE_UNUSED, const irange &op1 ATTRIBUTE_UNUSED, - const irange &op2 ATTRIBUTE_UNUSED) const + const irange &op2 ATTRIBUTE_UNUSED, + relation_kind rel ATTRIBUTE_UNUSED) const { - return VREL_NONE; + return VREL_VARYING; } -enum tree_code +relation_kind range_operator::lhs_op2_relation (const irange &lhs ATTRIBUTE_UNUSED, const irange &op1 ATTRIBUTE_UNUSED, - const irange &op2 ATTRIBUTE_UNUSED) const + const irange &op2 ATTRIBUTE_UNUSED, + relation_kind rel ATTRIBUTE_UNUSED) const { - return VREL_NONE; + return VREL_VARYING; } -enum tree_code +relation_kind range_operator::op1_op2_relation (const irange &lhs ATTRIBUTE_UNUSED) const { - return VREL_NONE; + return VREL_VARYING; } // Default is no relation affects the LHS. @@ -448,37 +450,37 @@ public: virtual bool fold_range (irange &r, tree type, const irange &op1, const irange &op2, - relation_kind rel = VREL_NONE) const; + relation_kind rel = VREL_VARYING) const; virtual bool op1_range (irange &r, tree type, const irange &lhs, const irange &val, - relation_kind rel = VREL_NONE) const; + relation_kind rel = VREL_VARYING) const; virtual bool op2_range (irange &r, tree type, const irange &lhs, const irange &val, - relation_kind rel = VREL_NONE) const; - virtual enum tree_code op1_op2_relation (const irange &lhs) const; + relation_kind rel = VREL_VARYING) const; + virtual relation_kind op1_op2_relation (const irange &lhs) const; } op_equal; // Check if the LHS range indicates a relation between OP1 and OP2. -enum tree_code +relation_kind equal_op1_op2_relation (const irange &lhs) { if (lhs.undefined_p ()) - return VREL_EMPTY; + return VREL_UNDEFINED; // FALSE = op1 == op2 indicates NE_EXPR. if (lhs.zero_p ()) - return NE_EXPR; + return VREL_NE; // TRUE = op1 == op2 indicates EQ_EXPR. if (!lhs.contains_p (build_zero_cst (lhs.type ()))) - return EQ_EXPR; - return VREL_NONE; + return VREL_EQ; + return VREL_VARYING; } -enum tree_code +relation_kind operator_equal::op1_op2_relation (const irange &lhs) const { return equal_op1_op2_relation (lhs); @@ -491,7 +493,7 @@ operator_equal::fold_range (irange &r, tree type, const irange &op2, relation_kind rel) const { - if (relop_early_resolve (r, type, op1, op2, rel, EQ_EXPR)) + if (relop_early_resolve (r, type, op1, op2, rel, VREL_EQ)) return true; // We can be sure the values are always equal or not if both ranges @@ -564,37 +566,37 @@ public: virtual bool fold_range (irange &r, tree type, const irange &op1, const irange &op2, - relation_kind rel = VREL_NONE) const; + relation_kind rel = VREL_VARYING) const; virtual bool op1_range (irange &r, tree type, const irange &lhs, const irange &op2, - relation_kind rel = VREL_NONE) const; + relation_kind rel = VREL_VARYING) const; virtual bool op2_range (irange &r, tree type, const irange &lhs, const irange &op1, - relation_kind rel = VREL_NONE) const; - virtual enum tree_code op1_op2_relation (const irange &lhs) const; + relation_kind rel = VREL_VARYING) const; + virtual relation_kind op1_op2_relation (const irange &lhs) const; } op_not_equal; // Check if the LHS range indicates a relation between OP1 and OP2. -enum tree_code +relation_kind not_equal_op1_op2_relation (const irange &lhs) { if (lhs.undefined_p ()) - return VREL_EMPTY; + return VREL_UNDEFINED; // FALSE = op1 != op2 indicates EQ_EXPR. if (lhs.zero_p ()) - return EQ_EXPR; + return VREL_EQ; // TRUE = op1 != op2 indicates NE_EXPR. if (!lhs.contains_p (build_zero_cst (lhs.type ()))) - return NE_EXPR; - return VREL_NONE; + return VREL_NE; + return VREL_VARYING; } -enum tree_code +relation_kind operator_not_equal::op1_op2_relation (const irange &lhs) const { return not_equal_op1_op2_relation (lhs); @@ -606,7 +608,7 @@ operator_not_equal::fold_range (irange &r, tree type, const irange &op2, relation_kind rel) const { - if (relop_early_resolve (r, type, op1, op2, rel, NE_EXPR)) + if (relop_early_resolve (r, type, op1, op2, rel, VREL_NE)) return true; // We can be sure the values are always equal or not if both ranges @@ -740,37 +742,37 @@ public: virtual bool fold_range (irange &r, tree type, const irange &op1, const irange &op2, - relation_kind rel = VREL_NONE) const; + relation_kind rel = VREL_VARYING) const; virtual bool op1_range (irange &r, tree type, const irange &lhs, const irange &op2, - relation_kind rel = VREL_NONE) const; + relation_kind rel = VREL_VARYING) const; virtual bool op2_range (irange &r, tree type, const irange &lhs, const irange &op1, - relation_kind rel = VREL_NONE) const; - virtual enum tree_code op1_op2_relation (const irange &lhs) const; + relation_kind rel = VREL_VARYING) const; + virtual relation_kind op1_op2_relation (const irange &lhs) const; } op_lt; // Check if the LHS range indicates a relation between OP1 and OP2. -enum tree_code +relation_kind lt_op1_op2_relation (const irange &lhs) { if (lhs.undefined_p ()) - return VREL_EMPTY; + return VREL_UNDEFINED; // FALSE = op1 < op2 indicates GE_EXPR. if (lhs.zero_p ()) - return GE_EXPR; + return VREL_GE; // TRUE = op1 < op2 indicates LT_EXPR. if (!lhs.contains_p (build_zero_cst (lhs.type ()))) - return LT_EXPR; - return VREL_NONE; + return VREL_LT; + return VREL_VARYING; } -enum tree_code +relation_kind operator_lt::op1_op2_relation (const irange &lhs) const { return lt_op1_op2_relation (lhs); @@ -782,7 +784,7 @@ operator_lt::fold_range (irange &r, tree type, const irange &op2, relation_kind rel) const { - if (relop_early_resolve (r, type, op1, op2, rel, LT_EXPR)) + if (relop_early_resolve (r, type, op1, op2, rel, VREL_LT)) return true; signop sign = TYPE_SIGN (op1.type ()); @@ -848,37 +850,37 @@ public: virtual bool fold_range (irange &r, tree type, const irange &op1, const irange &op2, - relation_kind rel = VREL_NONE) const; + relation_kind rel = VREL_VARYING) const; virtual bool op1_range (irange &r, tree type, const irange &lhs, const irange &op2, - relation_kind rel = VREL_NONE) const; + relation_kind rel = VREL_VARYING) const; virtual bool op2_range (irange &r, tree type, const irange &lhs, const irange &op1, - relation_kind rel = VREL_NONE) const; - virtual enum tree_code op1_op2_relation (const irange &lhs) const; + relation_kind rel = VREL_VARYING) const; + virtual relation_kind op1_op2_relation (const irange &lhs) const; } op_le; // Check if the LHS range indicates a relation between OP1 and OP2. -enum tree_code +relation_kind le_op1_op2_relation (const irange &lhs) { if (lhs.undefined_p ()) - return VREL_EMPTY; + return VREL_UNDEFINED; // FALSE = op1 <= op2 indicates GT_EXPR. if (lhs.zero_p ()) - return GT_EXPR; + return VREL_GT; // TRUE = op1 <= op2 indicates LE_EXPR. if (!lhs.contains_p (build_zero_cst (lhs.type ()))) - return LE_EXPR; - return VREL_NONE; + return VREL_LE; + return VREL_VARYING; } -enum tree_code +relation_kind operator_le::op1_op2_relation (const irange &lhs) const { return le_op1_op2_relation (lhs); @@ -890,7 +892,7 @@ operator_le::fold_range (irange &r, tree type, const irange &op2, relation_kind rel) const { - if (relop_early_resolve (r, type, op1, op2, rel, LE_EXPR)) + if (relop_early_resolve (r, type, op1, op2, rel, VREL_LE)) return true; signop sign = TYPE_SIGN (op1.type ()); @@ -956,37 +958,37 @@ public: virtual bool fold_range (irange &r, tree type, const irange &op1, const irange &op2, - relation_kind rel = VREL_NONE) const; + relation_kind rel = VREL_VARYING) const; virtual bool op1_range (irange &r, tree type, const irange &lhs, const irange &op2, - relation_kind rel = VREL_NONE) const; + relation_kind rel = VREL_VARYING) const; virtual bool op2_range (irange &r, tree type, const irange &lhs, const irange &op1, - relation_kind rel = VREL_NONE) const; - virtual enum tree_code op1_op2_relation (const irange &lhs) const; + relation_kind rel = VREL_VARYING) const; + virtual relation_kind op1_op2_relation (const irange &lhs) const; } op_gt; // Check if the LHS range indicates a relation between OP1 and OP2. -enum tree_code +relation_kind gt_op1_op2_relation (const irange &lhs) { if (lhs.undefined_p ()) - return VREL_EMPTY; + return VREL_UNDEFINED; // FALSE = op1 > op2 indicates LE_EXPR. if (lhs.zero_p ()) - return LE_EXPR; + return VREL_LE; // TRUE = op1 > op2 indicates GT_EXPR. if (!lhs.contains_p (build_zero_cst (lhs.type ()))) - return GT_EXPR; - return VREL_NONE; + return VREL_GT; + return VREL_VARYING; } -enum tree_code +relation_kind operator_gt::op1_op2_relation (const irange &lhs) const { return gt_op1_op2_relation (lhs); @@ -998,7 +1000,7 @@ operator_gt::fold_range (irange &r, tree type, const irange &op1, const irange &op2, relation_kind rel) const { - if (relop_early_resolve (r, type, op1, op2, rel, GT_EXPR)) + if (relop_early_resolve (r, type, op1, op2, rel, VREL_GT)) return true; signop sign = TYPE_SIGN (op1.type ()); @@ -1063,37 +1065,37 @@ public: virtual bool fold_range (irange &r, tree type, const irange &op1, const irange &op2, - relation_kind rel = VREL_NONE) const; + relation_kind rel = VREL_VARYING) const; virtual bool op1_range (irange &r, tree type, const irange &lhs, const irange &op2, - relation_kind rel = VREL_NONE) const; + relation_kind rel = VREL_VARYING) const; virtual bool op2_range (irange &r, tree type, const irange &lhs, const irange &op1, - relation_kind rel = VREL_NONE) const; - virtual enum tree_code op1_op2_relation (const irange &lhs) const; + relation_kind rel = VREL_VARYING) const; + virtual relation_kind op1_op2_relation (const irange &lhs) const; } op_ge; // Check if the LHS range indicates a relation between OP1 and OP2. -enum tree_code +relation_kind ge_op1_op2_relation (const irange &lhs) { if (lhs.undefined_p ()) - return VREL_EMPTY; + return VREL_UNDEFINED; // FALSE = op1 >= op2 indicates LT_EXPR. if (lhs.zero_p ()) - return LT_EXPR; + return VREL_LT; // TRUE = op1 >= op2 indicates GE_EXPR. if (!lhs.contains_p (build_zero_cst (lhs.type ()))) - return GE_EXPR; - return VREL_NONE; + return VREL_GE; + return VREL_VARYING; } -enum tree_code +relation_kind operator_ge::op1_op2_relation (const irange &lhs) const { return ge_op1_op2_relation (lhs); @@ -1105,7 +1107,7 @@ operator_ge::fold_range (irange &r, tree type, const irange &op2, relation_kind rel) const { - if (relop_early_resolve (r, type, op1, op2, rel, GE_EXPR)) + if (relop_early_resolve (r, type, op1, op2, rel, VREL_GE)) return true; signop sign = TYPE_SIGN (op1.type ()); @@ -1181,22 +1183,25 @@ public: const wide_int &lh_ub, const wide_int &rh_lb, const wide_int &rh_ub) const; - virtual enum tree_code lhs_op1_relation (const irange &lhs, const irange &op1, - const irange &op2) const; - virtual enum tree_code lhs_op2_relation (const irange &lhs, const irange &op1, - const irange &op2) const; + virtual relation_kind lhs_op1_relation (const irange &lhs, const irange &op1, + const irange &op2, + relation_kind rel) const; + virtual relation_kind lhs_op2_relation (const irange &lhs, const irange &op1, + const irange &op2, + relation_kind rel) const; } op_plus; // Check to see if the range of OP2 indicates anything about the relation // between LHS and OP1. -enum tree_code +relation_kind operator_plus::lhs_op1_relation (const irange &lhs, const irange &op1, - const irange &op2) const + const irange &op2, + relation_kind) const { if (lhs.undefined_p () || op1.undefined_p () || op2.undefined_p ()) - return VREL_NONE; + return VREL_VARYING; tree type = lhs.type (); unsigned prec = TYPE_PRECISION (type); @@ -1205,7 +1210,7 @@ operator_plus::lhs_op1_relation (const irange &lhs, // LHS = OP1 + 0 indicates LHS == OP1. if (op2.zero_p ()) - return EQ_EXPR; + return VREL_EQ; if (TYPE_OVERFLOW_WRAPS (type)) { @@ -1220,47 +1225,47 @@ operator_plus::lhs_op1_relation (const irange &lhs, { // Positive op2 means lhs > op1. if (wi::gt_p (op2.lower_bound (), wi::zero (prec), sign)) - return GT_EXPR; + return VREL_GT; if (wi::ge_p (op2.lower_bound (), wi::zero (prec), sign)) - return GE_EXPR; + return VREL_GE; // Negative op2 means lhs < op1. if (wi::lt_p (op2.upper_bound (), wi::zero (prec), sign)) - return LT_EXPR; + return VREL_LT; if (wi::le_p (op2.upper_bound (), wi::zero (prec), sign)) - return LE_EXPR; + return VREL_LE; } // Always wrapping additions. else if (ovf1 && ovf1 == ovf2) { // Positive op2 means lhs < op1. if (wi::gt_p (op2.lower_bound (), wi::zero (prec), sign)) - return LT_EXPR; + return VREL_LT; if (wi::ge_p (op2.lower_bound (), wi::zero (prec), sign)) - return LE_EXPR; + return VREL_LE; // Negative op2 means lhs > op1. if (wi::lt_p (op2.upper_bound (), wi::zero (prec), sign)) - return GT_EXPR; + return VREL_GT; if (wi::le_p (op2.upper_bound (), wi::zero (prec), sign)) - return GE_EXPR; + return VREL_GE; } // If op2 does not contain 0, then LHS and OP1 can never be equal. if (!range_includes_zero_p (&op2)) - return NE_EXPR; + return VREL_NE; - return VREL_NONE; + return VREL_VARYING; } // PLUS is symmetrical, so we can simply call lhs_op1_relation with reversed // operands. -enum tree_code +relation_kind operator_plus::lhs_op2_relation (const irange &lhs, const irange &op1, - const irange &op2) const + const irange &op2, relation_kind rel) const { - return lhs_op1_relation (lhs, op2, op1); + return lhs_op1_relation (lhs, op2, op1, rel); } void @@ -1310,6 +1315,10 @@ public: const wide_int &lh_ub, const wide_int &rh_lb, const wide_int &rh_ub) const; + virtual relation_kind lhs_op1_relation (const irange &lhs, + const irange &op1, + const irange &op2, + relation_kind rel) const; virtual bool op1_op2_relation_effect (irange &lhs_range, tree type, const irange &op1_range, @@ -1329,6 +1338,27 @@ operator_minus::wi_fold (irange &r, tree type, value_range_with_overflow (r, type, new_lb, new_ub, ov_lb, ov_ub); } + +// Return the relation between LHS and OP1 based on the relation between +// OP1 and OP2. + +relation_kind +operator_minus::lhs_op1_relation (const irange &, const irange &op1, + const irange &, relation_kind rel) const +{ + if (!op1.undefined_p () && TYPE_SIGN (op1.type ()) == UNSIGNED) + switch (rel) + { + case VREL_GT: + return VREL_LT; + case VREL_GE: + return VREL_LE; + default: + break; + } + return VREL_VARYING; +} + // Check to see if the relation REL between OP1 and OP2 has any effect on the // LHS of the expression. If so, apply it to LHS_RANGE. This is a helper // function for both MINUS_EXPR and POINTER_DIFF_EXPR. @@ -1339,7 +1369,7 @@ minus_op1_op2_relation_effect (irange &lhs_range, tree type, const irange &op2_range ATTRIBUTE_UNUSED, relation_kind rel) { - if (rel == VREL_NONE) + if (rel == VREL_VARYING) return false; int_range<2> rel_range; @@ -1347,9 +1377,9 @@ minus_op1_op2_relation_effect (irange &lhs_range, tree type, signop sgn = TYPE_SIGN (type); // == and != produce [0,0] and ~[0,0] regardless of wrapping. - if (rel == EQ_EXPR) + if (rel == VREL_EQ) rel_range = int_range<2> (type, wi::zero (prec), wi::zero (prec)); - else if (rel == NE_EXPR) + else if (rel == VREL_NE) rel_range = int_range<2> (type, wi::zero (prec), wi::zero (prec), VR_ANTI_RANGE); else if (TYPE_OVERFLOW_WRAPS (type)) @@ -1358,8 +1388,8 @@ minus_op1_op2_relation_effect (irange &lhs_range, tree type, { // For wrapping signed values and unsigned, if op1 > op2 or // op1 < op2, then op1 - op2 can be restricted to ~[0, 0]. - case GT_EXPR: - case LT_EXPR: + case VREL_GT: + case VREL_LT: rel_range = int_range<2> (type, wi::zero (prec), wi::zero (prec), VR_ANTI_RANGE); break; @@ -1372,22 +1402,22 @@ minus_op1_op2_relation_effect (irange &lhs_range, tree type, switch (rel) { // op1 > op2, op1 - op2 can be restricted to [1, +INF] - case GT_EXPR: + case VREL_GT: rel_range = int_range<2> (type, wi::one (prec), wi::max_value (prec, sgn)); break; // op1 >= op2, op1 - op2 can be restricted to [0, +INF] - case GE_EXPR: + case VREL_GE: rel_range = int_range<2> (type, wi::zero (prec), wi::max_value (prec, sgn)); break; // op1 < op2, op1 - op2 can be restricted to [-INF, -1] - case LT_EXPR: + case VREL_LT: rel_range = int_range<2> (type, wi::min_value (prec, sgn), wi::minus_one (prec)); break; // op1 <= op2, op1 - op2 can be restricted to [-INF, 0] - case LE_EXPR: + case VREL_LE: rel_range = int_range<2> (type, wi::min_value (prec, sgn), wi::zero (prec)); break; @@ -1862,11 +1892,11 @@ public: virtual bool op1_range (irange &r, tree type, const irange &lhs, const irange &op2, - relation_kind rel = VREL_NONE) const; + relation_kind rel = VREL_VARYING) const; virtual bool fold_range (irange &r, tree type, const irange &op1, const irange &op2, - relation_kind rel = VREL_NONE) const; + relation_kind rel = VREL_VARYING) const; virtual void wi_fold (irange &r, tree type, const wide_int &lh_lb, const wide_int &lh_ub, @@ -1883,7 +1913,7 @@ public: virtual bool fold_range (irange &r, tree type, const irange &op1, const irange &op2, - relation_kind rel = VREL_NONE) const; + relation_kind rel = VREL_VARYING) const; virtual void wi_fold (irange &r, tree type, const wide_int &lh_lb, const wide_int &lh_ub, @@ -1896,24 +1926,26 @@ public: virtual bool op1_range (irange &, tree type, const irange &lhs, const irange &op2, - relation_kind rel = VREL_NONE) const; - virtual enum tree_code lhs_op1_relation (const irange &lhs, + relation_kind rel = VREL_VARYING) const; + virtual relation_kind lhs_op1_relation (const irange &lhs, const irange &op1, - const irange &op2) const; + const irange &op2, + relation_kind rel) const; } op_rshift; -enum tree_code +relation_kind operator_rshift::lhs_op1_relation (const irange &lhs ATTRIBUTE_UNUSED, const irange &op1, - const irange &op2) const + const irange &op2, + relation_kind) const { // If both operands range are >= 0, then the LHS <= op1. if (!op1.undefined_p () && !op2.undefined_p () && wi::ge_p (op1.lower_bound (), 0, TYPE_SIGN (op1.type ())) && wi::ge_p (op2.lower_bound (), 0, TYPE_SIGN (op2.type ()))) - return LE_EXPR; - return VREL_NONE; + return VREL_LE; + return VREL_VARYING; } bool @@ -2220,11 +2252,11 @@ public: virtual bool fold_range (irange &r, tree type, const irange &op1, const irange &op2, - relation_kind rel = VREL_NONE) const; + relation_kind rel = VREL_VARYING) const; virtual bool op1_range (irange &r, tree type, const irange &lhs, const irange &op2, - relation_kind rel = VREL_NONE) const; + relation_kind rel = VREL_VARYING) const; private: bool truncating_cast_p (const irange &inner, const irange &outer) const; bool inside_domain_p (const wide_int &min, const wide_int &max, @@ -2441,15 +2473,15 @@ public: virtual bool fold_range (irange &r, tree type, const irange &lh, const irange &rh, - relation_kind rel = VREL_NONE) const; + relation_kind rel = VREL_VARYING) const; virtual bool op1_range (irange &r, tree type, const irange &lhs, const irange &op2, - relation_kind rel = VREL_NONE) const; + relation_kind rel = VREL_VARYING) const; virtual bool op2_range (irange &r, tree type, const irange &lhs, const irange &op1, - relation_kind rel = VREL_NONE) const; + relation_kind rel = VREL_VARYING) const; } op_logical_and; @@ -2514,15 +2546,15 @@ public: virtual bool fold_range (irange &r, tree type, const irange &lh, const irange &rh, - relation_kind rel = VREL_NONE) const; + relation_kind rel = VREL_VARYING) const; virtual bool op1_range (irange &r, tree type, const irange &lhs, const irange &op2, - relation_kind rel = VREL_NONE) const; + relation_kind rel = VREL_VARYING) const; virtual bool op2_range (irange &r, tree type, const irange &lhs, const irange &op1, - relation_kind rel = VREL_NONE) const; + relation_kind rel = VREL_VARYING) const; virtual void wi_fold (irange &r, tree type, const wide_int &lh_lb, const wide_int &lh_ub, @@ -2960,15 +2992,15 @@ public: virtual bool fold_range (irange &r, tree type, const irange &lh, const irange &rh, - relation_kind rel = VREL_NONE) const; + relation_kind rel = VREL_VARYING) const; virtual bool op1_range (irange &r, tree type, const irange &lhs, const irange &op2, - relation_kind rel = VREL_NONE) const; + relation_kind rel = VREL_VARYING) const; virtual bool op2_range (irange &r, tree type, const irange &lhs, const irange &op1, - relation_kind rel = VREL_NONE) const; + relation_kind rel = VREL_VARYING) const; } op_logical_or; bool @@ -3023,11 +3055,11 @@ public: virtual bool op1_range (irange &r, tree type, const irange &lhs, const irange &op2, - relation_kind rel = VREL_NONE) const; + relation_kind rel = VREL_VARYING) const; virtual bool op2_range (irange &r, tree type, const irange &lhs, const irange &op1, - relation_kind rel= VREL_NONE) const; + relation_kind rel= VREL_VARYING) const; virtual void wi_fold (irange &r, tree type, const wide_int &lh_lb, const wide_int &lh_ub, @@ -3132,11 +3164,11 @@ public: virtual bool op1_range (irange &r, tree type, const irange &lhs, const irange &op2, - relation_kind rel = VREL_NONE) const; + relation_kind rel = VREL_VARYING) const; virtual bool op2_range (irange &r, tree type, const irange &lhs, const irange &op1, - relation_kind rel = VREL_NONE) const; + relation_kind rel = VREL_VARYING) const; virtual bool op1_op2_relation_effect (irange &lhs_range, tree type, const irange &op1_range, @@ -3197,17 +3229,17 @@ operator_bitwise_xor::op1_op2_relation_effect (irange &lhs_range, const irange &, relation_kind rel) const { - if (rel == VREL_NONE) + if (rel == VREL_VARYING) return false; int_range<2> rel_range; switch (rel) { - case EQ_EXPR: + case VREL_EQ: rel_range.set_zero (type); break; - case NE_EXPR: + case VREL_NE: rel_range.set_nonzero (type); break; default: @@ -3404,11 +3436,11 @@ public: virtual bool fold_range (irange &r, tree type, const irange &lh, const irange &rh, - relation_kind rel = VREL_NONE) const; + relation_kind rel = VREL_VARYING) const; virtual bool op1_range (irange &r, tree type, const irange &lhs, const irange &op2, - relation_kind rel = VREL_NONE) const; + relation_kind rel = VREL_VARYING) const; } op_logical_not; // Folding a logical NOT, oddly enough, involves doing nothing on the @@ -3459,11 +3491,11 @@ public: virtual bool fold_range (irange &r, tree type, const irange &lh, const irange &rh, - relation_kind rel = VREL_NONE) const; + relation_kind rel = VREL_VARYING) const; virtual bool op1_range (irange &r, tree type, const irange &lhs, const irange &op2, - relation_kind rel = VREL_NONE) const; + relation_kind rel = VREL_VARYING) const; } op_bitwise_not; bool @@ -3505,7 +3537,7 @@ public: virtual bool fold_range (irange &r, tree type, const irange &op1, const irange &op2, - relation_kind rel = VREL_NONE) const; + relation_kind rel = VREL_VARYING) const; } op_integer_cst; bool @@ -3525,27 +3557,29 @@ public: virtual bool fold_range (irange &r, tree type, const irange &op1, const irange &op2, - relation_kind rel = VREL_NONE) const; + relation_kind rel = VREL_VARYING) const; virtual bool op1_range (irange &r, tree type, const irange &lhs, const irange &op2, - relation_kind rel = VREL_NONE) const; - virtual enum tree_code lhs_op1_relation (const irange &lhs, + relation_kind rel = VREL_VARYING) const; + virtual relation_kind lhs_op1_relation (const irange &lhs, const irange &op1, - const irange &op2) const; + const irange &op2, + relation_kind rel) const; } op_identity; // Determine if there is a relationship between LHS and OP1. -enum tree_code +relation_kind operator_identity::lhs_op1_relation (const irange &lhs, const irange &op1 ATTRIBUTE_UNUSED, - const irange &op2 ATTRIBUTE_UNUSED) const + const irange &op2 ATTRIBUTE_UNUSED, + relation_kind) const { if (lhs.undefined_p ()) - return VREL_NONE; + return VREL_VARYING; // Simply a copy, so they are equivalent. - return EQ_EXPR; + return VREL_EQ; } bool @@ -3575,7 +3609,7 @@ public: virtual bool fold_range (irange &r, tree type, const irange &op1, const irange &op2, - relation_kind rel = VREL_NONE) const; + relation_kind rel = VREL_VARYING) const; } op_unknown; bool @@ -3760,11 +3794,11 @@ class operator_negate : public range_operator virtual bool fold_range (irange &r, tree type, const irange &op1, const irange &op2, - relation_kind rel = VREL_NONE) const; + relation_kind rel = VREL_VARYING) const; virtual bool op1_range (irange &r, tree type, const irange &lhs, const irange &op2, - relation_kind rel = VREL_NONE) const; + relation_kind rel = VREL_VARYING) const; } op_negate; bool @@ -3798,11 +3832,11 @@ public: virtual bool fold_range (irange &r, tree type, const irange &op1, const irange &op2, - relation_kind rel = VREL_NONE) const; + relation_kind rel = VREL_VARYING) const; virtual bool op1_range (irange &r, tree type, const irange &lhs, const irange &op2, - relation_kind rel = VREL_NONE) const; + relation_kind rel = VREL_VARYING) const; } op_addr; bool @@ -3948,11 +3982,11 @@ public: virtual bool op1_range (irange &r, tree type, const irange &lhs, const irange &op2, - relation_kind rel = VREL_NONE) const; + relation_kind rel = VREL_VARYING) const; virtual bool op2_range (irange &r, tree type, const irange &lhs, const irange &op1, - relation_kind rel = VREL_NONE) const; + relation_kind rel = VREL_VARYING) const; virtual void wi_fold (irange &r, tree type, const wide_int &lh_lb, const wide_int &lh_ub, const wide_int &rh_lb, const wide_int &rh_ub) const; @@ -4427,20 +4461,20 @@ range_relational_tests () int_range<2> op2 (UCHAR (20), UCHAR (20)); // Never wrapping additions mean LHS > OP1. - tree_code code = op_plus.lhs_op1_relation (lhs, op1, op2); - ASSERT_TRUE (code == GT_EXPR); + relation_kind code = op_plus.lhs_op1_relation (lhs, op1, op2, VREL_VARYING); + ASSERT_TRUE (code == VREL_GT); // Most wrapping additions mean nothing... op1 = int_range<2> (UCHAR (8), UCHAR (10)); op2 = int_range<2> (UCHAR (0), UCHAR (255)); - code = op_plus.lhs_op1_relation (lhs, op1, op2); - ASSERT_TRUE (code == VREL_NONE); + code = op_plus.lhs_op1_relation (lhs, op1, op2, VREL_VARYING); + ASSERT_TRUE (code == VREL_VARYING); // However, always wrapping additions mean LHS < OP1. op1 = int_range<2> (UCHAR (1), UCHAR (255)); op2 = int_range<2> (UCHAR (255), UCHAR (255)); - code = op_plus.lhs_op1_relation (lhs, op1, op2); - ASSERT_TRUE (code == LT_EXPR); + code = op_plus.lhs_op1_relation (lhs, op1, op2, VREL_VARYING); + ASSERT_TRUE (code == VREL_LT); } void diff --git a/gcc/range-op.h b/gcc/range-op.h index c93eb84..5fdda32 100644 --- a/gcc/range-op.h +++ b/gcc/range-op.h @@ -53,7 +53,7 @@ public: virtual bool fold_range (irange &r, tree type, const irange &lh, const irange &rh, - relation_kind rel = VREL_NONE) const; + relation_kind rel = VREL_VARYING) const; // Return the range for op[12] in the general case. LHS is the range for // the LHS of the expression, OP[12]is the range for the other @@ -69,22 +69,25 @@ public: virtual bool op1_range (irange &r, tree type, const irange &lhs, const irange &op2, - relation_kind rel = VREL_NONE) const; + relation_kind rel = VREL_VARYING) const; virtual bool op2_range (irange &r, tree type, const irange &lhs, const irange &op1, - relation_kind rel = VREL_NONE) const; + relation_kind rel = VREL_VARYING) const; // The following routines are used to represent relations between the // various operations. If the caller knows where the symbolics are, // it can query for relationships between them given known ranges. - virtual enum tree_code lhs_op1_relation (const irange &lhs, - const irange &op1, - const irange &op2) const; - virtual enum tree_code lhs_op2_relation (const irange &lhs, - const irange &op1, - const irange &op2) const; - virtual enum tree_code op1_op2_relation (const irange &lhs) const; + // the optional relation passed in is the relation between op1 and op2. + virtual relation_kind lhs_op1_relation (const irange &lhs, + const irange &op1, + const irange &op2, + relation_kind = VREL_VARYING) const; + virtual relation_kind lhs_op2_relation (const irange &lhs, + const irange &op1, + const irange &op2, + relation_kind = VREL_VARYING) const; + virtual relation_kind op1_op2_relation (const irange &lhs) const; protected: // Perform an integral operation between 2 sub-ranges and return it. virtual void wi_fold (irange &r, tree type, @@ -113,12 +116,12 @@ extern void wi_set_zero_nonzero_bits (tree type, wide_int &mustbe_nonzero); // op1_op2_relation methods that are the same across irange and frange. -enum tree_code equal_op1_op2_relation (const irange &lhs); -enum tree_code not_equal_op1_op2_relation (const irange &lhs); -enum tree_code lt_op1_op2_relation (const irange &lhs); -enum tree_code le_op1_op2_relation (const irange &lhs); -enum tree_code gt_op1_op2_relation (const irange &lhs); -enum tree_code ge_op1_op2_relation (const irange &lhs); +relation_kind equal_op1_op2_relation (const irange &lhs); +relation_kind not_equal_op1_op2_relation (const irange &lhs); +relation_kind lt_op1_op2_relation (const irange &lhs); +relation_kind le_op1_op2_relation (const irange &lhs); +relation_kind gt_op1_op2_relation (const irange &lhs); +relation_kind ge_op1_op2_relation (const irange &lhs); enum bool_range_state { BRS_FALSE, BRS_TRUE, BRS_EMPTY, BRS_FULL }; bool_range_state get_bool_state (irange &r, const irange &lhs, tree val_type); @@ -159,7 +162,7 @@ relop_early_resolve (irange &r, tree type, const irange &op1, } // If known relation has no subset of this relation, always false. - if (relation_intersect (rel, my_rel) == VREL_EMPTY) + if (relation_intersect (rel, my_rel) == VREL_UNDEFINED) { r = range_false (type); return true; diff --git a/gcc/testsuite/ChangeLog b/gcc/testsuite/ChangeLog index e33db7b..3109d8e 100644 --- a/gcc/testsuite/ChangeLog +++ b/gcc/testsuite/ChangeLog @@ -1,3 +1,183 @@ +2022-05-13 Marek Polacek <polacek@redhat.com> + + PR c++/81952 + * g++.dg/overload/conv-op4.C: New test. + +2022-05-13 Roger Sayle <roger@nextmovesoftware.com> + UroÅ¡ Bizjak <ubizjak@gmail.com> + + * gcc.target/i386/sse2-v1ti-veq.c: New test case. + * gcc.target/i386/sse2-v1ti-vne.c: New test case. + +2022-05-13 Paul A. Clarke <pc@us.ibm.com> + + * g++.target/powerpc/pr65240-1.C: Adjust DejaGnu directives. + * g++.target/powerpc/pr65240-2.C: Likewise. + * g++.target/powerpc/pr65240-3.C: Likewise. + * g++.target/powerpc/pr65240-4.C: Likewise. + * g++.target/powerpc/pr65242.C: Likewise. + * g++.target/powerpc/pr67211.C: Likewise. + * g++.target/powerpc/pr69667.C: Likewise. + * g++.target/powerpc/pr71294.C: Likewise. + +2022-05-13 Paul A. Clarke <pc@us.ibm.com> + + * g++.dg/pr65240.h: Move to g++.target/powerpc. + * g++.dg/pr93974.C: Likewise. + * g++.dg/pr65240-1.C: Move to g++.target/powerpc, adjust dg directives. + * g++.dg/pr65240-2.C: Likewise. + * g++.dg/pr65240-3.C: Likewise. + * g++.dg/pr65240-4.C: Likewise. + * g++.dg/pr65242.C: Likewise. + * g++.dg/pr67211.C: Likewise. + * g++.dg/pr69667.C: Likewise. + * g++.dg/pr71294.C: Likewise. + * g++.dg/pr84264.C: Likewise. + * g++.dg/pr84279.C: Likewise. + * g++.dg/pr85657.C: Likewise. + * g++.target/powerpc/pr65240-1.C: New file. + * g++.target/powerpc/pr65240-2.C: New file. + * g++.target/powerpc/pr65240-3.C: New file. + * g++.target/powerpc/pr65240-4.C: New file. + * g++.target/powerpc/pr65240.h: New file. + * g++.target/powerpc/pr65242.C: New file. + * g++.target/powerpc/pr67211.C: New file. + * g++.target/powerpc/pr69667.C: New file. + * g++.target/powerpc/pr71294.C: New file. + * g++.target/powerpc/pr84264.C: New file. + * g++.target/powerpc/pr84279.C: New file. + * g++.target/powerpc/pr85657.C: New file. + * g++.target/powerpc/pr93974.C: New file. + +2022-05-13 Roger Sayle <roger@nextmovesoftware.com> + + PR tree-optimization/83907 + * gcc.dg/tree-ssa/pr83907-1.c: New test case. + * gcc.dg/tree-ssa/pr83907-2.c: New test case. + +2022-05-13 Philipp Tomsich <philipp.tomsich@vrull.eu> + Manolis Tsamis <manolis.tsamis@vrull.eu> + + * gcc.dg/pr90838.c: Add additional flags (dg-additional-options) + when compiling for riscv64 and subsume gcc.target/aarch64/pr90838.c + and gcc.target/i386/pr95863-2.c. + * gcc.target/aarch64/pr90838.c: Removed. + * gcc.target/i386/pr95863-2.c: Removed. + * lib/target-supports.exp: Recognize RV32 or RV64 via XLEN + +2022-05-13 Andrew MacLeod <amacleod@redhat.com> + + PR tree-optimization/105597 + * gcc.dg/pr105597.c: New. + +2022-05-13 Sebastian Pop <spop@amazon.com> + + PR target/105162 + * gcc.target/aarch64/sync-comp-swap-ool.c: New. + * gcc.target/aarch64/sync-op-acquire-ool.c: New. + * gcc.target/aarch64/sync-op-full-ool.c: New. + * gcc.target/aarch64/target_attr_20.c: Update check. + * gcc.target/aarch64/target_attr_21.c: Same. + +2022-05-13 Palmer Dabbelt <palmer@rivosinc.com> + + * gcc.dg/debug/btf/btf-datasec-1.c: Don't use small data on RISC-V. + +2022-05-13 Jia-Wei Chen <jiawei@iscas.ac.cn> + + * g++.dg/opt/const7.C: Don't use small data on RISC-V. + +2022-05-13 Andrew MacLeod <amacleod@redhat.com> + + * g++.dg/pr104547.C: New. + +2022-05-13 Nathan Sidwell <nathan@acm.org> + + * g++.dg/modules/mod-sym-4.C: New. + +2022-05-13 Alexandre Oliva <oliva@adacore.com> + + * gnat.dg/hardbool.ads: New. + * gnat.dg/hardbool.adb: New. + +2022-05-13 Eric Botcazou <ebotcazou@adacore.com> + + * gnat.dg/sso17.adb: New test. + +2022-05-13 Christophe Lyon <christophe.lyon@arm.com> + + * gcc.target/aarch64/sve/acle/general/attributes_7.c: Make + diagnostic unique. + +2022-05-13 Richard Biener <rguenther@suse.de> + + * gcc.dg/plugin/diagnostic_group_plugin.c: Reorder or remove + gimple-fold.h include. + * gcc.dg/plugin/diagnostic_plugin_show_trees.c: + Likewise. + * gcc.dg/plugin/diagnostic_plugin_test_inlining.c: + Likewise. + * gcc.dg/plugin/diagnostic_plugin_test_metadata.c: + Likewise. + * gcc.dg/plugin/diagnostic_plugin_test_paths.c: + Likewise. + * gcc.dg/plugin/diagnostic_plugin_test_show_locus.c: + Likewise. + * gcc.dg/plugin/diagnostic_plugin_test_string_literals.c: Likewise. + * gcc.dg/plugin/diagnostic_plugin_test_tree_expression_range.c: + Likewise. + * gcc.dg/plugin/finish_unit_plugin.c: Likewise. + * gcc.dg/plugin/ggcplug.c: Likewise. + * gcc.dg/plugin/must_tail_call_plugin.c: Likewise. + * gcc.dg/plugin/one_time_plugin.c: Likewise. + * gcc.dg/plugin/selfassign.c: Likewise. + * gcc.dg/plugin/start_unit_plugin.c: Likewise. + * g++.dg/plugin/selfassign.c: Likewise. + +2022-05-13 Alexandre Oliva <oliva@adacore.com> + + PR rtl-optimization/105455 + * gcc.dg/pr105455.c: New. + +2022-05-13 liuhongt <hongtao.liu@intel.com> + + * gcc.target/i386/pr102583.c: New test. + * gcc.target/i386/pr92645-2.c: Adjust testcase. + * gcc.target/i386/pr92645-3.c: Ditto. + +2022-05-12 David Edelsohn <dje.gcc@gmail.com> + + * g++.target/powerpc/pr101168.C: Require VSX. + +2022-05-12 Richard Biener <rguenther@suse.de> + + PR tree-optimization/105562 + * g++.dg/warn/uninit-pr105562.C: New testcase. + +2022-05-12 Nathan Sidwell <nathan@acm.org> + + * g++.dg/modules/lang-3_a.C: New. + * g++.dg/modules/lang-3_b.C: New. + * g++.dg/modules/lang-3_c.C: New. + +2022-05-12 Haochen Jiang <haochen.jiang@intel.com> + + PR target/104371 + * gcc.target/i386/pr104371-1.c: New test. + * gcc.target/i386/pr104371-2.c: Ditto. + +2022-05-12 Jakub Jelinek <jakub@redhat.com> + + * c-c++-common/gomp/all-memory-1.c: New test. + * c-c++-common/gomp/all-memory-2.c: New test. + * c-c++-common/gomp/all-memory-3.c: New test. + * g++.dg/gomp/all-memory-1.C: New test. + * g++.dg/gomp/all-memory-2.C: New test. + +2022-05-12 jiawei <jiawei@iscas.ac.cn> + + * c-c++-common/Wconversion-1.c: Update type. + 2022-05-11 Jason Merrill <jason@redhat.com> PR c++/105541 diff --git a/gcc/testsuite/g++.dg/modules/lang-3_a.C b/gcc/testsuite/g++.dg/modules/lang-3_a.C new file mode 100644 index 0000000..1c6fa1f --- /dev/null +++ b/gcc/testsuite/g++.dg/modules/lang-3_a.C @@ -0,0 +1,17 @@ +// { dg-additional-options "-fmodules-ts -Wno-pedantic" } +module; +# 4 __FILE__ 1 +void Quux (); +# 6 "" 2 +export module bob; +// { dg-module-cmi bob } + +extern "C++" +{ +export void Bar () {} +export void Quux (); +void Baz () {} +} + +// { dg-final { scan-assembler {_Z3Barv:} } } +// { dg-final { scan-assembler {_Z3Bazv:} } } diff --git a/gcc/testsuite/g++.dg/modules/lang-3_b.C b/gcc/testsuite/g++.dg/modules/lang-3_b.C new file mode 100644 index 0000000..17300ec --- /dev/null +++ b/gcc/testsuite/g++.dg/modules/lang-3_b.C @@ -0,0 +1,18 @@ +// { dg-additional-options -fmodules-ts } +import bob; + +void Foo () +{ + Bar (); + Baz (); // { dg-error "was not declared" } + Quux (); +} + +void Bar (); +void Baz (); + +void Quux () +{ + Bar (); + Baz (); +} diff --git a/gcc/testsuite/g++.dg/modules/lang-3_c.C b/gcc/testsuite/g++.dg/modules/lang-3_c.C new file mode 100644 index 0000000..ca18db7 --- /dev/null +++ b/gcc/testsuite/g++.dg/modules/lang-3_c.C @@ -0,0 +1,12 @@ +// { dg-additional-options -fmodules-ts } +module bob; + +void Foo () +{ + Bar (); + Baz (); +} + +extern "C++" void Bar (); +extern "C++" void Baz (); + diff --git a/gcc/testsuite/g++.dg/modules/mod-sym-4.C b/gcc/testsuite/g++.dg/modules/mod-sym-4.C new file mode 100644 index 0000000..fbf54d0 --- /dev/null +++ b/gcc/testsuite/g++.dg/modules/mod-sym-4.C @@ -0,0 +1,48 @@ +// { dg-additional-options -fmodules-ts } + +// internal linkage symbol mangling is unspecified, but let's try and +// be unchanged from non-module internal mangling. + +export module A; +// { dg-module-cmi A } + +// { dg-final { scan-assembler {_ZL6addonev:} } } +static void addone () {} +// { dg-final { scan-assembler {_ZL1x:} } } +static int x = 5; + +namespace { +// { dg-final { scan-assembler {_ZN12_GLOBAL__N_14frobEv:} } } +void frob () {} +// { dg-final { scan-assembler {_ZN12_GLOBAL__N_11yE:} } } +int y = 2; +struct Bill +{ + void F (); +}; +// { dg-final { scan-assembler {_ZN12_GLOBAL__N_14Bill1FEv:} } } +void Bill::F() {} +} + +// { dg-final { scan-assembler {_ZL4FrobPN12_GLOBAL__N_14BillE:} } } +static void Frob (Bill *b) +{ + if (b) b->F(); +} + +namespace N { +// { dg-final { scan-assembler {_ZN1NL5innerEv:} } } +static void inner() {} +// { dg-final { scan-assembler {_ZN1NL1zE:} } } +static int z = 3; +} + +// { dg-final { scan-assembler {_ZW1A6addsixv:} } } +void addsix () +{ + Frob(nullptr); + frob(); + addone(); + void(x + y + N::z); + N::inner(); +} diff --git a/gcc/testsuite/g++.dg/opt/const7.C b/gcc/testsuite/g++.dg/opt/const7.C index 5bcf948..50d902b 100644 --- a/gcc/testsuite/g++.dg/opt/const7.C +++ b/gcc/testsuite/g++.dg/opt/const7.C @@ -1,6 +1,7 @@ // PR c++/104142 // { dg-do compile { target c++11 } } // { dg-additional-options -Wunused-variable } +// { dg-options "-msmall-data-limit=0" { target { riscv*-*-* } } } struct B { B()=default; }; static const B b_var; // { dg-bogus "" } diff --git a/gcc/testsuite/g++.dg/overload/conv-op4.C b/gcc/testsuite/g++.dg/overload/conv-op4.C new file mode 100644 index 0000000..80de195 --- /dev/null +++ b/gcc/testsuite/g++.dg/overload/conv-op4.C @@ -0,0 +1,22 @@ +// PR c++/81952 +// { dg-do run { target c++11 } } + +template <class T> +struct opt { + opt() { } + opt(opt const& ) { __builtin_abort (); } + opt(opt&& ) { __builtin_abort (); } + + template <class U> + opt(U&& ) { } +}; + +struct foo +{ + explicit operator opt<int>() { __builtin_abort (); return {}; } +}; + +int main() +{ + opt<int> o(foo{}); +} diff --git a/gcc/testsuite/g++.dg/plugin/selfassign.c b/gcc/testsuite/g++.dg/plugin/selfassign.c index 2c60c18..fd78f57 100644 --- a/gcc/testsuite/g++.dg/plugin/selfassign.c +++ b/gcc/testsuite/g++.dg/plugin/selfassign.c @@ -17,12 +17,12 @@ #include "basic-block.h" #include "tree-ssa-alias.h" #include "internal-fn.h" +#include "gimple.h" +#include "gimple-iterator.h" #include "gimple-fold.h" #include "tree-eh.h" #include "gimple-expr.h" #include "is-a.h" -#include "gimple.h" -#include "gimple-iterator.h" #include "tree.h" #include "tree-pass.h" #include "intl.h" diff --git a/gcc/testsuite/g++.dg/pr104547.C b/gcc/testsuite/g++.dg/pr104547.C new file mode 100644 index 0000000..b6135ff --- /dev/null +++ b/gcc/testsuite/g++.dg/pr104547.C @@ -0,0 +1,13 @@ +// { dg-do compile } +// { dg-options "-O3 -fdump-tree-vrp2" } + +#include <vector> + +void shrink(std::vector<int>& v, unsigned n) { + if (v.size() < n) + __builtin_unreachable(); + v.resize(v.size() - n); +} + +// Verify that std::vector<T>::_M_default_append() has been removed by vrp2. +// { dg-final { scan-tree-dump-not "_M_default_append" vrp2 } } diff --git a/gcc/testsuite/g++.dg/pr65240-1.C b/gcc/testsuite/g++.dg/pr65240-1.C deleted file mode 100644 index ff8910d..0000000 --- a/gcc/testsuite/g++.dg/pr65240-1.C +++ /dev/null @@ -1,8 +0,0 @@ -/* { dg-do compile { target { powerpc*-*-* && lp64 } } } */ -/* { dg-skip-if "" { powerpc*-*-darwin* } } */ -/* { dg-require-effective-target powerpc_p8vector_ok } */ -/* { dg-options "-mdejagnu-cpu=power8 -O3 -ffast-math -mcmodel=small -mno-fp-in-toc -Wno-return-type" } */ - -/* target/65240, compiler got a 'insn does not satisfy its constraints' error. */ - -#include "pr65240.h" diff --git a/gcc/testsuite/g++.dg/pr65240-2.C b/gcc/testsuite/g++.dg/pr65240-2.C deleted file mode 100644 index bdb7a62..0000000 --- a/gcc/testsuite/g++.dg/pr65240-2.C +++ /dev/null @@ -1,8 +0,0 @@ -/* { dg-do compile { target { powerpc*-*-* && lp64 } } } */ -/* { dg-skip-if "" { powerpc*-*-darwin* } } */ -/* { dg-require-effective-target powerpc_p8vector_ok } */ -/* { dg-options "-mdejagnu-cpu=power8 -O3 -ffast-math -mcmodel=small -mfp-in-toc -Wno-return-type" } */ - -/* target/65240, compiler got a 'insn does not satisfy its constraints' error. */ - -#include "pr65240.h" diff --git a/gcc/testsuite/g++.dg/pr65240-3.C b/gcc/testsuite/g++.dg/pr65240-3.C deleted file mode 100644 index f37db90..0000000 --- a/gcc/testsuite/g++.dg/pr65240-3.C +++ /dev/null @@ -1,8 +0,0 @@ -/* { dg-do compile { target { powerpc*-*-* && lp64 } } } */ -/* { dg-skip-if "" { powerpc*-*-darwin* } } */ -/* { dg-require-effective-target powerpc_p8vector_ok } */ -/* { dg-options "-mdejagnu-cpu=power8 -O3 -ffast-math -mcmodel=medium -Wno-return-type" } */ - -/* target/65240, compiler got a 'insn does not satisfy its constraints' error. */ - -#include "pr65240.h" diff --git a/gcc/testsuite/g++.dg/warn/uninit-pr105562.C b/gcc/testsuite/g++.dg/warn/uninit-pr105562.C new file mode 100644 index 0000000..ec3a550 --- /dev/null +++ b/gcc/testsuite/g++.dg/warn/uninit-pr105562.C @@ -0,0 +1,10 @@ +// { dg-require-effective-target c++11 } +// { dg-options "-O -Wall -fno-strict-aliasing" } + +#include <regex> + +int main() +{ + std::regex a("."); + std::regex b(std::move(a)); +} diff --git a/gcc/testsuite/g++.target/powerpc/pr101168.C b/gcc/testsuite/g++.target/powerpc/pr101168.C index 284e77f..e0512a9 100644 --- a/gcc/testsuite/g++.target/powerpc/pr101168.C +++ b/gcc/testsuite/g++.target/powerpc/pr101168.C @@ -1,6 +1,6 @@ /* { dg-do compile } */ -/* { dg-require-effective-target powerpc_altivec_ok } */ -/* { dg-options "-maltivec" } */ +/* { dg-require-effective-target powerpc_vsx_ok } */ +/* { dg-options "-mvsx" } */ using vdbl = __vector double; #define BREAK 1 diff --git a/gcc/testsuite/g++.target/powerpc/pr65240-1.C b/gcc/testsuite/g++.target/powerpc/pr65240-1.C new file mode 100644 index 0000000..1cf158c --- /dev/null +++ b/gcc/testsuite/g++.target/powerpc/pr65240-1.C @@ -0,0 +1,8 @@ +/* { dg-skip-if "" { *-*-darwin* } } */ +/* { dg-require-effective-target powerpc_p8vector_ok } */ +/* { dg-options "-mdejagnu-cpu=power8 -O3 -ffast-math -mno-fp-in-toc -Wno-return-type" } */ +/* { dg-additional-options "-mcmodel=small" { target lp64 } } */ + +/* target/65240, compiler got a 'insn does not satisfy its constraints' error. */ + +#include "pr65240.h" diff --git a/gcc/testsuite/g++.target/powerpc/pr65240-2.C b/gcc/testsuite/g++.target/powerpc/pr65240-2.C new file mode 100644 index 0000000..32d1c79 --- /dev/null +++ b/gcc/testsuite/g++.target/powerpc/pr65240-2.C @@ -0,0 +1,8 @@ +/* { dg-skip-if "" { *-*-darwin* } } */ +/* { dg-require-effective-target powerpc_p8vector_ok } */ +/* { dg-options "-mdejagnu-cpu=power8 -O3 -ffast-math -mfp-in-toc -Wno-return-type" } */ +/* { dg-additional-options "-mcmodel=small" { target lp64 } } */ + +/* target/65240, compiler got a 'insn does not satisfy its constraints' error. */ + +#include "pr65240.h" diff --git a/gcc/testsuite/g++.target/powerpc/pr65240-3.C b/gcc/testsuite/g++.target/powerpc/pr65240-3.C new file mode 100644 index 0000000..0256764 --- /dev/null +++ b/gcc/testsuite/g++.target/powerpc/pr65240-3.C @@ -0,0 +1,8 @@ +/* { dg-skip-if "" { *-*-darwin* } } */ +/* { dg-require-effective-target powerpc_p8vector_ok } */ +/* { dg-options "-mdejagnu-cpu=power8 -O3 -ffast-math -Wno-return-type" } */ +/* { dg-additional-options "-mcmodel=medium" { target lp64 } } */ + +/* target/65240, compiler got a 'insn does not satisfy its constraints' error. */ + +#include "pr65240.h" diff --git a/gcc/testsuite/g++.dg/pr65240-4.C b/gcc/testsuite/g++.target/powerpc/pr65240-4.C index efb6a6c..3f6993a 100644 --- a/gcc/testsuite/g++.dg/pr65240-4.C +++ b/gcc/testsuite/g++.target/powerpc/pr65240-4.C @@ -1,5 +1,4 @@ -/* { dg-do compile { target { powerpc*-*-* && lp64 } } } */ -/* { dg-skip-if "" { powerpc*-*-darwin* } } */ +/* { dg-skip-if "" { *-*-darwin* } } */ /* { dg-require-effective-target powerpc_vsx_ok } */ /* { dg-options "-mdejagnu-cpu=power7 -O3 -ffast-math -Wno-return-type" } */ diff --git a/gcc/testsuite/g++.dg/pr65240.h b/gcc/testsuite/g++.target/powerpc/pr65240.h index 6b9c8c0..6b9c8c0 100644 --- a/gcc/testsuite/g++.dg/pr65240.h +++ b/gcc/testsuite/g++.target/powerpc/pr65240.h diff --git a/gcc/testsuite/g++.dg/pr65242.C b/gcc/testsuite/g++.target/powerpc/pr65242.C index 662f375..3f5c2ea 100644 --- a/gcc/testsuite/g++.dg/pr65242.C +++ b/gcc/testsuite/g++.target/powerpc/pr65242.C @@ -1,5 +1,4 @@ -/* { dg-do compile { target { powerpc*-*-* && lp64 } } } */ -/* { dg-skip-if "" { powerpc*-*-darwin* } } */ +/* { dg-skip-if "" { *-*-darwin* } } */ /* { dg-require-effective-target powerpc_p8vector_ok } */ /* { dg-options "-mdejagnu-cpu=power8 -O3" } */ diff --git a/gcc/testsuite/g++.dg/pr67211.C b/gcc/testsuite/g++.target/powerpc/pr67211.C index ac24181..7d5dd42 100644 --- a/gcc/testsuite/g++.dg/pr67211.C +++ b/gcc/testsuite/g++.target/powerpc/pr67211.C @@ -1,5 +1,4 @@ -/* { dg-do compile { target { powerpc*-*-* && lp64 } } } */ -/* { dg-skip-if "" { powerpc*-*-darwin* } } */ +/* { dg-skip-if "" { *-*-darwin* } } */ /* { dg-require-effective-target powerpc_p8vector_ok } */ /* { dg-options "-mdejagnu-cpu=power7 -mdejagnu-tune=power8 -O3 -w" } */ diff --git a/gcc/testsuite/g++.dg/pr69667.C b/gcc/testsuite/g++.target/powerpc/pr69667.C index 422116d..da550cd 100644 --- a/gcc/testsuite/g++.dg/pr69667.C +++ b/gcc/testsuite/g++.target/powerpc/pr69667.C @@ -1,5 +1,4 @@ -/* { dg-do compile { target { powerpc*-*-* && lp64 } } } */ -/* { dg-skip-if "" { powerpc*-*-darwin* } } */ +/* { dg-skip-if "" { *-*-darwin* } } */ /* { dg-require-effective-target powerpc_p8vector_ok } */ /* { dg-options "-mdejagnu-cpu=power8 -w -std=c++14" } */ diff --git a/gcc/testsuite/g++.dg/pr71294.C b/gcc/testsuite/g++.target/powerpc/pr71294.C index 716fa0d..7f12c8d 100644 --- a/gcc/testsuite/g++.dg/pr71294.C +++ b/gcc/testsuite/g++.target/powerpc/pr71294.C @@ -1,4 +1,3 @@ -// { dg-do compile { target { powerpc64*-*-* && lp64 } } } // { dg-require-effective-target powerpc_p8vector_ok } */ // { dg-options "-mdejagnu-cpu=power8 -O3 -fstack-protector" } diff --git a/gcc/testsuite/g++.dg/pr84264.C b/gcc/testsuite/g++.target/powerpc/pr84264.C index 4f8a77d..c9968cf 100644 --- a/gcc/testsuite/g++.dg/pr84264.C +++ b/gcc/testsuite/g++.target/powerpc/pr84264.C @@ -1,4 +1,4 @@ -/* { dg-do compile { target { powerpc*-*-* } } } */ +/* { dg-do compile } */ /* { dg-options "-w -O1 -fstack-protector-strong" } */ void _setjmp (); diff --git a/gcc/testsuite/g++.dg/pr84279.C b/gcc/testsuite/g++.target/powerpc/pr84279.C index e78201c..0263242 100644 --- a/gcc/testsuite/g++.dg/pr84279.C +++ b/gcc/testsuite/g++.target/powerpc/pr84279.C @@ -1,5 +1,5 @@ -/* { dg-do compile { target { powerpc*-*-* } } } */ -/* { dg-skip-if "" { powerpc*-*-darwin* } } */ +/* { dg-do compile } */ +/* { dg-skip-if "" { *-*-darwin* } } */ /* { dg-require-effective-target powerpc_p8vector_ok } */ /* { dg-require-effective-target fpic } */ /* { dg-options "-O3 -mdejagnu-cpu=power8 -g -fPIC -fvisibility=hidden -fstack-protector-strong" } */ diff --git a/gcc/testsuite/g++.dg/pr85657.C b/gcc/testsuite/g++.target/powerpc/pr85657.C index e62b62a..3a38654 100644 --- a/gcc/testsuite/g++.dg/pr85657.C +++ b/gcc/testsuite/g++.target/powerpc/pr85657.C @@ -1,4 +1,4 @@ -// { dg-do compile { target { powerpc*-*-linux* } } } +// { dg-do compile { target { *-*-linux* } } } // { dg-require-effective-target ppc_float128_sw } // { dg-options "-mvsx -mfloat128 -O2 -mabi=ibmlongdouble -Wno-psabi" } diff --git a/gcc/testsuite/g++.dg/pr93974.C b/gcc/testsuite/g++.target/powerpc/pr93974.C index 562de0a..562de0a 100644 --- a/gcc/testsuite/g++.dg/pr93974.C +++ b/gcc/testsuite/g++.target/powerpc/pr93974.C diff --git a/gcc/testsuite/gcc.dg/debug/btf/btf-datasec-1.c b/gcc/testsuite/gcc.dg/debug/btf/btf-datasec-1.c index dbb236b..77df886 100644 --- a/gcc/testsuite/gcc.dg/debug/btf/btf-datasec-1.c +++ b/gcc/testsuite/gcc.dg/debug/btf/btf-datasec-1.c @@ -12,6 +12,7 @@ /* { dg-do compile ) */ /* { dg-options "-O0 -gbtf -dA" } */ /* { dg-options "-O0 -gbtf -dA -msdata=none" { target { { powerpc*-*-* } && ilp32 } } } */ +/* { dg-options "-O0 -gbtf -dA -msmall-data-limit=0" { target { riscv*-*-* } } } */ /* { dg-options "-O0 -gbtf -dA -G0" { target { nios2-*-* } } } */ /* Check for two DATASEC entries with vlen 3, and one with vlen 1. */ diff --git a/gcc/testsuite/gcc.dg/plugin/diagnostic_group_plugin.c b/gcc/testsuite/gcc.dg/plugin/diagnostic_group_plugin.c index 67ca701..3396b38 100644 --- a/gcc/testsuite/gcc.dg/plugin/diagnostic_group_plugin.c +++ b/gcc/testsuite/gcc.dg/plugin/diagnostic_group_plugin.c @@ -15,12 +15,12 @@ #include "basic-block.h" #include "tree-ssa-alias.h" #include "internal-fn.h" +#include "gimple.h" +#include "gimple-iterator.h" #include "gimple-fold.h" #include "tree-eh.h" #include "gimple-expr.h" #include "is-a.h" -#include "gimple.h" -#include "gimple-iterator.h" #include "tree.h" #include "tree-pass.h" #include "intl.h" diff --git a/gcc/testsuite/gcc.dg/plugin/diagnostic_plugin_show_trees.c b/gcc/testsuite/gcc.dg/plugin/diagnostic_plugin_show_trees.c index ac72503..d81fa57 100644 --- a/gcc/testsuite/gcc.dg/plugin/diagnostic_plugin_show_trees.c +++ b/gcc/testsuite/gcc.dg/plugin/diagnostic_plugin_show_trees.c @@ -17,12 +17,12 @@ #include "basic-block.h" #include "tree-ssa-alias.h" #include "internal-fn.h" +#include "gimple.h" +#include "gimple-iterator.h" #include "gimple-fold.h" #include "tree-eh.h" #include "gimple-expr.h" #include "is-a.h" -#include "gimple.h" -#include "gimple-iterator.h" #include "tree.h" #include "tree-pass.h" #include "intl.h" diff --git a/gcc/testsuite/gcc.dg/plugin/diagnostic_plugin_test_inlining.c b/gcc/testsuite/gcc.dg/plugin/diagnostic_plugin_test_inlining.c index d2bfca0..3627f7a 100644 --- a/gcc/testsuite/gcc.dg/plugin/diagnostic_plugin_test_inlining.c +++ b/gcc/testsuite/gcc.dg/plugin/diagnostic_plugin_test_inlining.c @@ -15,12 +15,12 @@ #include "basic-block.h" #include "tree-ssa-alias.h" #include "internal-fn.h" +#include "gimple.h" +#include "gimple-iterator.h" #include "gimple-fold.h" #include "tree-eh.h" #include "gimple-expr.h" #include "is-a.h" -#include "gimple.h" -#include "gimple-iterator.h" #include "tree.h" #include "tree-pass.h" #include "intl.h" diff --git a/gcc/testsuite/gcc.dg/plugin/diagnostic_plugin_test_metadata.c b/gcc/testsuite/gcc.dg/plugin/diagnostic_plugin_test_metadata.c index a610891..4b13afc 100644 --- a/gcc/testsuite/gcc.dg/plugin/diagnostic_plugin_test_metadata.c +++ b/gcc/testsuite/gcc.dg/plugin/diagnostic_plugin_test_metadata.c @@ -15,12 +15,12 @@ #include "basic-block.h" #include "tree-ssa-alias.h" #include "internal-fn.h" +#include "gimple.h" +#include "gimple-iterator.h" #include "gimple-fold.h" #include "tree-eh.h" #include "gimple-expr.h" #include "is-a.h" -#include "gimple.h" -#include "gimple-iterator.h" #include "tree.h" #include "tree-pass.h" #include "intl.h" diff --git a/gcc/testsuite/gcc.dg/plugin/diagnostic_plugin_test_paths.c b/gcc/testsuite/gcc.dg/plugin/diagnostic_plugin_test_paths.c index 5c2da02..8d97fe8 100644 --- a/gcc/testsuite/gcc.dg/plugin/diagnostic_plugin_test_paths.c +++ b/gcc/testsuite/gcc.dg/plugin/diagnostic_plugin_test_paths.c @@ -21,12 +21,12 @@ #include "basic-block.h" #include "tree-ssa-alias.h" #include "internal-fn.h" +#include "gimple.h" +#include "gimple-iterator.h" #include "gimple-fold.h" #include "tree-eh.h" #include "gimple-expr.h" #include "is-a.h" -#include "gimple.h" -#include "gimple-iterator.h" #include "tree.h" #include "tree-pass.h" #include "intl.h" diff --git a/gcc/testsuite/gcc.dg/plugin/diagnostic_plugin_test_show_locus.c b/gcc/testsuite/gcc.dg/plugin/diagnostic_plugin_test_show_locus.c index 482dbda..baa6b62 100644 --- a/gcc/testsuite/gcc.dg/plugin/diagnostic_plugin_test_show_locus.c +++ b/gcc/testsuite/gcc.dg/plugin/diagnostic_plugin_test_show_locus.c @@ -47,12 +47,12 @@ #include "basic-block.h" #include "tree-ssa-alias.h" #include "internal-fn.h" +#include "gimple.h" +#include "gimple-iterator.h" #include "gimple-fold.h" #include "tree-eh.h" #include "gimple-expr.h" #include "is-a.h" -#include "gimple.h" -#include "gimple-iterator.h" #include "tree.h" #include "tree-pass.h" #include "intl.h" diff --git a/gcc/testsuite/gcc.dg/plugin/diagnostic_plugin_test_string_literals.c b/gcc/testsuite/gcc.dg/plugin/diagnostic_plugin_test_string_literals.c index aa73dca..0269f72 100644 --- a/gcc/testsuite/gcc.dg/plugin/diagnostic_plugin_test_string_literals.c +++ b/gcc/testsuite/gcc.dg/plugin/diagnostic_plugin_test_string_literals.c @@ -17,12 +17,12 @@ #include "basic-block.h" #include "tree-ssa-alias.h" #include "internal-fn.h" +#include "gimple.h" +#include "gimple-iterator.h" #include "gimple-fold.h" #include "tree-eh.h" #include "gimple-expr.h" #include "is-a.h" -#include "gimple.h" -#include "gimple-iterator.h" #include "tree.h" #include "tree-pass.h" #include "intl.h" diff --git a/gcc/testsuite/gcc.dg/plugin/diagnostic_plugin_test_tree_expression_range.c b/gcc/testsuite/gcc.dg/plugin/diagnostic_plugin_test_tree_expression_range.c index 4a89d84..f546863 100644 --- a/gcc/testsuite/gcc.dg/plugin/diagnostic_plugin_test_tree_expression_range.c +++ b/gcc/testsuite/gcc.dg/plugin/diagnostic_plugin_test_tree_expression_range.c @@ -17,12 +17,12 @@ #include "basic-block.h" #include "tree-ssa-alias.h" #include "internal-fn.h" +#include "gimple.h" +#include "gimple-iterator.h" #include "gimple-fold.h" #include "tree-eh.h" #include "gimple-expr.h" #include "is-a.h" -#include "gimple.h" -#include "gimple-iterator.h" #include "tree.h" #include "tree-pass.h" #include "intl.h" diff --git a/gcc/testsuite/gcc.dg/plugin/finish_unit_plugin.c b/gcc/testsuite/gcc.dg/plugin/finish_unit_plugin.c index 1b4f7cc..05e1881 100644 --- a/gcc/testsuite/gcc.dg/plugin/finish_unit_plugin.c +++ b/gcc/testsuite/gcc.dg/plugin/finish_unit_plugin.c @@ -15,7 +15,6 @@ #include "basic-block.h" #include "tree-ssa-alias.h" #include "internal-fn.h" -#include "gimple-fold.h" #include "tree-eh.h" #include "gimple-expr.h" #include "is-a.h" diff --git a/gcc/testsuite/gcc.dg/plugin/ggcplug.c b/gcc/testsuite/gcc.dg/plugin/ggcplug.c index c186d11..a75eed0 100644 --- a/gcc/testsuite/gcc.dg/plugin/ggcplug.c +++ b/gcc/testsuite/gcc.dg/plugin/ggcplug.c @@ -14,7 +14,6 @@ #include "ggc.h" #include "tree-ssa-alias.h" #include "internal-fn.h" -#include "gimple-fold.h" #include "tree-eh.h" #include "gimple-expr.h" #include "is-a.h" diff --git a/gcc/testsuite/gcc.dg/plugin/must_tail_call_plugin.c b/gcc/testsuite/gcc.dg/plugin/must_tail_call_plugin.c index 5294f28..0c040e5 100644 --- a/gcc/testsuite/gcc.dg/plugin/must_tail_call_plugin.c +++ b/gcc/testsuite/gcc.dg/plugin/must_tail_call_plugin.c @@ -17,7 +17,6 @@ #include "basic-block.h" #include "tree-ssa-alias.h" #include "internal-fn.h" -#include "gimple-fold.h" #include "tree-eh.h" #include "gimple-expr.h" #include "is-a.h" diff --git a/gcc/testsuite/gcc.dg/plugin/one_time_plugin.c b/gcc/testsuite/gcc.dg/plugin/one_time_plugin.c index bd1c0f0..84f2d31 100644 --- a/gcc/testsuite/gcc.dg/plugin/one_time_plugin.c +++ b/gcc/testsuite/gcc.dg/plugin/one_time_plugin.c @@ -12,7 +12,6 @@ #include "basic-block.h" #include "tree-ssa-alias.h" #include "internal-fn.h" -#include "gimple-fold.h" #include "tree-eh.h" #include "gimple-expr.h" #include "is-a.h" diff --git a/gcc/testsuite/gcc.dg/plugin/selfassign.c b/gcc/testsuite/gcc.dg/plugin/selfassign.c index 2adb644..13b3eca 100644 --- a/gcc/testsuite/gcc.dg/plugin/selfassign.c +++ b/gcc/testsuite/gcc.dg/plugin/selfassign.c @@ -17,12 +17,12 @@ #include "basic-block.h" #include "tree-ssa-alias.h" #include "internal-fn.h" +#include "gimple.h" +#include "gimple-iterator.h" #include "gimple-fold.h" #include "tree-eh.h" #include "gimple-expr.h" #include "is-a.h" -#include "gimple.h" -#include "gimple-iterator.h" #include "tree.h" #include "tree-pass.h" #include "intl.h" diff --git a/gcc/testsuite/gcc.dg/plugin/start_unit_plugin.c b/gcc/testsuite/gcc.dg/plugin/start_unit_plugin.c index 61e9494..7b4f40e 100644 --- a/gcc/testsuite/gcc.dg/plugin/start_unit_plugin.c +++ b/gcc/testsuite/gcc.dg/plugin/start_unit_plugin.c @@ -20,7 +20,6 @@ #include "basic-block.h" #include "tree-ssa-alias.h" #include "internal-fn.h" -#include "gimple-fold.h" #include "tree-eh.h" #include "gimple-expr.h" #include "is-a.h" diff --git a/gcc/testsuite/gcc.dg/pr105455.c b/gcc/testsuite/gcc.dg/pr105455.c new file mode 100644 index 0000000..81e9154 --- /dev/null +++ b/gcc/testsuite/gcc.dg/pr105455.c @@ -0,0 +1,17 @@ +/* { dg-do compile } */ +/* { dg-options "-O1 -fharden-conditional-branches -funroll-loops --param max-loop-header-insns=1" } */ + +__attribute__ ((cold)) void +bar (void); + +void +foo (int x) +{ + if (x) + { + int i; + + for (i = 0; i < 101; ++i) + bar (); + } +} diff --git a/gcc/testsuite/gcc.dg/pr105597.c b/gcc/testsuite/gcc.dg/pr105597.c new file mode 100644 index 0000000..e463ec6 --- /dev/null +++ b/gcc/testsuite/gcc.dg/pr105597.c @@ -0,0 +1,27 @@ +/* PR tree-optimization/105597 */ +/* { dg-do compile } */ +/* { dg-options "-O2 -Wno-int-conversion" } */ + +typedef struct { + int allocated; +} vvec; + +int vvneeds_want, mgpssort; + +void vvinit(vvec *v, int minelems) { v->allocated = -minelems; } + +void vvneeds(vvec *v, int needed) { + if (needed > v->allocated) + if (v->allocated < 0) + ; + else { + int next = v->allocated + (v->allocated >> 1); + vvneeds_want = next; + } +} + +void mgpssort_1() { + vvinit((vvec *) &mgpssort, mgpssort_1); + vvneeds((vvec *) &mgpssort, mgpssort_1); +} + diff --git a/gcc/testsuite/gcc.dg/pr90838.c b/gcc/testsuite/gcc.dg/pr90838.c index 41c5dab..7502b84 100644 --- a/gcc/testsuite/gcc.dg/pr90838.c +++ b/gcc/testsuite/gcc.dg/pr90838.c @@ -1,5 +1,8 @@ /* { dg-do compile } */ /* { dg-options "-O2 -fdump-tree-forwprop2-details" } */ +/* { dg-additional-options "-mbmi" { target { { i?86-*-* x86_64-*-* } && { ! { ia32 } } } } } */ +/* { dg-additional-options "-march=rv64gc_zbb" { target { rv64 } } } */ +/* { dg-additional-options "-march=rv32gc_zbb" { target { rv32 } } } */ int ctz1 (unsigned x) { @@ -56,4 +59,26 @@ int ctz4 (unsigned long x) return table[(lsb * magic) >> 58]; } +/* { dg-final { scan-tree-dump-times {= \.CTZ} 4 "forwprop2" { target { { i?86-*-* x86_64-*-* } && { ! { ia32 } } } } } } */ +/* { dg-final { scan-assembler-times "tzcntq\t" 1 { target { { i?86-*-* x86_64-*-* } && { ! { ia32 } } } } } } */ +/* { dg-final { scan-assembler-times "tzcntl\t" 3 { target { { i?86-*-* x86_64-*-* } && { ! { ia32 } } } } } } */ +/* { dg-final { scan-assembler-times "andl\t" 2 { target { { i?86-*-* x86_64-*-* } && { ! { ia32 } } } } } } */ +/* { dg-final { scan-assembler-not "negq" { target { { i?86-*-* x86_64-*-* } && { ! { ia32 } } } } } } */ +/* { dg-final { scan-assembler-not "imulq" { target { { i?86-*-* x86_64-*-* } && { ! { ia32 } } } } } } */ +/* { dg-final { scan-assembler-not "shrq" { target { { i?86-*-* x86_64-*-* } && { ! { ia32 } } } } } } */ + /* { dg-final { scan-tree-dump-times {= \.CTZ} 4 "forwprop2" { target aarch64*-*-* } } } */ +/* { dg-final { scan-assembler-times "clz\t" 4 { target aarch64*-*-* } } } */ +/* { dg-final { scan-assembler-times "and\t" 2 { target aarch64*-*-* } } } */ +/* { dg-final { scan-assembler-not "cmp\t.*0" { target aarch64*-*-* } } } */ + +/* { dg-final { scan-tree-dump-times {= \.CTZ} 4 "forwprop2" { target { rv64 } } } } */ +/* { dg-final { scan-assembler-times "ctz\t" 1 { target { rv64 } } } } */ +/* { dg-final { scan-assembler-times "ctzw\t" 3 { target { rv64 } } } } */ +/* { dg-final { scan-assembler-times "andi\t" 2 { target { rv64 } } } } */ +/* { dg-final { scan-assembler-not "mul" { target { rv64 } } } } */ + +/* { dg-final { scan-tree-dump-times {= \.CTZ} 3 "forwprop2" { target { rv32 } } } } */ +/* { dg-final { scan-assembler-times "ctz\t" 3 { target { rv32 } } } } */ +/* { dg-final { scan-assembler-times "andi\t" 1 { target { rv32 } } } } */ +/* { dg-final { scan-assembler-times "mul\t" 1 { target { rv32 } } } } */ diff --git a/gcc/testsuite/gcc.dg/tree-ssa/pr83907-1.c b/gcc/testsuite/gcc.dg/tree-ssa/pr83907-1.c new file mode 100644 index 0000000..2a6f4f5 --- /dev/null +++ b/gcc/testsuite/gcc.dg/tree-ssa/pr83907-1.c @@ -0,0 +1,13 @@ +/* { dg-do compile } */ +/* { dg-options "-O2 -fdump-tree-optimized" } */ + +extern char str[]; + +unsigned int foo() +{ + __builtin_memset(str,'x',5); + str[5] = 0; + return __builtin_strlen (str); +} + +/* { dg-final { scan-tree-dump-not "strlen" "optimized" } } */ diff --git a/gcc/testsuite/gcc.dg/tree-ssa/pr83907-2.c b/gcc/testsuite/gcc.dg/tree-ssa/pr83907-2.c new file mode 100644 index 0000000..cc27504 --- /dev/null +++ b/gcc/testsuite/gcc.dg/tree-ssa/pr83907-2.c @@ -0,0 +1,14 @@ +/* { dg-do compile } */ +/* { dg-options "-O2 -fdump-tree-optimized" } */ + +extern char str[]; + +unsigned int foo() +{ + __builtin_memset(str,'x',5); + str[5] = 0; + str[6] = 'z'; + return __builtin_strlen (str); +} + +/* { dg-final { scan-tree-dump-not "strlen" "optimized" } } */ diff --git a/gcc/testsuite/gcc.target/aarch64/pr90838.c b/gcc/testsuite/gcc.target/aarch64/pr90838.c deleted file mode 100644 index e1e19ac..0000000 --- a/gcc/testsuite/gcc.target/aarch64/pr90838.c +++ /dev/null @@ -1,64 +0,0 @@ -/* { dg-do compile } */ -/* { dg-options "-O2" } */ - -int ctz1 (unsigned x) -{ - static const char table[32] = - { - 0, 1, 28, 2, 29, 14, 24, 3, 30, 22, 20, 15, 25, 17, 4, 8, - 31, 27, 13, 23, 21, 19, 16, 7, 26, 12, 18, 6, 11, 5, 10, 9 - }; - - return table[((unsigned)((x & -x) * 0x077CB531U)) >> 27]; -} - -int ctz2 (unsigned x) -{ -#define u 0 - static short table[64] = - { - 32, 0, 1,12, 2, 6, u,13, 3, u, 7, u, u, u, u,14, - 10, 4, u, u, 8, u, u,25, u, u, u, u, u,21,27,15, - 31,11, 5, u, u, u, u, u, 9, u, u,24, u, u,20,26, - 30, u, u, u, u,23, u,19,29, u,22,18,28,17,16, u - }; - - x = (x & -x) * 0x0450FBAF; - return table[x >> 26]; -} - -int ctz3 (unsigned x) -{ - static int table[32] = - { - 0, 1, 2,24, 3,19, 6,25, 22, 4,20,10,16, 7,12,26, - 31,23,18, 5,21, 9,15,11,30,17, 8,14,29,13,28,27 - }; - - if (x == 0) return 32; - x = (x & -x) * 0x04D7651F; - return table[x >> 27]; -} - -static const unsigned long long magic = 0x03f08c5392f756cdULL; - -static const char table[64] = { - 0, 1, 12, 2, 13, 22, 17, 3, - 14, 33, 23, 36, 18, 58, 28, 4, - 62, 15, 34, 26, 24, 48, 50, 37, - 19, 55, 59, 52, 29, 44, 39, 5, - 63, 11, 21, 16, 32, 35, 57, 27, - 61, 25, 47, 49, 54, 51, 43, 38, - 10, 20, 31, 56, 60, 46, 53, 42, - 9, 30, 45, 41, 8, 40, 7, 6, -}; - -int ctz4 (unsigned long x) -{ - unsigned long lsb = x & -x; - return table[(lsb * magic) >> 58]; -} - -/* { dg-final { scan-assembler-times "clz\t" 4 } } */ -/* { dg-final { scan-assembler-times "and\t" 2 } } */ -/* { dg-final { scan-assembler-not "cmp\t.*0" } } */ diff --git a/gcc/testsuite/gcc.target/aarch64/sve/acle/general/attributes_7.c b/gcc/testsuite/gcc.target/aarch64/sve/acle/general/attributes_7.c index 621666c..95be605 100644 --- a/gcc/testsuite/gcc.target/aarch64/sve/acle/general/attributes_7.c +++ b/gcc/testsuite/gcc.target/aarch64/sve/acle/general/attributes_7.c @@ -95,9 +95,9 @@ f (int c) fb = sb; (void) (c ? sb : sb); - (void) (c ? sb : fb); // { dg-error {type mismatch|different types} "" { xfail c } } + (void) (c ? sb : fb); // { dg-error {type mismatch|different types} "$tool" { xfail c } } - (void) (c ? fb : sb); // { dg-error {type mismatch|different types} "" { xfail c } } + (void) (c ? fb : sb); // { dg-error {type mismatch|different types} "$tool" { xfail c } } (void) (c ? fb : fb); } diff --git a/gcc/testsuite/gcc.target/aarch64/sync-comp-swap-ool.c b/gcc/testsuite/gcc.target/aarch64/sync-comp-swap-ool.c new file mode 100644 index 0000000..372f4aa --- /dev/null +++ b/gcc/testsuite/gcc.target/aarch64/sync-comp-swap-ool.c @@ -0,0 +1,6 @@ +/* { dg-do compile } */ +/* { dg-options "-march=armv8-a+nolse -O2 -fno-ipa-icf -moutline-atomics" } */ + +#include "sync-comp-swap.x" + +/* { dg-final { scan-assembler-times "bl.*__aarch64_cas4_sync" 1 } } */ diff --git a/gcc/testsuite/gcc.target/aarch64/sync-op-acquire-ool.c b/gcc/testsuite/gcc.target/aarch64/sync-op-acquire-ool.c new file mode 100644 index 0000000..95d9c56 --- /dev/null +++ b/gcc/testsuite/gcc.target/aarch64/sync-op-acquire-ool.c @@ -0,0 +1,6 @@ +/* { dg-do compile } */ +/* { dg-options "-march=armv8-a+nolse -O2 -moutline-atomics" } */ + +#include "sync-op-acquire.x" + +/* { dg-final { scan-assembler-times "bl.*__aarch64_swp4_sync" 1 } } */ diff --git a/gcc/testsuite/gcc.target/aarch64/sync-op-full-ool.c b/gcc/testsuite/gcc.target/aarch64/sync-op-full-ool.c new file mode 100644 index 0000000..2f3881d --- /dev/null +++ b/gcc/testsuite/gcc.target/aarch64/sync-op-full-ool.c @@ -0,0 +1,9 @@ +/* { dg-do compile } */ +/* { dg-options "-march=armv8-a+nolse -O2 -moutline-atomics" } */ + +#include "sync-op-full.x" + +/* { dg-final { scan-assembler-times "bl.*__aarch64_ldadd4_sync" 1 } } */ +/* { dg-final { scan-assembler-times "bl.*__aarch64_ldclr4_sync" 1 } } */ +/* { dg-final { scan-assembler-times "bl.*__aarch64_ldeor4_sync" 1 } } */ +/* { dg-final { scan-assembler-times "bl.*__aarch64_ldset4_sync" 1 } } */ diff --git a/gcc/testsuite/gcc.target/aarch64/target_attr_20.c b/gcc/testsuite/gcc.target/aarch64/target_attr_20.c index 509fb03..c9454fc 100644 --- a/gcc/testsuite/gcc.target/aarch64/target_attr_20.c +++ b/gcc/testsuite/gcc.target/aarch64/target_attr_20.c @@ -24,4 +24,4 @@ bar (void) } } -/* { dg-final { scan-assembler-not "bl.*__aarch64_cas2_acq_rel" } } */ +/* { dg-final { scan-assembler-not "bl.*__aarch64_cas2_sync" } } */ diff --git a/gcc/testsuite/gcc.target/aarch64/target_attr_21.c b/gcc/testsuite/gcc.target/aarch64/target_attr_21.c index acace4c..b8e5622 100644 --- a/gcc/testsuite/gcc.target/aarch64/target_attr_21.c +++ b/gcc/testsuite/gcc.target/aarch64/target_attr_21.c @@ -24,4 +24,4 @@ bar (void) } } -/* { dg-final { scan-assembler-times "bl.*__aarch64_cas2_acq_rel" 1 } } */ +/* { dg-final { scan-assembler-times "bl.*__aarch64_cas2_sync" 1 } } */ diff --git a/gcc/testsuite/gcc.target/i386/pr102583.c b/gcc/testsuite/gcc.target/i386/pr102583.c new file mode 100644 index 0000000..4ef2f29 --- /dev/null +++ b/gcc/testsuite/gcc.target/i386/pr102583.c @@ -0,0 +1,30 @@ +/* { dg-do compile } */ +/* { dg-options "-mavx512f -O2" } */ +/* { dg-final { scan-assembler-times {(?n)vcvtdq2ps[ \t]+32\(%.*%ymm} 1 } } */ +/* { dg-final { scan-assembler-times {(?n)vcvtdq2ps[ \t]+16\(%.*%xmm} 1 } } */ +/* { dg-final { scan-assembler-times {(?n)vmovq[ \t]+16\(%.*%xmm} 1 { target { ! ia32 } } } } */ +/* { dg-final { scan-assembler-not {(?n)vpermd[ \t]+.*%zmm} } } */ + +typedef int v16si __attribute__((vector_size(64))); +typedef float v8sf __attribute__((vector_size(32))); +typedef float v4sf __attribute__((vector_size(16))); +typedef float v2sf __attribute__((vector_size(8))); + +v8sf part (v16si *srcp) +{ + v16si src = *srcp; + return (v8sf) { (float)src[8], (float) src[9], (float)src[10], (float)src[11], + (float)src[12], (float)src[13], (float)src[14], (float)src[15] }; +} + +v4sf part1 (v16si *srcp) +{ + v16si src = *srcp; + return (v4sf) { (float)src[4], (float)src[5], (float)src[6], (float)src[7] }; +} + +v2sf part2 (v16si *srcp) +{ + v16si src = *srcp; + return (v2sf) { (float)src[4], (float)src[5] }; +} diff --git a/gcc/testsuite/gcc.target/i386/pr104371-1.c b/gcc/testsuite/gcc.target/i386/pr104371-1.c new file mode 100644 index 0000000..b4373c5 --- /dev/null +++ b/gcc/testsuite/gcc.target/i386/pr104371-1.c @@ -0,0 +1,13 @@ +/* { dg-do compile } */ +/* { dg-options "-O2 -msse4" } */ +/* { dg-final { scan-assembler "ptest\[ \\t\]" } } */ +/* { dg-final { scan-assembler-not "pxor\[ \\t\]" } } */ +/* { dg-final { scan-assembler-not "pcmpeqb\[ \\t\]" } } */ +/* { dg-final { scan-assembler-not "pmovmskb\[ \\t\]" } } */ + +#include <smmintrin.h> + +int is_zero(__m128i x) +{ + return _mm_movemask_epi8(_mm_cmpeq_epi8(x, _mm_setzero_si128())) == 0xffff; +} diff --git a/gcc/testsuite/gcc.target/i386/pr104371-2.c b/gcc/testsuite/gcc.target/i386/pr104371-2.c new file mode 100755 index 0000000..3431ffc --- /dev/null +++ b/gcc/testsuite/gcc.target/i386/pr104371-2.c @@ -0,0 +1,13 @@ +/* { dg-do compile } */ +/* { dg-options "-O2 -mavx2" } */ +/* { dg-final { scan-assembler "vptest\[ \\t\]" } } */ +/* { dg-final { scan-assembler-not "vpxor\[ \\t\]" } } */ +/* { dg-final { scan-assembler-not "vpcmpeqb\[ \\t\]" } } */ +/* { dg-final { scan-assembler-not "vpmovmskb\[ \\t\]" } } */ + +#include <immintrin.h> + +int is_zero256(__m256i x) +{ + return _mm256_movemask_epi8(_mm256_cmpeq_epi8(x, _mm256_setzero_si256())) == 0xffffffff; +} diff --git a/gcc/testsuite/gcc.target/i386/pr92645-2.c b/gcc/testsuite/gcc.target/i386/pr92645-2.c index d34ed3a..f0608de 100644 --- a/gcc/testsuite/gcc.target/i386/pr92645-2.c +++ b/gcc/testsuite/gcc.target/i386/pr92645-2.c @@ -29,6 +29,6 @@ void odd (v2si *dst, v4si *srcp) } /* { dg-final { scan-tree-dump-times "BIT_FIELD_REF" 4 "cddce1" } } */ -/* { dg-final { scan-tree-dump-times "VEC_PERM_EXPR" 3 "cddce1" } } */ +/* { dg-final { scan-tree-dump-times "VEC_PERM_EXPR" 3 "cddce1" { xfail *-*-* } } } */ /* Ideally highpart extraction would elide the permutation as well. */ -/* { dg-final { scan-tree-dump-times "VEC_PERM_EXPR" 2 "cddce1" { xfail *-*-* } } } */ +/* { dg-final { scan-tree-dump-times "VEC_PERM_EXPR" 2 "cddce1" } } */ diff --git a/gcc/testsuite/gcc.target/i386/pr92645-3.c b/gcc/testsuite/gcc.target/i386/pr92645-3.c index 9c08c9f..6910111 100644 --- a/gcc/testsuite/gcc.target/i386/pr92645-3.c +++ b/gcc/testsuite/gcc.target/i386/pr92645-3.c @@ -32,6 +32,6 @@ void odd (v4sf *dst, v8si *srcp) /* Four conversions, on the smaller vector type, to not convert excess elements. */ /* { dg-final { scan-tree-dump-times " = \\\(vector\\\(4\\\) float\\\)" 4 "cddce1" } } */ -/* { dg-final { scan-tree-dump-times "VEC_PERM_EXPR" 3 "cddce1" } } */ +/* { dg-final { scan-tree-dump-times "VEC_PERM_EXPR" 3 "cddce1" { xfail *-*-* } } } */ /* Ideally highpart extraction would elide the VEC_PERM_EXPR as well. */ -/* { dg-final { scan-tree-dump-times "VEC_PERM_EXPR" 2 "cddce1" { xfail *-*-* } } } */ +/* { dg-final { scan-tree-dump-times "VEC_PERM_EXPR" 2 "cddce1" } } */ diff --git a/gcc/testsuite/gcc.target/i386/pr95863-2.c b/gcc/testsuite/gcc.target/i386/pr95863-2.c deleted file mode 100644 index cb56dfc..0000000 --- a/gcc/testsuite/gcc.target/i386/pr95863-2.c +++ /dev/null @@ -1,27 +0,0 @@ -/* { dg-do compile { target { ! ia32 } } } */ -/* { dg-options "-O -mbmi" } */ - -static const unsigned long long magic = 0x03f08c5392f756cdULL; - -static const char table[64] = { - 0, 1, 12, 2, 13, 22, 17, 3, - 14, 33, 23, 36, 18, 58, 28, 4, - 62, 15, 34, 26, 24, 48, 50, 37, - 19, 55, 59, 52, 29, 44, 39, 5, - 63, 11, 21, 16, 32, 35, 57, 27, - 61, 25, 47, 49, 54, 51, 43, 38, - 10, 20, 31, 56, 60, 46, 53, 42, - 9, 30, 45, 41, 8, 40, 7, 6, -}; - -int ctz4 (unsigned long long x) -{ - unsigned long long lsb = x & -x; - return table[(lsb * magic) >> 58]; -} - -/* { dg-final { scan-assembler-times "tzcntq\t" 1 } } */ -/* { dg-final { scan-assembler-times "andl\t" 1 } } */ -/* { dg-final { scan-assembler-not "negq" } } */ -/* { dg-final { scan-assembler-not "imulq" } } */ -/* { dg-final { scan-assembler-not "shrq" } } */ diff --git a/gcc/testsuite/gcc.target/i386/sse2-v1ti-veq.c b/gcc/testsuite/gcc.target/i386/sse2-v1ti-veq.c new file mode 100644 index 0000000..b3837c4 --- /dev/null +++ b/gcc/testsuite/gcc.target/i386/sse2-v1ti-veq.c @@ -0,0 +1,12 @@ +/* { dg-do compile { target int128 } } */ +/* { dg-options "-O2 -msse2" } */ +typedef unsigned __int128 uv1ti __attribute__ ((__vector_size__ (16))); +typedef unsigned long long uv2di __attribute__ ((__vector_size__ (16))); +typedef unsigned int uv4si __attribute__ ((__vector_size__ (16))); + +uv1ti eq_v1ti(uv1ti x, uv1ti y) { return x == y; } +uv2di eq_v2di(uv2di x, uv2di y) { return x == y; } +uv4si eq_v4si(uv4si x, uv4si y) { return x == y; } + +/* { dg-final { scan-assembler-times "pcmpeq" 3 } } */ +/* { dg-final { scan-assembler "pshufd" } } */ diff --git a/gcc/testsuite/gcc.target/i386/sse2-v1ti-vne.c b/gcc/testsuite/gcc.target/i386/sse2-v1ti-vne.c new file mode 100644 index 0000000..767b0e4 --- /dev/null +++ b/gcc/testsuite/gcc.target/i386/sse2-v1ti-vne.c @@ -0,0 +1,13 @@ +/* { dg-do compile { target int128 } } */ +/* { dg-options "-O2 -msse2" } */ +typedef unsigned __int128 uv1ti __attribute__ ((__vector_size__ (16))); +typedef unsigned long long uv2di __attribute__ ((__vector_size__ (16))); +typedef unsigned int uv4si __attribute__ ((__vector_size__ (16))); + +uv1ti eq_v1ti(uv1ti x, uv1ti y) { return x != y; } +uv2di eq_v2di(uv2di x, uv2di y) { return x != y; } +uv4si eq_v4si(uv4si x, uv4si y) { return x != y; } + +/* { dg-final { scan-assembler-times "pcmpeq" 6 } } */ +/* { dg-final { scan-assembler-times "pxor" 3 } } */ +/* { dg-final { scan-assembler "pshufd" } } */ diff --git a/gcc/testsuite/gnat.dg/hardbool.adb b/gcc/testsuite/gnat.dg/hardbool.adb new file mode 100644 index 0000000..cc38af0 --- /dev/null +++ b/gcc/testsuite/gnat.dg/hardbool.adb @@ -0,0 +1,46 @@ +-- { dg-do compile } +-- { dg-options "-O -gnatVT -fdump-tree-optimized" } + +-- Check that we perform the expected validity checks for +-- hardbool-annotated types, even when checking of tests is disabled. + +package body Hardbool is + function T return Boolean is (Boolean (X) and then Boolean (Y)); + + procedure P1 is + begin + X := HBool1 (not Y); + end P1; + + procedure P2 is + begin + X := HBool1 (if Y then HBool2'(False) else HBool2'(True)); + end P2; + + procedure P3 is + begin + X := (if Y then HBool1'(False) else HBool1'(True)); + end P3; + + procedure Q1 is + begin + Y := HBool2 (not X); + end Q1; + + procedure Q2 is + begin + Y := HBool2 (if X then HBool1'(False) else HBool1'(True)); + end Q2; + + procedure Q3 is + begin + Y := (if X then HBool2'(False) else HBool2'(True)); + end Q3; + +end Hardbool; + +-- One for each type's _rep_to_pos function. +-- { dg-final { scan-tree-dump-times "gnat_rcheck_CE_Invalid_Data ..hardbool.ads" 2 "optimized" } } + +-- One check for each variable used in T, one use in each P* and in each Q*. +-- { dg-final { scan-tree-dump-times "gnat_rcheck_CE_Invalid_Data ..hardbool.adb" 8 "optimized" } } diff --git a/gcc/testsuite/gnat.dg/hardbool.ads b/gcc/testsuite/gnat.dg/hardbool.ads new file mode 100644 index 0000000..7181220 --- /dev/null +++ b/gcc/testsuite/gnat.dg/hardbool.ads @@ -0,0 +1,22 @@ +package Hardbool is + type HBool1 is new Boolean; + for HBool1'Size use 8; + for HBool1 use (16#5a#, 16#a5#); + pragma Machine_Attribute (HBool1, "hardbool"); + + type HBool2 is new Boolean; + for HBool2 use (16#0ff0#, 16#f00f#); + for HBool2'Size use 16; + pragma Machine_Attribute (HBool2, "hardbool"); + + X : HBool1 := False; + Y : HBool2 := True; + + function T return Boolean; + procedure P1; + procedure P2; + procedure P3; + procedure Q1; + procedure Q2; + procedure Q3; +end Hardbool; diff --git a/gcc/testsuite/gnat.dg/sso17.adb b/gcc/testsuite/gnat.dg/sso17.adb new file mode 100644 index 0000000..ed57580 --- /dev/null +++ b/gcc/testsuite/gnat.dg/sso17.adb @@ -0,0 +1,34 @@ +-- { dg-do run } +-- { dg-options "-gnatws -O" } + +with System; + +procedure SSO17 is + + type My_Float is new Float range 0.0 .. 359.99; + + type Rec is record + Az : My_Float; + El : My_Float; + end record; + for Rec'Bit_Order use System.High_Order_First; + for Rec'Scalar_Storage_Order use System.High_Order_First; + + R : Rec; + + procedure Is_True (B : Boolean); + pragma No_Inline (Is_True); + + procedure Is_True (B : Boolean) is + begin + if not B then + raise Program_Error; + end if; + end; + +begin + R := (Az => 1.1, El => 2.2); + Is_True (R.Az'Valid); + R := (Az => 3.3, El => 4.4); + Is_True (R.Az'Valid); +end; diff --git a/gcc/testsuite/lib/target-supports.exp b/gcc/testsuite/lib/target-supports.exp index 2d5d053..244fe23 100644 --- a/gcc/testsuite/lib/target-supports.exp +++ b/gcc/testsuite/lib/target-supports.exp @@ -1689,6 +1689,36 @@ proc check_linker_plugin_available { } { } "-flto -fuse-linker-plugin"] } +# Return 1 if the target is RV32, 0 otherwise. Cache the result. + +proc check_effective_target_rv32 { } { + # Check that we are compiling for RV32 by checking the xlen size. + return [check_no_compiler_messages riscv_rv32 assembly { + #if !defined(__riscv_xlen) + #error "__riscv_xlen not defined!" + #else + #if __riscv_xlen != 32 + #error "Not RV32" + #endif + #endif + }] +} + +# Return 1 if the target is RV64, 0 otherwise. Cache the result. + +proc check_effective_target_rv64 { } { + # Check that we are compiling for RV64 by checking the xlen size. + return [check_no_compiler_messages riscv_rv64 assembly { + #if !defined(__riscv_xlen) + #error "__riscv_xlen not defined!" + #else + #if __riscv_xlen != 64 + #error "Not RV64" + #endif + #endif + }] +} + # Return 1 if the target OS supports running SSE executables, 0 # otherwise. Cache the result. diff --git a/gcc/tree-cfg.cc b/gcc/tree-cfg.cc index e321d92..19ba09f 100644 --- a/gcc/tree-cfg.cc +++ b/gcc/tree-cfg.cc @@ -37,9 +37,9 @@ along with GCC; see the file COPYING3. If not see #include "stor-layout.h" #include "print-tree.h" #include "cfganal.h" +#include "gimple-iterator.h" #include "gimple-fold.h" #include "tree-eh.h" -#include "gimple-iterator.h" #include "gimplify-me.h" #include "gimple-walk.h" #include "tree-cfg.h" diff --git a/gcc/tree-if-conv.cc b/gcc/tree-if-conv.cc index 57cc385..4531ca5 100644 --- a/gcc/tree-if-conv.cc +++ b/gcc/tree-if-conv.cc @@ -96,9 +96,9 @@ along with GCC; see the file COPYING3. If not see #include "alias.h" #include "fold-const.h" #include "stor-layout.h" +#include "gimple-iterator.h" #include "gimple-fold.h" #include "gimplify.h" -#include "gimple-iterator.h" #include "gimplify-me.h" #include "tree-cfg.h" #include "tree-into-ssa.h" diff --git a/gcc/tree-inline.cc b/gcc/tree-inline.cc index 29bb758..043e1d5 100644 --- a/gcc/tree-inline.cc +++ b/gcc/tree-inline.cc @@ -41,10 +41,10 @@ along with GCC; see the file COPYING3. If not see #include "cfganal.h" #include "tree-iterator.h" #include "intl.h" +#include "gimple-iterator.h" #include "gimple-fold.h" #include "tree-eh.h" #include "gimplify.h" -#include "gimple-iterator.h" #include "gimplify-me.h" #include "gimple-walk.h" #include "tree-cfg.h" diff --git a/gcc/tree-object-size.cc b/gcc/tree-object-size.cc index fc062b9..5ca87ae 100644 --- a/gcc/tree-object-size.cc +++ b/gcc/tree-object-size.cc @@ -29,8 +29,8 @@ along with GCC; see the file COPYING3. If not see #include "gimple-pretty-print.h" #include "fold-const.h" #include "tree-object-size.h" -#include "gimple-fold.h" #include "gimple-iterator.h" +#include "gimple-fold.h" #include "tree-cfg.h" #include "tree-dfa.h" #include "stringpool.h" diff --git a/gcc/tree-sra.cc b/gcc/tree-sra.cc index a86f8c0..081c51b 100644 --- a/gcc/tree-sra.cc +++ b/gcc/tree-sra.cc @@ -4270,32 +4270,31 @@ sra_modify_assign (gimple *stmt, gimple_stmt_iterator *gsi) sra_stats.exprs++; } - if (modify_this_stmt) - { - if (!useless_type_conversion_p (TREE_TYPE (lhs), TREE_TYPE (rhs))) + if (modify_this_stmt + && !useless_type_conversion_p (TREE_TYPE (lhs), TREE_TYPE (rhs))) + { + /* If we can avoid creating a VIEW_CONVERT_EXPR, then do so. + ??? This should move to fold_stmt which we simply should + call after building a VIEW_CONVERT_EXPR here. */ + if (AGGREGATE_TYPE_P (TREE_TYPE (lhs)) + && TYPE_REVERSE_STORAGE_ORDER (TREE_TYPE (lhs)) == racc->reverse + && !contains_bitfld_component_ref_p (lhs)) { - /* If we can avoid creating a VIEW_CONVERT_EXPR do so. - ??? This should move to fold_stmt which we simply should - call after building a VIEW_CONVERT_EXPR here. */ - if (AGGREGATE_TYPE_P (TREE_TYPE (lhs)) - && !contains_bitfld_component_ref_p (lhs)) - { - lhs = build_ref_for_model (loc, lhs, 0, racc, gsi, false); - gimple_assign_set_lhs (stmt, lhs); - } - else if (lacc - && AGGREGATE_TYPE_P (TREE_TYPE (rhs)) - && !contains_vce_or_bfcref_p (rhs)) - rhs = build_ref_for_model (loc, rhs, 0, lacc, gsi, false); + lhs = build_ref_for_model (loc, lhs, 0, racc, gsi, false); + gimple_assign_set_lhs (stmt, lhs); + } + else if (lacc + && AGGREGATE_TYPE_P (TREE_TYPE (rhs)) + && TYPE_REVERSE_STORAGE_ORDER (TREE_TYPE (rhs)) == lacc->reverse + && !contains_vce_or_bfcref_p (rhs)) + rhs = build_ref_for_model (loc, rhs, 0, lacc, gsi, false); - if (!useless_type_conversion_p (TREE_TYPE (lhs), TREE_TYPE (rhs))) - { - rhs = fold_build1_loc (loc, VIEW_CONVERT_EXPR, TREE_TYPE (lhs), - rhs); - if (is_gimple_reg_type (TREE_TYPE (lhs)) - && TREE_CODE (lhs) != SSA_NAME) - force_gimple_rhs = true; - } + if (!useless_type_conversion_p (TREE_TYPE (lhs), TREE_TYPE (rhs))) + { + rhs = fold_build1_loc (loc, VIEW_CONVERT_EXPR, TREE_TYPE (lhs), rhs); + if (is_gimple_reg_type (TREE_TYPE (lhs)) + && TREE_CODE (lhs) != SSA_NAME) + force_gimple_rhs = true; } } diff --git a/gcc/tree-ssa-ccp.cc b/gcc/tree-ssa-ccp.cc index 9164efe..262a247e 100644 --- a/gcc/tree-ssa-ccp.cc +++ b/gcc/tree-ssa-ccp.cc @@ -129,10 +129,10 @@ along with GCC; see the file COPYING3. If not see #include "ssa.h" #include "gimple-pretty-print.h" #include "fold-const.h" +#include "gimple-iterator.h" #include "gimple-fold.h" #include "tree-eh.h" #include "gimplify.h" -#include "gimple-iterator.h" #include "tree-cfg.h" #include "tree-ssa-propagate.h" #include "dbgcnt.h" diff --git a/gcc/tree-ssa-dom.cc b/gcc/tree-ssa-dom.cc index 89b0517..9a84321 100644 --- a/gcc/tree-ssa-dom.cc +++ b/gcc/tree-ssa-dom.cc @@ -30,10 +30,10 @@ along with GCC; see the file COPYING3. If not see #include "fold-const.h" #include "cfganal.h" #include "cfgloop.h" +#include "gimple-iterator.h" #include "gimple-fold.h" #include "tree-eh.h" #include "tree-inline.h" -#include "gimple-iterator.h" #include "tree-cfg.h" #include "tree-into-ssa.h" #include "domwalk.h" diff --git a/gcc/tree-ssa-forwprop.cc b/gcc/tree-ssa-forwprop.cc index 484491f..48cab58 100644 --- a/gcc/tree-ssa-forwprop.cc +++ b/gcc/tree-ssa-forwprop.cc @@ -32,10 +32,10 @@ along with GCC; see the file COPYING3. If not see #include "gimple-pretty-print.h" #include "fold-const.h" #include "stor-layout.h" +#include "gimple-iterator.h" #include "gimple-fold.h" #include "tree-eh.h" #include "gimplify.h" -#include "gimple-iterator.h" #include "gimplify-me.h" #include "tree-cfg.h" #include "expr.h" @@ -2334,8 +2334,10 @@ simplify_bitfield_ref (gimple_stmt_iterator *gsi) gimple *stmt = gsi_stmt (*gsi); gimple *def_stmt; tree op, op0, op1; - tree elem_type; - unsigned idx, size; + tree elem_type, type; + tree p, m, tem; + unsigned HOST_WIDE_INT nelts, idx; + poly_uint64 size, elem_size; enum tree_code code; op = gimple_assign_rhs1 (stmt); @@ -2353,42 +2355,71 @@ simplify_bitfield_ref (gimple_stmt_iterator *gsi) op1 = TREE_OPERAND (op, 1); code = gimple_assign_rhs_code (def_stmt); elem_type = TREE_TYPE (TREE_TYPE (op0)); - if (TREE_TYPE (op) != elem_type) - return false; + type = TREE_TYPE (op); + /* Also hanlde vector type. + .i.e. + _7 = VEC_PERM_EXPR <_1, _1, { 2, 3, 2, 3 }>; + _11 = BIT_FIELD_REF <_7, 64, 0>; - size = TREE_INT_CST_LOW (TYPE_SIZE (elem_type)); + to + + _11 = BIT_FIELD_REF <_1, 64, 64>. */ + + size = tree_to_poly_uint64 (TYPE_SIZE (type)); if (maybe_ne (bit_field_size (op), size)) return false; - if (code == VEC_PERM_EXPR - && constant_multiple_p (bit_field_offset (op), size, &idx)) + elem_size = tree_to_poly_uint64 (TYPE_SIZE (elem_type)); + if (code != VEC_PERM_EXPR + || !constant_multiple_p (bit_field_offset (op), elem_size, &idx)) + return false; + + m = gimple_assign_rhs3 (def_stmt); + if (TREE_CODE (m) != VECTOR_CST + || !VECTOR_CST_NELTS (m).is_constant (&nelts)) + return false; + + /* One element. */ + if (known_eq (size, elem_size)) + idx = TREE_INT_CST_LOW (VECTOR_CST_ELT (m, idx)); + else { - tree p, m, tem; - unsigned HOST_WIDE_INT nelts; - m = gimple_assign_rhs3 (def_stmt); - if (TREE_CODE (m) != VECTOR_CST - || !VECTOR_CST_NELTS (m).is_constant (&nelts)) + unsigned HOST_WIDE_INT nelts_op; + if (!constant_multiple_p (size, elem_size, &nelts_op) + || !pow2p_hwi (nelts_op)) return false; - idx = TREE_INT_CST_LOW (VECTOR_CST_ELT (m, idx)); - idx %= 2 * nelts; - if (idx < nelts) - { - p = gimple_assign_rhs1 (def_stmt); - } - else + unsigned start = TREE_INT_CST_LOW (vector_cst_elt (m, idx)); + unsigned end = TREE_INT_CST_LOW (vector_cst_elt (m, idx + nelts_op - 1)); + /* Be in the same vector. */ + if ((start < nelts) != (end < nelts)) + return false; + for (unsigned HOST_WIDE_INT i = 1; i != nelts_op; i++) { - p = gimple_assign_rhs2 (def_stmt); - idx -= nelts; + /* Continuous area. */ + if (TREE_INT_CST_LOW (vector_cst_elt (m, idx + i)) - 1 + != TREE_INT_CST_LOW (vector_cst_elt (m, idx + i - 1))) + return false; } - tem = build3 (BIT_FIELD_REF, TREE_TYPE (op), - unshare_expr (p), op1, bitsize_int (idx * size)); - gimple_assign_set_rhs1 (stmt, tem); - fold_stmt (gsi); - update_stmt (gsi_stmt (*gsi)); - return true; + /* Alignment not worse than before. */ + if (start % nelts_op) + return false; + idx = start; } - return false; + if (idx < nelts) + p = gimple_assign_rhs1 (def_stmt); + else + { + p = gimple_assign_rhs2 (def_stmt); + idx -= nelts; + } + + tem = build3 (BIT_FIELD_REF, TREE_TYPE (op), + p, op1, bitsize_int (idx * elem_size)); + gimple_assign_set_rhs1 (stmt, tem); + fold_stmt (gsi); + update_stmt (gsi_stmt (*gsi)); + return true; } /* Determine whether applying the 2 permutations (mask1 then mask2) diff --git a/gcc/tree-ssa-ifcombine.cc b/gcc/tree-ssa-ifcombine.cc index cb86cc1..88a9f06 100644 --- a/gcc/tree-ssa-ifcombine.cc +++ b/gcc/tree-ssa-ifcombine.cc @@ -35,8 +35,8 @@ along with GCC; see the file COPYING3. If not see BRANCH_COST. */ #include "fold-const.h" #include "cfganal.h" -#include "gimple-fold.h" #include "gimple-iterator.h" +#include "gimple-fold.h" #include "gimplify-me.h" #include "tree-cfg.h" #include "tree-ssa.h" diff --git a/gcc/tree-ssa-loop-ivcanon.cc b/gcc/tree-ssa-loop-ivcanon.cc index e2ac204..2ee00a3 100644 --- a/gcc/tree-ssa-loop-ivcanon.cc +++ b/gcc/tree-ssa-loop-ivcanon.cc @@ -48,9 +48,9 @@ along with GCC; see the file COPYING3. If not see #include "gimple-pretty-print.h" #include "fold-const.h" #include "profile.h" +#include "gimple-iterator.h" #include "gimple-fold.h" #include "tree-eh.h" -#include "gimple-iterator.h" #include "tree-cfg.h" #include "tree-ssa-loop-manip.h" #include "tree-ssa-loop-niter.h" diff --git a/gcc/tree-ssa-math-opts.cc b/gcc/tree-ssa-math-opts.cc index 2085597..ce1df01 100644 --- a/gcc/tree-ssa-math-opts.cc +++ b/gcc/tree-ssa-math-opts.cc @@ -100,8 +100,8 @@ along with GCC; see the file COPYING3. If not see #include "gimple-pretty-print.h" #include "alias.h" #include "fold-const.h" -#include "gimple-fold.h" #include "gimple-iterator.h" +#include "gimple-fold.h" #include "gimplify.h" #include "gimplify-me.h" #include "stor-layout.h" diff --git a/gcc/tree-ssa-pre.cc b/gcc/tree-ssa-pre.cc index a578ce6..34d77f1 100644 --- a/gcc/tree-ssa-pre.cc +++ b/gcc/tree-ssa-pre.cc @@ -34,10 +34,10 @@ along with GCC; see the file COPYING3. If not see #include "gimple-pretty-print.h" #include "fold-const.h" #include "cfganal.h" +#include "gimple-iterator.h" #include "gimple-fold.h" #include "tree-eh.h" #include "gimplify.h" -#include "gimple-iterator.h" #include "tree-cfg.h" #include "tree-into-ssa.h" #include "tree-dfa.h" diff --git a/gcc/tree-ssa-propagate.cc b/gcc/tree-ssa-propagate.cc index 7813e51..c10ffd9 100644 --- a/gcc/tree-ssa-propagate.cc +++ b/gcc/tree-ssa-propagate.cc @@ -27,10 +27,10 @@ #include "ssa.h" #include "gimple-pretty-print.h" #include "dumpfile.h" +#include "gimple-iterator.h" #include "gimple-fold.h" #include "tree-eh.h" #include "gimplify.h" -#include "gimple-iterator.h" #include "tree-cfg.h" #include "tree-ssa.h" #include "tree-ssa-propagate.h" diff --git a/gcc/tree-ssa-reassoc.cc b/gcc/tree-ssa-reassoc.cc index 43b2537..406523b 100644 --- a/gcc/tree-ssa-reassoc.cc +++ b/gcc/tree-ssa-reassoc.cc @@ -38,9 +38,9 @@ along with GCC; see the file COPYING3. If not see #include "fold-const.h" #include "stor-layout.h" #include "cfganal.h" +#include "gimple-iterator.h" #include "gimple-fold.h" #include "tree-eh.h" -#include "gimple-iterator.h" #include "gimplify-me.h" #include "tree-cfg.h" #include "tree-ssa-loop.h" diff --git a/gcc/tree-ssa-sccvn.cc b/gcc/tree-ssa-sccvn.cc index 3732d06..ed68557 100644 --- a/gcc/tree-ssa-sccvn.cc +++ b/gcc/tree-ssa-sccvn.cc @@ -39,6 +39,7 @@ along with GCC; see the file COPYING3. If not see #include "cfganal.h" #include "tree-inline.h" #include "internal-fn.h" +#include "gimple-iterator.h" #include "gimple-fold.h" #include "tree-eh.h" #include "gimplify.h" @@ -56,7 +57,6 @@ along with GCC; see the file COPYING3. If not see #include "tree-ssa-propagate.h" #include "tree-cfg.h" #include "domwalk.h" -#include "gimple-iterator.h" #include "gimple-match.h" #include "stringpool.h" #include "attribs.h" @@ -1799,11 +1799,13 @@ struct pd_data struct vn_walk_cb_data { vn_walk_cb_data (vn_reference_t vr_, tree orig_ref_, tree *last_vuse_ptr_, - vn_lookup_kind vn_walk_kind_, bool tbaa_p_, tree mask_) + vn_lookup_kind vn_walk_kind_, bool tbaa_p_, tree mask_, + bool redundant_store_removal_p_) : vr (vr_), last_vuse_ptr (last_vuse_ptr_), last_vuse (NULL_TREE), mask (mask_), masked_result (NULL_TREE), vn_walk_kind (vn_walk_kind_), - tbaa_p (tbaa_p_), saved_operands (vNULL), first_set (-2), - first_base_set (-2), known_ranges (NULL) + tbaa_p (tbaa_p_), redundant_store_removal_p (redundant_store_removal_p_), + saved_operands (vNULL), first_set (-2), first_base_set (-2), + known_ranges (NULL) { if (!last_vuse_ptr) last_vuse_ptr = &last_vuse; @@ -1862,6 +1864,7 @@ struct vn_walk_cb_data tree masked_result; vn_lookup_kind vn_walk_kind; bool tbaa_p; + bool redundant_store_removal_p; vec<vn_reference_op_s> saved_operands; /* The VDEFs of partial defs we come along. */ @@ -2620,6 +2623,19 @@ vn_reference_lookup_3 (ao_ref *ref, tree vuse, void *data_, return NULL; } + /* When the def is a CLOBBER we can optimistically disambiguate + against it since any overlap it would be undefined behavior. + Avoid this for obvious must aliases to save compile-time though. + We also may not do this when the query is used for redundant + store removal. */ + if (!data->redundant_store_removal_p + && gimple_clobber_p (def_stmt) + && !operand_equal_p (ao_ref_base (&lhs_ref), base, OEP_ADDRESS_OF)) + { + *disambiguate_only = TR_DISAMBIGUATE; + return NULL; + } + /* Besides valueizing the LHS we can also use access-path based disambiguation on the original non-valueized ref. */ if (!ref->ref @@ -3604,7 +3620,8 @@ vn_reference_lookup_pieces (tree vuse, alias_set_type set, { ao_ref r; unsigned limit = param_sccvn_max_alias_queries_per_access; - vn_walk_cb_data data (&vr1, NULL_TREE, NULL, kind, true, NULL_TREE); + vn_walk_cb_data data (&vr1, NULL_TREE, NULL, kind, true, NULL_TREE, + false); vec<vn_reference_op_s> ops_for_ref; if (!valueized_p) ops_for_ref = vr1.operands; @@ -3649,12 +3666,14 @@ vn_reference_lookup_pieces (tree vuse, alias_set_type set, MASK is either NULL_TREE, or can be an INTEGER_CST if the result of the load is bitwise anded with MASK and so we are only interested in a subset of the bits and can ignore if the other bits are uninitialized or - not initialized with constants. */ + not initialized with constants. When doing redundant store removal + the caller has to set REDUNDANT_STORE_REMOVAL_P. */ tree vn_reference_lookup (tree op, tree vuse, vn_lookup_kind kind, vn_reference_t *vnresult, bool tbaa_p, - tree *last_vuse_ptr, tree mask) + tree *last_vuse_ptr, tree mask, + bool redundant_store_removal_p) { vec<vn_reference_op_s> operands; struct vn_reference_s vr1; @@ -3732,7 +3751,8 @@ vn_reference_lookup (tree op, tree vuse, vn_lookup_kind kind, vr1.type, ops_for_ref)) ao_ref_init (&r, op); vn_walk_cb_data data (&vr1, r.ref ? NULL_TREE : op, - last_vuse_ptr, kind, tbaa_p, mask); + last_vuse_ptr, kind, tbaa_p, mask, + redundant_store_removal_p); wvnresult = ((vn_reference_t) @@ -6592,7 +6612,8 @@ eliminate_dom_walker::eliminate_stmt (basic_block b, gimple_stmt_iterator *gsi) tree val = NULL_TREE; if (lookup_lhs) val = vn_reference_lookup (lookup_lhs, gimple_vuse (stmt), - VN_WALKREWRITE, &vnresult, false); + VN_WALKREWRITE, &vnresult, false, + NULL, NULL_TREE, true); if (TREE_CODE (rhs) == SSA_NAME) rhs = VN_INFO (rhs)->valnum; if (val diff --git a/gcc/tree-ssa-sccvn.h b/gcc/tree-ssa-sccvn.h index c4e3410..a1b1e6b 100644 --- a/gcc/tree-ssa-sccvn.h +++ b/gcc/tree-ssa-sccvn.h @@ -265,7 +265,7 @@ tree vn_reference_lookup_pieces (tree, alias_set_type, alias_set_type, tree, vec<vn_reference_op_s> , vn_reference_t *, vn_lookup_kind); tree vn_reference_lookup (tree, tree, vn_lookup_kind, vn_reference_t *, bool, - tree * = NULL, tree = NULL_TREE); + tree * = NULL, tree = NULL_TREE, bool = false); void vn_reference_lookup_call (gcall *, vn_reference_t *, vn_reference_t); vn_reference_t vn_reference_insert_pieces (tree, alias_set_type, alias_set_type, tree, vec<vn_reference_op_s>, diff --git a/gcc/tree-ssa-strlen.cc b/gcc/tree-ssa-strlen.cc index 1e5f911..1d4c0f7 100644 --- a/gcc/tree-ssa-strlen.cc +++ b/gcc/tree-ssa-strlen.cc @@ -34,10 +34,10 @@ along with GCC; see the file COPYING3. If not see #include "gimple-ssa-warn-restrict.h" #include "fold-const.h" #include "stor-layout.h" +#include "gimple-iterator.h" #include "gimple-fold.h" #include "tree-eh.h" #include "gimplify.h" -#include "gimple-iterator.h" #include "gimplify-me.h" #include "expr.h" #include "tree-cfg.h" @@ -3805,9 +3805,44 @@ strlen_pass::handle_builtin_memset (bool *zero_write) { gimple *memset_stmt = gsi_stmt (m_gsi); tree ptr = gimple_call_arg (memset_stmt, 0); + tree memset_val = gimple_call_arg (memset_stmt, 1); + tree memset_size = gimple_call_arg (memset_stmt, 2); + /* Set to the non-constant offset added to PTR. */ wide_int offrng[2]; int idx1 = get_stridx (ptr, memset_stmt, offrng, ptr_qry.rvals); + if (idx1 == 0 + && TREE_CODE (memset_val) == INTEGER_CST + && ((TREE_CODE (memset_size) == INTEGER_CST + && !integer_zerop (memset_size)) + || TREE_CODE (memset_size) == SSA_NAME)) + { + unsigned HOST_WIDE_INT mask = (HOST_WIDE_INT_1U << CHAR_TYPE_SIZE) - 1; + bool full_string_p = (wi::to_wide (memset_val) & mask) == 0; + + /* We only handle symbolic lengths when writing non-zero values. */ + if (full_string_p && TREE_CODE (memset_size) != INTEGER_CST) + return false; + + idx1 = new_stridx (ptr); + if (idx1 == 0) + return false; + tree newlen; + if (full_string_p) + newlen = build_int_cst (size_type_node, 0); + else if (TREE_CODE (memset_size) == INTEGER_CST) + newlen = fold_convert (size_type_node, memset_size); + else + newlen = memset_size; + + strinfo *dsi = new_strinfo (ptr, idx1, newlen, full_string_p); + set_strinfo (idx1, dsi); + find_equal_ptrs (ptr, idx1); + dsi->dont_invalidate = true; + dsi->writable = true; + return false; + } + if (idx1 <= 0) return false; strinfo *si1 = get_strinfo (idx1); @@ -3820,7 +3855,6 @@ strlen_pass::handle_builtin_memset (bool *zero_write) if (!valid_builtin_call (alloc_stmt)) return false; tree alloc_size = gimple_call_arg (alloc_stmt, 0); - tree memset_size = gimple_call_arg (memset_stmt, 2); /* Check for overflow. */ maybe_warn_overflow (memset_stmt, false, memset_size, NULL, false, true); @@ -3836,7 +3870,7 @@ strlen_pass::handle_builtin_memset (bool *zero_write) return false; /* Bail when the call writes a non-zero value. */ - if (!integer_zerop (gimple_call_arg (memset_stmt, 1))) + if (!integer_zerop (memset_val)) return false; /* Let the caller know the memset call cleared the destination. */ @@ -5089,8 +5123,9 @@ strlen_pass::handle_store (bool *zero_write) return false; } - if (storing_all_zeros_p - || storing_nonzero_p + if (storing_nonzero_p + || storing_all_zeros_p + || (full_string_p && lenrange[1] == 0) || (offset != 0 && store_before_nul[1] > 0)) { /* When STORING_NONZERO_P, we know that the string will start @@ -5100,8 +5135,9 @@ strlen_pass::handle_store (bool *zero_write) of leading non-zero characters and set si->NONZERO_CHARS to the result instead. - When STORING_ALL_ZEROS_P, we know that the string is now - OFFSET characters long. + When STORING_ALL_ZEROS_P, or the first byte written is zero, + i.e. FULL_STRING_P && LENRANGE[1] == 0, we know that the + string is now OFFSET characters long. Otherwise, we're storing an unknown value at offset OFFSET, so need to clip the nonzero_chars to OFFSET. diff --git a/gcc/tree-ssa.cc b/gcc/tree-ssa.cc index a362a0a..6507348 100644 --- a/gcc/tree-ssa.cc +++ b/gcc/tree-ssa.cc @@ -30,9 +30,9 @@ along with GCC; see the file COPYING3. If not see #include "diagnostic-core.h" #include "fold-const.h" #include "stor-layout.h" +#include "gimple-iterator.h" #include "gimple-fold.h" #include "gimplify.h" -#include "gimple-iterator.h" #include "gimple-walk.h" #include "tree-ssa-loop-manip.h" #include "tree-into-ssa.h" diff --git a/gcc/tree-vect-generic.cc b/gcc/tree-vect-generic.cc index e5bd9dc..d99e320 100644 --- a/gcc/tree-vect-generic.cc +++ b/gcc/tree-vect-generic.cc @@ -54,10 +54,7 @@ gimplify_build3 (gimple_stmt_iterator *gsi, enum tree_code code, tree type, tree a, tree b, tree c) { location_t loc = gimple_location (gsi_stmt (*gsi)); - gimple_seq stmts = NULL; - tree ret = gimple_build (&stmts, loc, code, type, a, b, c); - gsi_insert_seq_before (gsi, stmts, GSI_SAME_STMT); - return ret; + return gimple_build (gsi, true, GSI_SAME_STMT, loc, code, type, a, b, c); } /* Build a binary operation and gimplify it. Emit code before GSI. @@ -68,10 +65,7 @@ gimplify_build2 (gimple_stmt_iterator *gsi, enum tree_code code, tree type, tree a, tree b) { location_t loc = gimple_location (gsi_stmt (*gsi)); - gimple_seq stmts = NULL; - tree ret = gimple_build (&stmts, loc, code, type, a, b); - gsi_insert_seq_before (gsi, stmts, GSI_SAME_STMT); - return ret; + return gimple_build (gsi, true, GSI_SAME_STMT, loc, code, type, a, b); } /* Build a unary operation and gimplify it. Emit code before GSI. @@ -82,10 +76,7 @@ gimplify_build1 (gimple_stmt_iterator *gsi, enum tree_code code, tree type, tree a) { location_t loc = gimple_location (gsi_stmt (*gsi)); - gimple_seq stmts = NULL; - tree ret = gimple_build (&stmts, loc, code, type, a); - gsi_insert_seq_before (gsi, stmts, GSI_SAME_STMT); - return ret; + return gimple_build (gsi, true, GSI_SAME_STMT, loc, code, type, a); } diff --git a/gcc/tree-vrp.cc b/gcc/tree-vrp.cc index 0cbd9d3..8ba9ca7 100644 --- a/gcc/tree-vrp.cc +++ b/gcc/tree-vrp.cc @@ -4302,6 +4302,9 @@ public: void pre_fold_bb (basic_block bb) OVERRIDE { m_pta->enter (bb); + for (gphi_iterator gsi = gsi_start_phis (bb); !gsi_end_p (gsi); + gsi_next (&gsi)) + m_ranger->register_side_effects (gsi.phi ()); } void post_fold_bb (basic_block bb) OVERRIDE @@ -4345,7 +4348,6 @@ execute_ranger_vrp (struct function *fun, bool warn_array_bounds_p) gimple_ranger *ranger = enable_ranger (fun); rvrp_folder folder (ranger); folder.substitute_and_fold (); - ranger->export_global_ranges (); if (dump_file && (dump_flags & TDF_DETAILS)) ranger->dump (dump_file); diff --git a/gcc/ubsan.cc b/gcc/ubsan.cc index f74929d..6c05814 100644 --- a/gcc/ubsan.cc +++ b/gcc/ubsan.cc @@ -1184,12 +1184,9 @@ ubsan_expand_ptr_ifn (gimple_stmt_iterator *gsip) gimple_set_location (g, loc); gsi_insert_after (&gsi2, g, GSI_NEW_STMT); - gimple_seq seq = NULL; - tree t = gimple_build (&seq, loc, NOP_EXPR, ssizetype, off); - t = gimple_build (&seq, loc, GE_EXPR, boolean_type_node, - t, ssize_int (0)); - gsi_insert_seq_before (&gsi, seq, GSI_SAME_STMT); - g = gimple_build_cond (NE_EXPR, t, boolean_false_node, + tree t = gimple_build (&gsi, true, GSI_SAME_STMT, + loc, NOP_EXPR, ssizetype, off); + g = gimple_build_cond (GE_EXPR, t, ssize_int (0), NULL_TREE, NULL_TREE); } gimple_set_location (g, loc); diff --git a/gcc/value-pointer-equiv.cc b/gcc/value-pointer-equiv.cc index f2d95c4..b768ecd 100644 --- a/gcc/value-pointer-equiv.cc +++ b/gcc/value-pointer-equiv.cc @@ -28,9 +28,9 @@ along with GCC; see the file COPYING3. If not see #include "ssa.h" #include "gimple-pretty-print.h" #include "cfganal.h" +#include "gimple-iterator.h" #include "gimple-fold.h" #include "tree-eh.h" -#include "gimple-iterator.h" #include "tree-cfg.h" #include "tree-ssa-loop-manip.h" #include "tree-ssa-loop.h" diff --git a/gcc/value-query.cc b/gcc/value-query.cc index 844070a..9ccd802 100644 --- a/gcc/value-query.cc +++ b/gcc/value-query.cc @@ -457,7 +457,7 @@ range_query::query_relation (gimple *s, tree ssa1, tree ssa2, bool get_range) { int_range_max tmp; if (!m_oracle || TREE_CODE (ssa1) != SSA_NAME || TREE_CODE (ssa2) != SSA_NAME) - return VREL_NONE; + return VREL_VARYING; // Ensure ssa1 and ssa2 have both been evaluated. if (get_range) @@ -478,7 +478,7 @@ range_query::query_relation (edge e, tree ssa1, tree ssa2, bool get_range) basic_block bb; int_range_max tmp; if (!m_oracle || TREE_CODE (ssa1) != SSA_NAME || TREE_CODE (ssa2) != SSA_NAME) - return VREL_NONE; + return VREL_VARYING; // Use destination block if it has a single predecessor, and this picks // up any relation on the edge. diff --git a/gcc/value-range.cc b/gcc/value-range.cc index 94301b3..2e7385a 100644 --- a/gcc/value-range.cc +++ b/gcc/value-range.cc @@ -1439,9 +1439,10 @@ irange::legacy_union (irange *vr0, const irange *vr1) /* Meet operation for value ranges. Given two value ranges VR0 and VR1, store in VR0 a range that contains both VR0 and VR1. This - may not be the smallest possible such range. */ + may not be the smallest possible such range. + Return TRUE if the original value changes. */ -void +bool irange::legacy_verbose_union_ (const irange *other) { if (legacy_mode_p ()) @@ -1450,7 +1451,7 @@ irange::legacy_verbose_union_ (const irange *other) { int_range<1> tmp = *other; legacy_union (this, &tmp); - return; + return true; } if (dump_file && (dump_flags & TDF_DETAILS)) { @@ -1469,19 +1470,19 @@ irange::legacy_verbose_union_ (const irange *other) dump_value_range (dump_file, this); fprintf (dump_file, "\n"); } - return; + return true; } if (other->legacy_mode_p ()) { int_range<2> wider = *other; - irange_union (wider); + return irange_union (wider); } else - irange_union (*other); + return irange_union (*other); } -void +bool irange::legacy_verbose_intersect (const irange *other) { if (legacy_mode_p ()) @@ -1490,7 +1491,7 @@ irange::legacy_verbose_intersect (const irange *other) { int_range<1> tmp = *other; legacy_intersect (this, &tmp); - return; + return true; } if (dump_file && (dump_flags & TDF_DETAILS)) { @@ -1509,35 +1510,108 @@ irange::legacy_verbose_intersect (const irange *other) dump_value_range (dump_file, this); fprintf (dump_file, "\n"); } - return; + return true; } if (other->legacy_mode_p ()) { int_range<2> wider; wider = *other; - irange_intersect (wider); + return irange_intersect (wider); + } + else + return irange_intersect (*other); +} + +// Perform an efficient union with R when both ranges have only a single pair. +// Excluded are VARYING and UNDEFINED ranges. + +bool +irange::irange_single_pair_union (const irange &r) +{ + gcc_checking_assert (!undefined_p () && !varying_p ()); + gcc_checking_assert (!r.undefined_p () && !varying_p ()); + + signop sign = TYPE_SIGN (TREE_TYPE (m_base[0])); + // Check if current lower bound is also the new lower bound. + if (wi::le_p (wi::to_wide (m_base[0]), wi::to_wide (r.m_base[0]), sign)) + { + // If current upper bound is new upper bound, we're done. + if (wi::le_p (wi::to_wide (r.m_base[1]), wi::to_wide (m_base[1]), sign)) + return false; + // Otherwise R has the new upper bound. + // Check for overlap/touching ranges, or single target range. + if (m_max_ranges == 1 + || wi::to_widest (m_base[1]) + 1 >= wi::to_widest (r.m_base[0])) + { + m_base[1] = r.m_base[1]; + if (varying_compatible_p ()) + m_kind = VR_VARYING; + } + else + { + // This is a dual range result. + m_base[2] = r.m_base[0]; + m_base[3] = r.m_base[1]; + m_num_ranges = 2; + } + if (flag_checking) + verify_range (); + return true; + } + + // Set the new lower bound to R's lower bound. + tree lb = m_base[0]; + m_base[0] = r.m_base[0]; + + // If R fully contains THIS range, just set the upper bound. + if (wi::ge_p (wi::to_wide (r.m_base[1]), wi::to_wide (m_base[1]), sign)) + m_base[1] = r.m_base[1]; + // Check for overlapping ranges, or target limited to a single range. + else if (m_max_ranges == 1 + || wi::to_widest (r.m_base[1]) + 1 >= wi::to_widest (lb)) + { + // This has the new upper bound, just check for varying. + if (varying_compatible_p ()) + m_kind = VR_VARYING; } else - irange_intersect (*other); + { + // Left with 2 pairs. + m_num_ranges = 2; + m_base[2] = lb; + m_base[3] = m_base[1]; + m_base[1] = r.m_base[1]; + } + if (flag_checking) + verify_range (); + return true; } // union_ for multi-ranges. -void +bool irange::irange_union (const irange &r) { gcc_checking_assert (!legacy_mode_p () && !r.legacy_mode_p ()); if (r.undefined_p () || varying_p ()) - return; + return false; if (undefined_p () || r.varying_p ()) { operator= (r); - return; + return true; } + // Special case one range union one range. + if (m_num_ranges == 1 && r.m_num_ranges == 1) + return irange_single_pair_union (r); + + // If this ranges fully contains R, then we need do nothing. + if (irange_contains_p (r)) + return false; + // Do not worry about merging and such by reserving twice as many // pairs as needed, and then simply sort the 2 ranges into this // intermediate form. @@ -1628,11 +1702,58 @@ irange::irange_union (const irange &r) if (flag_checking) verify_range (); + return true; } -// intersect for multi-ranges. +// Return TRUE if THIS fully contains R. No undefined or varying cases. -void +bool +irange::irange_contains_p (const irange &r) const +{ + gcc_checking_assert (!undefined_p () && !varying_p ()); + gcc_checking_assert (!r.undefined_p () && !varying_p ()); + + // In order for THIS to fully contain R, all of the pairs within R must + // be fully contained by the pairs in this object. + signop sign = TYPE_SIGN (TREE_TYPE(m_base[0])); + unsigned ri = 0; + unsigned i = 0; + tree rl = r.m_base[0]; + tree ru = r.m_base[1]; + tree l = m_base[0]; + tree u = m_base[1]; + while (1) + { + // If r is contained within this range, move to the next R + if (wi::ge_p (wi::to_wide (rl), wi::to_wide (l), sign) + && wi::le_p (wi::to_wide (ru), wi::to_wide (u), sign)) + { + // This pair is OK, Either done, or bump to the next. + if (++ri >= r.num_pairs ()) + return true; + rl = r.m_base[ri * 2]; + ru = r.m_base[ri * 2 + 1]; + continue; + } + // Otherwise, check if this's pair occurs before R's. + if (wi::lt_p (wi::to_wide (u), wi::to_wide (rl), sign)) + { + // THere's still at leats one pair of R left. + if (++i >= num_pairs ()) + return false; + l = m_base[i * 2]; + u = m_base[i * 2 + 1]; + continue; + } + return false; + } + return false; +} + + +// Intersect for multi-ranges. Return TRUE if anything changes. + +bool irange::irange_intersect (const irange &r) { gcc_checking_assert (!legacy_mode_p () && !r.legacy_mode_p ()); @@ -1640,24 +1761,24 @@ irange::irange_intersect (const irange &r) || range_compatible_p (type (), r.type ())); if (undefined_p () || r.varying_p ()) - return; + return false; if (r.undefined_p ()) { set_undefined (); - return; + return true; } if (varying_p ()) { operator= (r); - return; + return true; } if (r.num_pairs () == 1) - { - // R cannot be undefined, use more efficent pair routine. - intersect (r.lower_bound(), r.upper_bound ()); - return; - } + return intersect (r.lower_bound (), r.upper_bound ()); + + // If R fully contains this, then intersection will change nothing. + if (r.irange_contains_p (*this)) + return false; signop sign = TYPE_SIGN (TREE_TYPE(m_base[0])); unsigned bld_pair = 0; @@ -1732,21 +1853,25 @@ irange::irange_intersect (const irange &r) if (flag_checking) verify_range (); + + return true; } + // Multirange intersect for a specified wide_int [lb, ub] range. +// Return TRUE if intersect changed anything. -void +bool irange::intersect (const wide_int& lb, const wide_int& ub) { // Undefined remains undefined. if (undefined_p ()) - return; + return false; if (legacy_mode_p ()) { intersect (int_range<1> (type (), lb, ub)); - return; + return true; } tree range_type = type(); @@ -1755,6 +1880,11 @@ irange::intersect (const wide_int& lb, const wide_int& ub) gcc_checking_assert (TYPE_PRECISION (range_type) == wi::get_precision (lb)); gcc_checking_assert (TYPE_PRECISION (range_type) == wi::get_precision (ub)); + // If this range is fuly contained, then intersection will do nothing. + if (wi::ge_p (lower_bound (), lb, sign) + && wi::le_p (upper_bound (), ub, sign)) + return false; + unsigned bld_index = 0; unsigned pair_lim = num_pairs (); for (unsigned i = 0; i < pair_lim; i++) @@ -1793,7 +1923,10 @@ irange::intersect (const wide_int& lb, const wide_int& ub) if (flag_checking) verify_range (); + return true; } + + // Signed 1-bits are strange. You can't subtract 1, because you can't // represent the number 1. This works around that for the invert routine. diff --git a/gcc/value-range.h b/gcc/value-range.h index 90a395f..ec59d2e 100644 --- a/gcc/value-range.h +++ b/gcc/value-range.h @@ -71,8 +71,8 @@ public: bool contains_p (tree) const; // In-place operators. - void union_ (const irange &); - void intersect (const irange &); + bool union_ (const irange &); + bool intersect (const irange &); void invert (); // Operator overloads. @@ -96,8 +96,8 @@ public: bool may_contain_p (tree) const; // DEPRECATED void set (tree); // DEPRECATED bool equal_p (const irange &) const; // DEPRECATED - void legacy_verbose_union_ (const class irange *); // DEPRECATED - void legacy_verbose_intersect (const irange *); // DEPRECATED + bool legacy_verbose_union_ (const class irange *); // DEPRECATED + bool legacy_verbose_intersect (const irange *); // DEPRECATED protected: irange (tree *, unsigned); @@ -107,10 +107,12 @@ protected: tree tree_upper_bound () const; // In-place operators. - void irange_union (const irange &); - void irange_intersect (const irange &); + bool irange_union (const irange &); + bool irange_intersect (const irange &); void irange_set (tree, tree); void irange_set_anti_range (tree, tree); + bool irange_contains_p (const irange &) const; + bool irange_single_pair_union (const irange &r); void normalize_kind (); @@ -134,7 +136,7 @@ private: void irange_set_1bit_anti_range (tree, tree); bool varying_compatible_p () const; - void intersect (const wide_int& lb, const wide_int& ub); + bool intersect (const wide_int& lb, const wide_int& ub); unsigned char m_num_ranges; unsigned char m_max_ranges; ENUM_BITFIELD(value_range_kind) m_kind : 8; @@ -544,22 +546,24 @@ irange::upper_bound () const return upper_bound (pairs - 1); } -inline void +inline bool irange::union_ (const irange &r) { dump_flags_t m_flags = dump_flags; dump_flags &= ~TDF_DETAILS; - irange::legacy_verbose_union_ (&r); + bool ret = irange::legacy_verbose_union_ (&r); dump_flags = m_flags; + return ret; } -inline void +inline bool irange::intersect (const irange &r) { dump_flags_t m_flags = dump_flags; dump_flags &= ~TDF_DETAILS; - irange::legacy_verbose_intersect (&r); + bool ret = irange::legacy_verbose_intersect (&r); dump_flags = m_flags; + return ret; } // Set value range VR to a nonzero range of type TYPE. diff --git a/gcc/value-relation.cc b/gcc/value-relation.cc index 077ab42..a935651 100644 --- a/gcc/value-relation.cc +++ b/gcc/value-relation.cc @@ -32,84 +32,72 @@ along with GCC; see the file COPYING3. If not see #include "alloc-pool.h" #include "dominance.h" -// These VREL codes are arranged such that VREL_NONE is the first -// code, and all the rest are contiguous up to and including VREL_LAST. - -#define VREL_FIRST VREL_NONE -#define VREL_LAST NE_EXPR -#define VREL_COUNT (VREL_LAST - VREL_FIRST + 1) - -// vrel_range_assert will either assert that the tree code passed is valid, -// or mark invalid codes as unreachable to help with table optimation. -#if CHECKING_P - #define vrel_range_assert(c) \ - gcc_checking_assert ((c) >= VREL_FIRST && (c) <= VREL_LAST) -#else - #define vrel_range_assert(c) \ - if ((c) < VREL_FIRST || (c) > VREL_LAST) \ - gcc_unreachable (); -#endif - -static const char *kind_string[VREL_COUNT] = -{ "none", "<", "<=", ">", ">=", "empty", "==", "!=" }; +#define VREL_LAST VREL_NE + +static const char *kind_string[VREL_LAST + 1] = +{ "varying", "undefined", "<", "<=", ">", ">=", "==", "!=" }; // Print a relation_kind REL to file F. void print_relation (FILE *f, relation_kind rel) { - vrel_range_assert (rel); - fprintf (f, " %s ", kind_string[rel - VREL_FIRST]); + fprintf (f, " %s ", kind_string[rel]); } // This table is used to negate the operands. op1 REL op2 -> !(op1 REL op2). -relation_kind rr_negate_table[VREL_COUNT] = { -// NONE, LT_EXPR, LE_EXPR, GT_EXPR, GE_EXPR, EMPTY, EQ_EXPR, NE_EXPR - VREL_NONE, GE_EXPR, GT_EXPR, LE_EXPR, LT_EXPR, VREL_EMPTY, NE_EXPR, EQ_EXPR }; +relation_kind rr_negate_table[VREL_LAST + 1] = { + VREL_VARYING, VREL_UNDEFINED, VREL_GE, VREL_GT, VREL_LE, VREL_LT, VREL_NE, + VREL_EQ }; // Negate the relation, as in logical negation. relation_kind relation_negate (relation_kind r) { - vrel_range_assert (r); - return rr_negate_table [r - VREL_FIRST]; + return rr_negate_table [r]; } // This table is used to swap the operands. op1 REL op2 -> op2 REL op1. -relation_kind rr_swap_table[VREL_COUNT] = { -// NONE, LT_EXPR, LE_EXPR, GT_EXPR, GE_EXPR, EMPTY, EQ_EXPR, NE_EXPR - VREL_NONE, GT_EXPR, GE_EXPR, LT_EXPR, LE_EXPR, VREL_EMPTY, EQ_EXPR, NE_EXPR }; +relation_kind rr_swap_table[VREL_LAST + 1] = { + VREL_VARYING, VREL_UNDEFINED, VREL_GT, VREL_GE, VREL_LT, VREL_LE, VREL_EQ, + VREL_NE }; // Return the relation as if the operands were swapped. relation_kind relation_swap (relation_kind r) { - vrel_range_assert (r); - return rr_swap_table [r - VREL_FIRST]; + return rr_swap_table [r]; } // This table is used to perform an intersection between 2 relations. -relation_kind rr_intersect_table[VREL_COUNT][VREL_COUNT] = { -// NONE, LT_EXPR, LE_EXPR, GT_EXPR, GE_EXPR, EMPTY, EQ_EXPR, NE_EXPR -// VREL_NONE - { VREL_NONE, LT_EXPR, LE_EXPR, GT_EXPR, GE_EXPR, VREL_EMPTY, EQ_EXPR, NE_EXPR }, -// LT_EXPR - { LT_EXPR, LT_EXPR, LT_EXPR, VREL_EMPTY, VREL_EMPTY, VREL_EMPTY, VREL_EMPTY, LT_EXPR }, -// LE_EXPR - { LE_EXPR, LT_EXPR, LE_EXPR, VREL_EMPTY, EQ_EXPR, VREL_EMPTY, EQ_EXPR, LT_EXPR }, -// GT_EXPR - { GT_EXPR, VREL_EMPTY, VREL_EMPTY, GT_EXPR, GT_EXPR, VREL_EMPTY, VREL_EMPTY, GT_EXPR }, -// GE_EXPR - { GE_EXPR, VREL_EMPTY, EQ_EXPR, GT_EXPR, GE_EXPR, VREL_EMPTY, EQ_EXPR, GT_EXPR }, -// VREL_EMPTY - { VREL_EMPTY, VREL_EMPTY, VREL_EMPTY, VREL_EMPTY, VREL_EMPTY, VREL_EMPTY, VREL_EMPTY, VREL_EMPTY }, -// EQ_EXPR - { EQ_EXPR, VREL_EMPTY, EQ_EXPR, VREL_EMPTY, EQ_EXPR, VREL_EMPTY, EQ_EXPR, VREL_EMPTY }, -// NE_EXPR - { NE_EXPR, LT_EXPR, LT_EXPR, GT_EXPR, GT_EXPR, VREL_EMPTY, VREL_EMPTY, NE_EXPR } }; +relation_kind rr_intersect_table[VREL_LAST + 1][VREL_LAST + 1] = { +// VREL_VARYING + { VREL_VARYING, VREL_UNDEFINED, VREL_LT, VREL_LE, VREL_GT, VREL_GE, VREL_EQ, + VREL_NE }, +// VREL_UNDEFINED + { VREL_UNDEFINED, VREL_UNDEFINED, VREL_UNDEFINED, VREL_UNDEFINED, + VREL_UNDEFINED, VREL_UNDEFINED, VREL_UNDEFINED, VREL_UNDEFINED }, +// VREL_LT + { VREL_LT, VREL_UNDEFINED, VREL_LT, VREL_LT, VREL_UNDEFINED, VREL_UNDEFINED, + VREL_UNDEFINED, VREL_LT }, +// VREL_LE + { VREL_LE, VREL_UNDEFINED, VREL_LT, VREL_LE, VREL_UNDEFINED, VREL_EQ, + VREL_EQ, VREL_LT }, +// VREL_GT + { VREL_GT, VREL_UNDEFINED, VREL_UNDEFINED, VREL_UNDEFINED, VREL_GT, VREL_GT, + VREL_UNDEFINED, VREL_GT }, +// VREL_GE + { VREL_GE, VREL_UNDEFINED, VREL_UNDEFINED, VREL_EQ, VREL_GT, VREL_GE, + VREL_EQ, VREL_GT }, +// VREL_EQ + { VREL_EQ, VREL_UNDEFINED, VREL_UNDEFINED, VREL_EQ, VREL_UNDEFINED, VREL_EQ, + VREL_EQ, VREL_UNDEFINED }, +// VREL_NE + { VREL_NE, VREL_UNDEFINED, VREL_LT, VREL_LT, VREL_GT, VREL_GT, + VREL_UNDEFINED, VREL_NE } }; // Intersect relation R1 with relation R2 and return the resulting relation. @@ -117,65 +105,75 @@ relation_kind rr_intersect_table[VREL_COUNT][VREL_COUNT] = { relation_kind relation_intersect (relation_kind r1, relation_kind r2) { - vrel_range_assert (r1); - vrel_range_assert (r2); - return rr_intersect_table[r1 - VREL_FIRST][r2 - VREL_FIRST]; + return rr_intersect_table[r1][r2]; } // This table is used to perform a union between 2 relations. -relation_kind rr_union_table[VREL_COUNT][VREL_COUNT] = { -// NONE, LT_EXPR, LE_EXPR, GT_EXPR, GE_EXPR, EMPTY, EQ_EXPR, NE_EXPR -// VREL_NONE - { VREL_NONE, VREL_NONE, VREL_NONE, VREL_NONE, VREL_NONE, VREL_NONE, VREL_NONE, VREL_NONE }, -// LT_EXPR - { VREL_NONE, LT_EXPR, LE_EXPR, NE_EXPR, VREL_NONE, LT_EXPR, LE_EXPR, NE_EXPR }, -// LE_EXPR - { VREL_NONE, LE_EXPR, LE_EXPR, VREL_NONE, VREL_NONE, LE_EXPR, LE_EXPR, VREL_NONE }, -// GT_EXPR - { VREL_NONE, NE_EXPR, VREL_NONE, GT_EXPR, GE_EXPR, GT_EXPR, GE_EXPR, NE_EXPR }, -// GE_EXPR - { VREL_NONE, VREL_NONE, VREL_NONE, GE_EXPR, GE_EXPR, GE_EXPR, GE_EXPR, VREL_NONE }, -// VREL_EMPTY - { VREL_NONE, LT_EXPR, LE_EXPR, GT_EXPR, GE_EXPR, VREL_EMPTY, EQ_EXPR, NE_EXPR }, -// EQ_EXPR - { VREL_NONE, LE_EXPR, LE_EXPR, GE_EXPR, GE_EXPR, EQ_EXPR, EQ_EXPR, VREL_NONE }, -// NE_EXPR - { VREL_NONE, NE_EXPR, VREL_NONE, NE_EXPR, VREL_NONE, NE_EXPR, VREL_NONE, NE_EXPR } }; +relation_kind rr_union_table[VREL_LAST + 1][VREL_LAST + 1] = { +// VREL_VARYING + { VREL_VARYING, VREL_VARYING, VREL_VARYING, VREL_VARYING, VREL_VARYING, + VREL_VARYING, VREL_VARYING, VREL_VARYING }, +// VREL_UNDEFINED + { VREL_VARYING, VREL_LT, VREL_LE, VREL_GT, VREL_GE, VREL_UNDEFINED, + VREL_EQ, VREL_NE }, +// VREL_LT + { VREL_VARYING, VREL_LT, VREL_LT, VREL_LE, VREL_NE, VREL_VARYING, VREL_LE, + VREL_NE }, +// VREL_LE + { VREL_VARYING, VREL_LE, VREL_LE, VREL_LE, VREL_VARYING, VREL_VARYING, + VREL_LE, VREL_VARYING }, +// VREL_GT + { VREL_VARYING, VREL_GT, VREL_NE, VREL_VARYING, VREL_GT, VREL_GE, VREL_GE, + VREL_NE }, +// VREL_GE + { VREL_VARYING, VREL_GE, VREL_VARYING, VREL_VARYING, VREL_GE, VREL_GE, + VREL_GE, VREL_VARYING }, +// VREL_EQ + { VREL_VARYING, VREL_EQ, VREL_LE, VREL_LE, VREL_GE, VREL_GE, VREL_EQ, + VREL_VARYING }, +// VREL_NE + { VREL_VARYING, VREL_NE, VREL_NE, VREL_VARYING, VREL_NE, VREL_VARYING, + VREL_VARYING, VREL_NE } }; // Union relation R1 with relation R2 and return the result. relation_kind relation_union (relation_kind r1, relation_kind r2) { - vrel_range_assert (r1); - vrel_range_assert (r2); - return rr_union_table[r1 - VREL_FIRST][r2 - VREL_FIRST]; + return rr_union_table[r1][r2]; } // This table is used to determine transitivity between 2 relations. // (A relation0 B) and (B relation1 C) implies (A result C) -relation_kind rr_transitive_table[VREL_COUNT][VREL_COUNT] = { -// NONE, LT_EXPR, LE_EXPR, GT_EXPR, GE_EXPR, EMPTY, EQ_EXPR, NE_EXPR -// VREL_NONE - { VREL_NONE, VREL_NONE, VREL_NONE, VREL_NONE, VREL_NONE, VREL_NONE, VREL_NONE, VREL_NONE }, -// LT_EXPR - { VREL_NONE, LT_EXPR, LT_EXPR, VREL_NONE, VREL_NONE, VREL_NONE, LT_EXPR, VREL_NONE }, -// LE_EXPR - { VREL_NONE, LT_EXPR, LE_EXPR, VREL_NONE, VREL_NONE, VREL_NONE, LE_EXPR, VREL_NONE }, -// GT_EXPR - { VREL_NONE, VREL_NONE, VREL_NONE, GT_EXPR, GT_EXPR, VREL_NONE, GT_EXPR, VREL_NONE }, -// GE_EXPR - { VREL_NONE, VREL_NONE, VREL_NONE, GT_EXPR, GE_EXPR, VREL_NONE, GE_EXPR, VREL_NONE }, -// VREL_EMPTY - { VREL_NONE, VREL_NONE, VREL_NONE, VREL_NONE, VREL_NONE, VREL_NONE, VREL_NONE, VREL_NONE }, -// EQ_EXPR - { VREL_NONE, LT_EXPR, LE_EXPR, GT_EXPR, GE_EXPR, VREL_NONE, EQ_EXPR, VREL_NONE }, -// NE_EXPR - { VREL_NONE, VREL_NONE, VREL_NONE, VREL_NONE, VREL_NONE, VREL_NONE, VREL_NONE, VREL_NONE } }; +relation_kind rr_transitive_table[VREL_LAST + 1][VREL_LAST + 1] = { +// VREL_VARYING + { VREL_VARYING, VREL_VARYING, VREL_VARYING, VREL_VARYING, VREL_VARYING, + VREL_VARYING, VREL_VARYING, VREL_VARYING }, +// VREL_UNDEFINED + { VREL_VARYING, VREL_VARYING, VREL_VARYING, VREL_VARYING, VREL_VARYING, + VREL_VARYING, VREL_VARYING, VREL_VARYING }, +// VREL_LT + { VREL_VARYING, VREL_VARYING, VREL_LT, VREL_LT, VREL_VARYING, VREL_VARYING, + VREL_LT, VREL_VARYING }, +// VREL_LE + { VREL_VARYING, VREL_VARYING, VREL_LT, VREL_LE, VREL_VARYING, VREL_VARYING, + VREL_LE, VREL_VARYING }, +// VREL_GT + { VREL_VARYING, VREL_VARYING, VREL_VARYING, VREL_VARYING, VREL_GT, VREL_GT, + VREL_GT, VREL_VARYING }, +// VREL_GE + { VREL_VARYING, VREL_VARYING, VREL_VARYING, VREL_VARYING, VREL_GT, VREL_GE, + VREL_GE, VREL_VARYING }, +// VREL_EQ + { VREL_VARYING, VREL_VARYING, VREL_LT, VREL_LE, VREL_GT, VREL_GE, VREL_EQ, + VREL_VARYING }, +// VREL_NE + { VREL_VARYING, VREL_VARYING, VREL_VARYING, VREL_VARYING, VREL_VARYING, + VREL_VARYING, VREL_VARYING, VREL_VARYING } }; // Apply transitive operation between relation R1 and relation R2, and // return the resulting relation, if any. @@ -183,9 +181,7 @@ relation_kind rr_transitive_table[VREL_COUNT][VREL_COUNT] = { relation_kind relation_transitive (relation_kind r1, relation_kind r2) { - vrel_range_assert (r1); - vrel_range_assert (r2); - return rr_transitive_table[r1 - VREL_FIRST][r2 - VREL_FIRST]; + return rr_transitive_table[r1][r2]; } // Given an equivalence set EQUIV, set all the bits in B that are still valid @@ -311,8 +307,8 @@ equiv_oracle::query_relation (basic_block bb, tree ssa1, tree ssa2) { // If the 2 ssa names share the same equiv set, they are equal. if (equiv_set (ssa1, bb) == equiv_set (ssa2, bb)) - return EQ_EXPR; - return VREL_NONE; + return VREL_EQ; + return VREL_VARYING; } // Query if thre is a relation (equivalence) between 2 SSA_NAMEs. @@ -323,8 +319,8 @@ equiv_oracle::query_relation (basic_block bb ATTRIBUTE_UNUSED, const_bitmap e1, { // If the 2 ssa names share the same equiv set, they are equal. if (bitmap_equal_p (e1, e2)) - return EQ_EXPR; - return VREL_NONE; + return VREL_EQ; + return VREL_VARYING; } // If SSA has an equivalence in block BB, find and return it. @@ -455,7 +451,7 @@ equiv_oracle::register_relation (basic_block bb, relation_kind k, tree ssa1, tree ssa2) { // Only handle equality relations. - if (k != EQ_EXPR) + if (k != VREL_EQ) return; unsigned v1 = SSA_NAME_VERSION (ssa1); @@ -617,7 +613,7 @@ value_relation::set_relation (relation_kind r, tree n1, tree n2) inline value_relation::value_relation () { - related = VREL_NONE; + related = VREL_VARYING; name1 = NULL_TREE; name2 = NULL_TREE; } @@ -680,7 +676,7 @@ value_relation::union_ (value_relation &p) bool value_relation::apply_transitive (const value_relation &rel) { - relation_kind k = VREL_NONE; + relation_kind k = VREL_VARYING; // Idenity any common operand, and notrmalize the relations to // the form : A < B B < C produces A < C @@ -690,7 +686,7 @@ value_relation::apply_transitive (const value_relation &rel) if (rel.op2 () == name1) return false; k = relation_transitive (kind (), rel.kind ()); - if (k != VREL_NONE) + if (k != VREL_VARYING) { related = k; name2 = rel.op2 (); @@ -703,7 +699,7 @@ value_relation::apply_transitive (const value_relation &rel) if (rel.op2 () == name2) return false; k = relation_transitive (relation_swap (kind ()), rel.kind ()); - if (k != VREL_NONE) + if (k != VREL_VARYING) { related = k; name1 = name2; @@ -717,7 +713,7 @@ value_relation::apply_transitive (const value_relation &rel) if (rel.op1 () == name1) return false; k = relation_transitive (kind (), relation_swap (rel.kind ())); - if (k != VREL_NONE) + if (k != VREL_VARYING) { related = k; name2 = rel.op1 (); @@ -731,7 +727,7 @@ value_relation::apply_transitive (const value_relation &rel) return false; k = relation_transitive (relation_swap (kind ()), relation_swap (rel.kind ())); - if (k != VREL_NONE) + if (k != VREL_VARYING) { related = k; name1 = name2; @@ -776,11 +772,11 @@ relation_kind relation_chain_head::find_relation (const_bitmap b1, const_bitmap b2) const { if (!m_names) - return VREL_NONE; + return VREL_VARYING; // If both b1 and b2 aren't referenced in thie block, cant be a relation if (!bitmap_intersect_p (m_names, b1) || !bitmap_intersect_p (m_names, b2)) - return VREL_NONE; + return VREL_VARYING; // Search for the fiorst relation that contains BOTH an element from B1 // and B2, and return that relation. @@ -794,7 +790,7 @@ relation_chain_head::find_relation (const_bitmap b1, const_bitmap b2) const return relation_swap (ptr->kind ()); } - return VREL_NONE; + return VREL_VARYING; } // Instantiate a relation oracle. @@ -826,7 +822,7 @@ relation_oracle::register_stmt (gimple *stmt, relation_kind k, tree op1, gcc_checking_assert (stmt && gimple_bb (stmt)); // Don't register lack of a relation. - if (k == VREL_NONE) + if (k == VREL_VARYING) return; if (dump_file && (dump_flags & TDF_DETAILS)) @@ -842,7 +838,7 @@ relation_oracle::register_stmt (gimple *stmt, relation_kind k, tree op1, // make sure that that argument is not defined in the same block. // This can happen along back edges and the equivalence will not be // applicable as it would require a use before def. - if (k == EQ_EXPR && is_a<gphi *> (stmt)) + if (k == VREL_EQ && is_a<gphi *> (stmt)) { tree phi_def = gimple_phi_result (stmt); gcc_checking_assert (phi_def == op1 || phi_def == op2); @@ -873,7 +869,7 @@ relation_oracle::register_edge (edge e, relation_kind k, tree op1, tree op2) // Do not register lack of relation, or blocks which have more than // edge E for a predecessor. - if (k == VREL_NONE || !single_pred_p (e->dest)) + if (k == VREL_VARYING || !single_pred_p (e->dest)) return; if (dump_file && (dump_flags & TDF_DETAILS)) @@ -901,7 +897,7 @@ dom_oracle::register_relation (basic_block bb, relation_kind k, tree op1, return; // Equivalencies are handled by the equivalence oracle. - if (k == EQ_EXPR) + if (k == VREL_EQ) equiv_oracle::register_relation (bb, k, op1, op2); else { @@ -919,7 +915,7 @@ relation_chain * dom_oracle::set_one_relation (basic_block bb, relation_kind k, tree op1, tree op2) { - gcc_checking_assert (k != VREL_NONE && k != EQ_EXPR); + gcc_checking_assert (k != VREL_VARYING && k != VREL_EQ); value_relation vr(k, op1, op2); int bbi = bb->index; @@ -938,7 +934,7 @@ dom_oracle::set_one_relation (basic_block bb, relation_kind k, tree op1, relation_chain *ptr; curr = find_relation_block (bbi, v1, v2, &ptr); // There is an existing relation in this block, just intersect with it. - if (curr != VREL_NONE) + if (curr != VREL_VARYING) { if (dump_file && (dump_flags & TDF_DETAILS)) { @@ -969,7 +965,7 @@ dom_oracle::set_one_relation (basic_block bb, relation_kind k, tree op1, // By including dominating relations, The first one found in any search // will be the aggregate of all the previous ones. curr = find_relation_dom (bb, v1, v2); - if (curr != VREL_NONE) + if (curr != VREL_VARYING) k = relation_intersect (curr, k); bitmap_set_bit (bm, v1); @@ -999,10 +995,10 @@ dom_oracle::register_transitives (basic_block root_bb, // Only apply transitives to certain kinds of operations. switch (relation.kind ()) { - case LE_EXPR: - case LT_EXPR: - case GT_EXPR: - case GE_EXPR: + case VREL_LE: + case VREL_LT: + case VREL_GT: + case VREL_GE: break; default: return; @@ -1087,7 +1083,7 @@ dom_oracle::find_relation_block (unsigned bb, const_bitmap b1, const_bitmap b2) const { if (bb >= m_relations.length()) - return VREL_NONE; + return VREL_VARYING; return m_relations[bb].find_relation (b1, b2); } @@ -1101,21 +1097,21 @@ dom_oracle::query_relation (basic_block bb, const_bitmap b1, { relation_kind r; if (bitmap_equal_p (b1, b2)) - return EQ_EXPR; + return VREL_EQ; // If either name does not occur in a relation anywhere, there isnt one. if (!bitmap_intersect_p (m_relation_set, b1) || !bitmap_intersect_p (m_relation_set, b2)) - return VREL_NONE; + return VREL_VARYING; // Search each block in the DOM tree checking. for ( ; bb; bb = get_immediate_dominator (CDI_DOMINATORS, bb)) { r = find_relation_block (bb->index, b1, b2); - if (r != VREL_NONE) + if (r != VREL_VARYING) return r; } - return VREL_NONE; + return VREL_VARYING; } @@ -1127,15 +1123,15 @@ dom_oracle::find_relation_block (int bb, unsigned v1, unsigned v2, relation_chain **obj) const { if (bb >= (int)m_relations.length()) - return VREL_NONE; + return VREL_VARYING; const_bitmap bm = m_relations[bb].m_names; if (!bm) - return VREL_NONE; + return VREL_VARYING; // If both b1 and b2 aren't referenced in thie block, cant be a relation if (!bitmap_bit_p (bm, v1) || !bitmap_bit_p (bm, v2)) - return VREL_NONE; + return VREL_VARYING; relation_chain *ptr; for (ptr = m_relations[bb].m_head; ptr ; ptr = ptr->m_next) @@ -1156,7 +1152,7 @@ dom_oracle::find_relation_block (int bb, unsigned v1, unsigned v2, } } - return VREL_NONE; + return VREL_VARYING; } // Find a relation between SSA version V1 and V2 in the dominator tree @@ -1168,15 +1164,15 @@ dom_oracle::find_relation_dom (basic_block bb, unsigned v1, unsigned v2) const relation_kind r; // IF either name does not occur in a relation anywhere, there isnt one. if (!bitmap_bit_p (m_relation_set, v1) || !bitmap_bit_p (m_relation_set, v2)) - return VREL_NONE; + return VREL_VARYING; for ( ; bb; bb = get_immediate_dominator (CDI_DOMINATORS, bb)) { r = find_relation_block (bb->index, v1, v2); - if (r != VREL_NONE) + if (r != VREL_VARYING) return r; } - return VREL_NONE; + return VREL_VARYING; } @@ -1190,17 +1186,17 @@ dom_oracle::query_relation (basic_block bb, tree ssa1, tree ssa2) unsigned v1 = SSA_NAME_VERSION (ssa1); unsigned v2 = SSA_NAME_VERSION (ssa2); if (v1 == v2) - return EQ_EXPR; + return VREL_EQ; // Check for equivalence first. They must be in each equivalency set. const_bitmap equiv1 = equiv_set (ssa1, bb); const_bitmap equiv2 = equiv_set (ssa2, bb); if (bitmap_bit_p (equiv1, v2) && bitmap_bit_p (equiv2, v1)) - return EQ_EXPR; + return VREL_EQ; // Initially look for a direct relationship and just return that. kind = find_relation_dom (bb, v1, v2); - if (kind != VREL_NONE) + if (kind != VREL_VARYING) return kind; // Query using the equiovalence sets. @@ -1388,14 +1384,14 @@ path_oracle::register_relation (basic_block bb, relation_kind k, tree ssa1, fprintf (dump_file, " (root: bb%d)\n", bb->index); } - if (k == EQ_EXPR) + if (k == VREL_EQ) { register_equiv (bb, ssa1, ssa2); return; } relation_kind curr = query_relation (bb, ssa1, ssa2); - if (curr != VREL_NONE) + if (curr != VREL_VARYING) k = relation_intersect (curr, k); bitmap_set_bit (m_relations.m_names, SSA_NAME_VERSION (ssa1)); @@ -1414,7 +1410,7 @@ relation_kind path_oracle::query_relation (basic_block bb, const_bitmap b1, const_bitmap b2) { if (bitmap_equal_p (b1, b2)) - return EQ_EXPR; + return VREL_EQ; relation_kind k = m_relations.find_relation (b1, b2); @@ -1424,7 +1420,7 @@ path_oracle::query_relation (basic_block bb, const_bitmap b1, const_bitmap b2) || bitmap_intersect_p (m_killed_defs, b2)) return k; - if (k == VREL_NONE && m_root) + if (k == VREL_VARYING && m_root) k = m_root->query_relation (bb, b1, b2); return k; @@ -1440,12 +1436,12 @@ path_oracle::query_relation (basic_block bb, tree ssa1, tree ssa2) unsigned v2 = SSA_NAME_VERSION (ssa2); if (v1 == v2) - return EQ_EXPR; + return VREL_EQ; const_bitmap equiv_1 = equiv_set (ssa1, bb); const_bitmap equiv_2 = equiv_set (ssa2, bb); if (bitmap_bit_p (equiv_1, v2) && bitmap_bit_p (equiv_2, v1)) - return EQ_EXPR; + return VREL_EQ; return query_relation (bb, equiv_1, equiv_2); } @@ -1459,6 +1455,7 @@ path_oracle::reset_path () bitmap_clear (m_equiv.m_names); m_relations.m_head = NULL; bitmap_clear (m_relations.m_names); + bitmap_clear (m_killed_defs); } // Dump relation in basic block... Do nothing here. diff --git a/gcc/value-relation.h b/gcc/value-relation.h index 36e4cf9..19762d8 100644 --- a/gcc/value-relation.h +++ b/gcc/value-relation.h @@ -28,7 +28,7 @@ along with GCC; see the file COPYING3. If not see // The general range_query object provided in value-query.h provides // access to an oracle, if one is available, via the oracle() method. // Thre are also a couple of access routines provided, which even if there is -// no oracle, will return the default VREL_NONE no relation. +// no oracle, will return the default VREL_VARYING no relation. // // Typically, when a ranger object is active, there will be an oracle, and // any information available can be directly queried. Ranger also sets and @@ -43,8 +43,8 @@ along with GCC; see the file COPYING3. If not see // block, or on an edge, the possible return values are: // // EQ_EXPR, NE_EXPR, LT_EXPR, LE_EXPR, GT_EXPR, and GE_EXPR mean the same. -// VREL_NONE : No relation between the 2 names. -// VREL_EMPTY : Impossible relation (ie, A < B && A > B produces VREL_EMPTY. +// VREL_VARYING : No relation between the 2 names. +// VREL_UNDEFINED : Impossible relation (ie, A < B && A > B) // // The oracle maintains EQ_EXPR relations with equivalency sets, so if a // relation comes back EQ_EXPR, it is also possible to query the set of @@ -58,13 +58,20 @@ along with GCC; see the file COPYING3. If not see // Rather than introduce a new enumerated type for relations, we can use the // existing tree_codes for relations, plus add a couple of #defines for -// the other cases. These codes are arranged such that VREL_NONE is the first -// code, and all the rest are contiguous. +// the other cases. These codes are arranged such that VREL_VARYING is the +// first code, and all the rest are contiguous. -typedef enum tree_code relation_kind; - -#define VREL_NONE TRUTH_NOT_EXPR -#define VREL_EMPTY LTGT_EXPR +typedef enum relation_kind_t +{ + VREL_VARYING = 0, // No known relation, AKA varying. + VREL_UNDEFINED, // Impossible relation, ie (r1 < r2) && (r2 > r1) + VREL_LT, // r1 < r2 + VREL_LE, // r1 <= r2 + VREL_GT, // r1 > r2 + VREL_GE, // r1 >= r2 + VREL_EQ, // r1 == r2 + VREL_NE // r1 != r2 +} relation_kind; // General relation kind transformations. relation_kind relation_union (relation_kind r1, relation_kind r2); @@ -73,7 +80,6 @@ relation_kind relation_negate (relation_kind r); relation_kind relation_swap (relation_kind r); void print_relation (FILE *f, relation_kind rel); - class relation_oracle { public: diff --git a/gcc/vr-values.cc b/gcc/vr-values.cc index 301996d..2cc5084 100644 --- a/gcc/vr-values.cc +++ b/gcc/vr-values.cc @@ -32,8 +32,8 @@ along with GCC; see the file COPYING3. If not see #include "fold-const.h" #include "calls.h" #include "cfganal.h" -#include "gimple-fold.h" #include "gimple-iterator.h" +#include "gimple-fold.h" #include "tree-cfg.h" #include "tree-ssa-loop-niter.h" #include "tree-ssa-loop.h" diff --git a/libgcc/ChangeLog b/libgcc/ChangeLog index 25f5c19..5d351a6 100644 --- a/libgcc/ChangeLog +++ b/libgcc/ChangeLog @@ -1,3 +1,9 @@ +2022-05-13 Sebastian Pop <spop@amazon.com> + + PR target/105162 + * config/aarch64/lse.S: Define BARRIER and handle memory MODEL 5. + * config/aarch64/t-lse: Add a 5th memory model for _sync functions. + 2022-05-10 Martin Liska <mliska@suse.cz> Hans-Peter Helfert <peter-helfert@t-online.de> diff --git a/libgcc/config/aarch64/lse.S b/libgcc/config/aarch64/lse.S index c353ec2..9c29cf0 100644 --- a/libgcc/config/aarch64/lse.S +++ b/libgcc/config/aarch64/lse.S @@ -87,24 +87,44 @@ see the files COPYING3 and COPYING.RUNTIME respectively. If not, see # define L # define M 0x000000 # define N 0x000000 +# define BARRIER #elif MODEL == 2 # define SUFF _acq # define A a # define L # define M 0x400000 # define N 0x800000 +# define BARRIER #elif MODEL == 3 # define SUFF _rel # define A # define L l # define M 0x008000 # define N 0x400000 +# define BARRIER #elif MODEL == 4 # define SUFF _acq_rel # define A a # define L l # define M 0x408000 # define N 0xc00000 +# define BARRIER +#elif MODEL == 5 +# define SUFF _sync +#ifdef L_swp +/* swp has _acq semantics. */ +# define A a +# define L +# define M 0x400000 +# define N 0x800000 +#else +/* All other _sync functions have _seq semantics. */ +# define A a +# define L l +# define M 0x408000 +# define N 0xc00000 +#endif +# define BARRIER dmb ish #else # error #endif @@ -127,7 +147,12 @@ see the files COPYING3 and COPYING.RUNTIME respectively. If not, see #endif #define NAME(BASE) glue4(__aarch64_, BASE, SIZE, SUFF) -#define LDXR glue4(ld, A, xr, S) +#if MODEL == 5 +/* Drop A for _sync functions. */ +# define LDXR glue3(ld, xr, S) +#else +# define LDXR glue4(ld, A, xr, S) +#endif #define STXR glue4(st, L, xr, S) /* Temporary registers used. Other than these, only the return value @@ -183,10 +208,16 @@ STARTFN NAME(cas) bne 1f STXR w(tmp1), s(1), [x2] cbnz w(tmp1), 0b -1: ret +1: BARRIER + ret #else -#define LDXP glue3(ld, A, xp) +#if MODEL == 5 +/* Drop A for _sync functions. */ +# define LDXP glue2(ld, xp) +#else +# define LDXP glue3(ld, A, xp) +#endif #define STXP glue3(st, L, xp) #ifdef HAVE_AS_LSE # define CASP glue3(casp, A, L) x0, x1, x2, x3, [x4] @@ -205,7 +236,8 @@ STARTFN NAME(cas) bne 1f STXP w(tmp2), x2, x3, [x4] cbnz w(tmp2), 0b -1: ret +1: BARRIER + ret #endif @@ -229,6 +261,7 @@ STARTFN NAME(swp) 0: LDXR s(0), [x1] STXR w(tmp1), s(tmp0), [x1] cbnz w(tmp1), 0b + BARRIER ret ENDFN NAME(swp) @@ -273,6 +306,7 @@ STARTFN NAME(LDNM) OP s(tmp1), s(0), s(tmp0) STXR w(tmp2), s(tmp1), [x1] cbnz w(tmp2), 0b + BARRIER ret ENDFN NAME(LDNM) diff --git a/libgcc/config/aarch64/t-lse b/libgcc/config/aarch64/t-lse index 790cada..624daf7 100644 --- a/libgcc/config/aarch64/t-lse +++ b/libgcc/config/aarch64/t-lse @@ -18,13 +18,13 @@ # along with GCC; see the file COPYING3. If not see # <http://www.gnu.org/licenses/>. -# Compare-and-swap has 5 sizes and 4 memory models. +# Compare-and-swap has 5 sizes and 5 memory models. S0 := $(foreach s, 1 2 4 8 16, $(addsuffix _$(s), cas)) -O0 := $(foreach m, 1 2 3 4, $(addsuffix _$(m)$(objext), $(S0))) +O0 := $(foreach m, 1 2 3 4 5, $(addsuffix _$(m)$(objext), $(S0))) -# Swap, Load-and-operate have 4 sizes and 4 memory models +# Swap, Load-and-operate have 4 sizes and 5 memory models S1 := $(foreach s, 1 2 4 8, $(addsuffix _$(s), swp ldadd ldclr ldeor ldset)) -O1 := $(foreach m, 1 2 3 4, $(addsuffix _$(m)$(objext), $(S1))) +O1 := $(foreach m, 1 2 3 4 5, $(addsuffix _$(m)$(objext), $(S1))) LSE_OBJS := $(O0) $(O1) diff --git a/libgomp/ChangeLog b/libgomp/ChangeLog index 1e9cbf7..3f21ffb 100644 --- a/libgomp/ChangeLog +++ b/libgomp/ChangeLog @@ -1,3 +1,66 @@ +2022-05-13 Tobias Burnus <tobias@codesourcery.com> + + * testsuite/libgomp.fortran/target-nowait-array-section.f90: New test. + +2022-05-13 Tobias Burnus <tobias@codesourcery.com> + + * testsuite/libgomp.fortran/target-nowait-array-section.f90: New test. + +2022-05-13 Thomas Schwinge <thomas@codesourcery.com> + + * plugin/Makefrag.am (libgomp_plugin_nvptx_la_CPPFLAGS) + [PLUGIN_NVPTX_DYNAMIC]: Don't append '$(PLUGIN_NVPTX_CPPFLAGS)'. + (libgomp_plugin_nvptx_la_LDFLAGS) [PLUGIN_NVPTX_DYNAMIC]: Don't + append '$(PLUGIN_NVPTX_LDFLAGS)'. + * Makefile.in: Regenerate. + +2022-05-12 Thomas Schwinge <thomas@codesourcery.com> + + * Makefile.am (libgomp_la_LIBADD): Initialize. + * plugin/configfrag.ac (DL_LIBS): New. + (PLUGIN_GCN_LIBS): Remove. + (PLUGIN_NVPTX_LIBS): Don't set in the 'PLUGIN_NVPTX_DYNAMIC' case. + * plugin/Makefrag.am (libgomp_la_LIBADD) + (libgomp_plugin_gcn_la_LIBADD): Consider '$(DL_LIBS)'. + (libgomp_plugin_nvptx_la_LIBADD) <PLUGIN_NVPTX_DYNAMIC>: Likewise. + * Makefile.in: Regenerate. + * config.h.in: Likewise. + * configure: Likewise. + * testsuite/Makefile.in: Likewise. + +2022-05-12 Thomas Schwinge <thomas@codesourcery.com> + + * plugin/Makefrag.am: Handle 'PLUGIN_NVPTX_DYNAMIC'. + * plugin/configfrag.ac (PLUGIN_NVPTX_DYNAMIC): Change + 'AC_DEFINE_UNQUOTED' into 'AM_CONDITIONAL'. + * plugin/plugin-nvptx.c: Split 'PLUGIN_NVPTX_DYNAMIC' into + 'PLUGIN_NVPTX_INCLUDE_SYSTEM_CUDA_H' and + 'PLUGIN_NVPTX_LINK_LIBCUDA'. + * Makefile.in: Regenerate. + * config.h.in: Likewise. + * configure: Likewise. + +2022-05-12 Thomas Schwinge <thomas@codesourcery.com> + + * plugin/configfrag.ac: Don't 'AC_SUBST' and 'AC_DEFINE_UNQUOTED' + for 'PLUGIN_GCN', 'PLUGIN_NVPTX'. + * Makefile.in: Regenerate. + * config.h.in: Likewise. + * configure: Likewise. + * testsuite/Makefile.in: Likewise. + +2022-05-12 Jakub Jelinek <jakub@redhat.com> + + * libgomp.h (struct gomp_task): Add depend_all_memory member. + * task.c (gomp_init_task): Initialize depend_all_memory. + (gomp_task_handle_depend): Handle omp_all_memory. + (gomp_task_run_post_handle_depend_hash): Clear + parent->depend_all_memory if equal to current task. + (gomp_task_maybe_wait_for_dependencies): Handle omp_all_memory. + * testsuite/libgomp.c-c++-common/depend-1.c: New test. + * testsuite/libgomp.c-c++-common/depend-2.c: New test. + * testsuite/libgomp.c-c++-common/depend-3.c: New test. + 2022-05-11 Thomas Schwinge <thomas@codesourcery.com> * plugin/configfrag.ac: Remove '--with-hsa-runtime', diff --git a/libgomp/Makefile.am b/libgomp/Makefile.am index f8b2a06..428f7a9 100644 --- a/libgomp/Makefile.am +++ b/libgomp/Makefile.am @@ -56,6 +56,7 @@ endif libgomp_version_info = -version-info $(libtool_VERSION) libgomp_la_LDFLAGS = $(libgomp_version_info) $(libgomp_version_script) \ $(lt_host_flags) +libgomp_la_LIBADD = libgomp_la_DEPENDENCIES = $(libgomp_version_dep) libgomp_la_LINK = $(LINK) $(libgomp_la_LDFLAGS) diff --git a/libgomp/Makefile.in b/libgomp/Makefile.in index f2712aa..2ac0397 100644 --- a/libgomp/Makefile.in +++ b/libgomp/Makefile.in @@ -119,8 +119,18 @@ build_triplet = @build@ host_triplet = @host@ target_triplet = @target@ @PLUGIN_NVPTX_TRUE@am__append_1 = libgomp-plugin-nvptx.la -@PLUGIN_GCN_TRUE@am__append_2 = libgomp-plugin-gcn.la -@USE_FORTRAN_TRUE@am__append_3 = openacc.f90 + +# Including the GCC-shipped 'include/cuda/cuda.h' vs. system <cuda.h>. +@PLUGIN_NVPTX_DYNAMIC_FALSE@@PLUGIN_NVPTX_TRUE@am__append_2 = -DPLUGIN_NVPTX_INCLUDE_SYSTEM_CUDA_H \ +@PLUGIN_NVPTX_DYNAMIC_FALSE@@PLUGIN_NVPTX_TRUE@ $(PLUGIN_NVPTX_CPPFLAGS) \ +@PLUGIN_NVPTX_DYNAMIC_FALSE@@PLUGIN_NVPTX_TRUE@ -DPLUGIN_NVPTX_LINK_LIBCUDA + +# 'dlopen'ing the CUDA Driver library vs. linking it. +@PLUGIN_NVPTX_DYNAMIC_TRUE@@PLUGIN_NVPTX_TRUE@am__append_3 = $(DL_LIBS) +@PLUGIN_NVPTX_DYNAMIC_FALSE@@PLUGIN_NVPTX_TRUE@am__append_4 = $(PLUGIN_NVPTX_LDFLAGS) +@PLUGIN_NVPTX_DYNAMIC_FALSE@@PLUGIN_NVPTX_TRUE@am__append_5 = $(PLUGIN_NVPTX_LIBS) +@PLUGIN_GCN_TRUE@am__append_6 = libgomp-plugin-gcn.la +@USE_FORTRAN_TRUE@am__append_7 = openacc.f90 subdir = . ACLOCAL_M4 = $(top_srcdir)/aclocal.m4 am__aclocal_m4_deps = $(top_srcdir)/../config/acx.m4 \ @@ -197,8 +207,10 @@ libgomp_plugin_gcn_la_LINK = $(LIBTOOL) $(AM_V_lt) --tag=CC \ $(libgomp_plugin_gcn_la_LDFLAGS) $(LDFLAGS) -o $@ @PLUGIN_GCN_TRUE@am_libgomp_plugin_gcn_la_rpath = -rpath \ @PLUGIN_GCN_TRUE@ $(toolexeclibdir) +@PLUGIN_NVPTX_DYNAMIC_TRUE@@PLUGIN_NVPTX_TRUE@am__DEPENDENCIES_2 = $(am__DEPENDENCIES_1) +@PLUGIN_NVPTX_DYNAMIC_FALSE@@PLUGIN_NVPTX_TRUE@am__DEPENDENCIES_3 = $(am__DEPENDENCIES_1) @PLUGIN_NVPTX_TRUE@libgomp_plugin_nvptx_la_DEPENDENCIES = libgomp.la \ -@PLUGIN_NVPTX_TRUE@ $(am__DEPENDENCIES_1) +@PLUGIN_NVPTX_TRUE@ $(am__DEPENDENCIES_2) $(am__DEPENDENCIES_3) @PLUGIN_NVPTX_TRUE@am_libgomp_plugin_nvptx_la_OBJECTS = \ @PLUGIN_NVPTX_TRUE@ libgomp_plugin_nvptx_la-plugin-nvptx.lo libgomp_plugin_nvptx_la_OBJECTS = \ @@ -209,7 +221,6 @@ libgomp_plugin_nvptx_la_LINK = $(LIBTOOL) $(AM_V_lt) --tag=CC \ $(libgomp_plugin_nvptx_la_LDFLAGS) $(LDFLAGS) -o $@ @PLUGIN_NVPTX_TRUE@am_libgomp_plugin_nvptx_la_rpath = -rpath \ @PLUGIN_NVPTX_TRUE@ $(toolexeclibdir) -libgomp_la_LIBADD = @USE_FORTRAN_TRUE@am__objects_1 = openacc.lo am_libgomp_la_OBJECTS = alloc.lo atomic.lo barrier.lo critical.lo \ env.lo error.lo icv.lo icv-device.lo iter.lo iter_ull.lo \ @@ -374,6 +385,7 @@ CUDA_DRIVER_LIB = @CUDA_DRIVER_LIB@ CYGPATH_W = @CYGPATH_W@ DEFS = @DEFS@ DEPDIR = @DEPDIR@ +DL_LIBS = @DL_LIBS@ DSYMUTIL = @DSYMUTIL@ DUMPBIN = @DUMPBIN@ ECHO_C = @ECHO_C@ @@ -431,9 +443,6 @@ PACKAGE_URL = @PACKAGE_URL@ PACKAGE_VERSION = @PACKAGE_VERSION@ PATH_SEPARATOR = @PATH_SEPARATOR@ PERL = @PERL@ -PLUGIN_GCN = @PLUGIN_GCN@ -PLUGIN_GCN_LIBS = @PLUGIN_GCN_LIBS@ -PLUGIN_NVPTX = @PLUGIN_NVPTX@ PLUGIN_NVPTX_CPPFLAGS = @PLUGIN_NVPTX_CPPFLAGS@ PLUGIN_NVPTX_LDFLAGS = @PLUGIN_NVPTX_LDFLAGS@ PLUGIN_NVPTX_LIBS = @PLUGIN_NVPTX_LIBS@ @@ -529,7 +538,7 @@ libsubincludedir = $(libdir)/gcc/$(target_alias)/$(gcc_version)/include AM_CPPFLAGS = $(addprefix -I, $(search_path)) AM_CFLAGS = $(XCFLAGS) AM_LDFLAGS = $(XLDFLAGS) $(SECTION_LDFLAGS) $(OPT_LDFLAGS) -toolexeclib_LTLIBRARIES = libgomp.la $(am__append_1) $(am__append_2) +toolexeclib_LTLIBRARIES = libgomp.la $(am__append_1) $(am__append_6) nodist_toolexeclib_HEADERS = libgomp.spec # -Wc is only a libtool option. @@ -545,6 +554,7 @@ libgomp_version_info = -version-info $(libtool_VERSION) libgomp_la_LDFLAGS = $(libgomp_version_info) $(libgomp_version_script) \ $(lt_host_flags) +libgomp_la_LIBADD = $(DL_LIBS) libgomp_la_DEPENDENCIES = $(libgomp_version_dep) libgomp_la_LINK = $(LINK) $(libgomp_la_LDFLAGS) libgomp_la_SOURCES = alloc.c atomic.c barrier.c critical.c env.c \ @@ -555,16 +565,18 @@ libgomp_la_SOURCES = alloc.c atomic.c barrier.c critical.c env.c \ oacc-parallel.c oacc-host.c oacc-init.c oacc-mem.c \ oacc-async.c oacc-plugin.c oacc-cuda.c priority_queue.c \ affinity-fmt.c teams.c allocator.c oacc-profiling.c \ - oacc-target.c $(am__append_3) + oacc-target.c $(am__append_7) # Nvidia PTX OpenACC plugin. @PLUGIN_NVPTX_TRUE@libgomp_plugin_nvptx_version_info = -version-info $(libtool_VERSION) @PLUGIN_NVPTX_TRUE@libgomp_plugin_nvptx_la_SOURCES = plugin/plugin-nvptx.c -@PLUGIN_NVPTX_TRUE@libgomp_plugin_nvptx_la_CPPFLAGS = $(AM_CPPFLAGS) $(PLUGIN_NVPTX_CPPFLAGS) +@PLUGIN_NVPTX_TRUE@libgomp_plugin_nvptx_la_CPPFLAGS = $(AM_CPPFLAGS) \ +@PLUGIN_NVPTX_TRUE@ $(am__append_2) @PLUGIN_NVPTX_TRUE@libgomp_plugin_nvptx_la_LDFLAGS = \ @PLUGIN_NVPTX_TRUE@ $(libgomp_plugin_nvptx_version_info) \ -@PLUGIN_NVPTX_TRUE@ $(lt_host_flags) $(PLUGIN_NVPTX_LDFLAGS) -@PLUGIN_NVPTX_TRUE@libgomp_plugin_nvptx_la_LIBADD = libgomp.la $(PLUGIN_NVPTX_LIBS) +@PLUGIN_NVPTX_TRUE@ $(lt_host_flags) $(am__append_4) +@PLUGIN_NVPTX_TRUE@libgomp_plugin_nvptx_la_LIBADD = libgomp.la \ +@PLUGIN_NVPTX_TRUE@ $(am__append_3) $(am__append_5) @PLUGIN_NVPTX_TRUE@libgomp_plugin_nvptx_la_LIBTOOLFLAGS = --tag=disable-static # AMD GCN plugin @@ -576,7 +588,7 @@ libgomp_la_SOURCES = alloc.c atomic.c barrier.c critical.c env.c \ @PLUGIN_GCN_TRUE@libgomp_plugin_gcn_la_LDFLAGS = $(libgomp_plugin_gcn_version_info) \ @PLUGIN_GCN_TRUE@ $(lt_host_flags) -@PLUGIN_GCN_TRUE@libgomp_plugin_gcn_la_LIBADD = libgomp.la $(PLUGIN_GCN_LIBS) +@PLUGIN_GCN_TRUE@libgomp_plugin_gcn_la_LIBADD = libgomp.la $(DL_LIBS) @PLUGIN_GCN_TRUE@libgomp_plugin_gcn_la_LIBTOOLFLAGS = --tag=disable-static nodist_noinst_HEADERS = libgomp_f.h nodist_libsubinclude_HEADERS = omp.h openacc.h acc_prof.h diff --git a/libgomp/config.h.in b/libgomp/config.h.in index e702625..46d3eac 100644 --- a/libgomp/config.h.in +++ b/libgomp/config.h.in @@ -51,9 +51,6 @@ /* Define to 1 if you have the <inttypes.h> header file. */ #undef HAVE_INTTYPES_H -/* Define to 1 if you have the `dl' library (-ldl). */ -#undef HAVE_LIBDL - /* Define to 1 if you have the `memalign' function. */ #undef HAVE_MEMALIGN @@ -170,16 +167,6 @@ /* Define to the version of this package. */ #undef PACKAGE_VERSION -/* Define to 1 if the GCN plugin is built, 0 if not. */ -#undef PLUGIN_GCN - -/* Define to 1 if the NVIDIA plugin is built, 0 if not. */ -#undef PLUGIN_NVPTX - -/* Define to 1 if the NVIDIA plugin should dlopen libcuda.so.1, 0 if it should - be linked against it. */ -#undef PLUGIN_NVPTX_DYNAMIC - /* Define if all infrastructure, needed for plugins, is supported. */ #undef PLUGIN_SUPPORT diff --git a/libgomp/configure b/libgomp/configure index 3de8eb2..66dface 100755 --- a/libgomp/configure +++ b/libgomp/configure @@ -667,20 +667,20 @@ OPT_LDFLAGS SECTION_LDFLAGS PLUGIN_GCN_FALSE PLUGIN_GCN_TRUE +PLUGIN_NVPTX_DYNAMIC_FALSE +PLUGIN_NVPTX_DYNAMIC_TRUE PLUGIN_NVPTX_FALSE PLUGIN_NVPTX_TRUE offload_additional_lib_paths offload_additional_options offload_targets offload_plugins -PLUGIN_GCN_LIBS -PLUGIN_GCN PLUGIN_NVPTX_LIBS PLUGIN_NVPTX_LDFLAGS PLUGIN_NVPTX_CPPFLAGS -PLUGIN_NVPTX CUDA_DRIVER_LIB CUDA_DRIVER_INCLUDE +DL_LIBS libtool_VERSION ac_ct_FC FCFLAGS @@ -15057,6 +15057,8 @@ _ACEOF # <http://www.gnu.org/licenses/>. plugin_support=yes +DL_LIBS= + { $as_echo "$as_me:${as_lineno-$LINENO}: checking for dlsym in -ldl" >&5 $as_echo_n "checking for dlsym in -ldl... " >&6; } if ${ac_cv_lib_dl_dlsym+:} false; then : @@ -15094,12 +15096,7 @@ fi { $as_echo "$as_me:${as_lineno-$LINENO}: result: $ac_cv_lib_dl_dlsym" >&5 $as_echo "$ac_cv_lib_dl_dlsym" >&6; } if test "x$ac_cv_lib_dl_dlsym" = xyes; then : - cat >>confdefs.h <<_ACEOF -#define HAVE_LIBDL 1 -_ACEOF - - LIBS="-ldl $LIBS" - + DL_LIBS=-ldl else plugin_support=no fi @@ -15220,11 +15217,7 @@ PLUGIN_NVPTX_DYNAMIC=0 - PLUGIN_GCN=0 -PLUGIN_GCN_LIBS= - - # Parse '--enable-offload-targets', figure out the corresponding libgomp # plugins, and configure to find the corresponding offload compilers. @@ -15297,7 +15290,6 @@ rm -f core conftest.err conftest.$ac_objext \ && (test "x$CUDA_DRIVER_LIB" = x \ || test "x$CUDA_DRIVER_LIB" = xno); then PLUGIN_NVPTX=1 - PLUGIN_NVPTX_LIBS='-ldl' PLUGIN_NVPTX_DYNAMIC=1 else PLUGIN_NVPTX=0 @@ -15323,8 +15315,6 @@ rm -f core conftest.err conftest.$ac_objext \ ;; *) tgt_plugin=gcn - PLUGIN_GCN=$tgt - PLUGIN_GCN_LIBS="-ldl" PLUGIN_GCN=1 ;; esac @@ -15372,15 +15362,13 @@ else PLUGIN_NVPTX_FALSE= fi - -cat >>confdefs.h <<_ACEOF -#define PLUGIN_NVPTX $PLUGIN_NVPTX -_ACEOF - - -cat >>confdefs.h <<_ACEOF -#define PLUGIN_NVPTX_DYNAMIC $PLUGIN_NVPTX_DYNAMIC -_ACEOF + if test $PLUGIN_NVPTX_DYNAMIC = 1; then + PLUGIN_NVPTX_DYNAMIC_TRUE= + PLUGIN_NVPTX_DYNAMIC_FALSE='#' +else + PLUGIN_NVPTX_DYNAMIC_TRUE='#' + PLUGIN_NVPTX_DYNAMIC_FALSE= +fi if test $PLUGIN_GCN = 1; then PLUGIN_GCN_TRUE= @@ -15391,11 +15379,6 @@ else fi -cat >>confdefs.h <<_ACEOF -#define PLUGIN_GCN $PLUGIN_GCN -_ACEOF - - # Check for functions needed. for ac_func in getloadavg clock_gettime strtoull @@ -17154,6 +17137,10 @@ if test -z "${PLUGIN_NVPTX_TRUE}" && test -z "${PLUGIN_NVPTX_FALSE}"; then as_fn_error $? "conditional \"PLUGIN_NVPTX\" was never defined. Usually this means the macro was only invoked conditionally." "$LINENO" 5 fi +if test -z "${PLUGIN_NVPTX_DYNAMIC_TRUE}" && test -z "${PLUGIN_NVPTX_DYNAMIC_FALSE}"; then + as_fn_error $? "conditional \"PLUGIN_NVPTX_DYNAMIC\" was never defined. +Usually this means the macro was only invoked conditionally." "$LINENO" 5 +fi if test -z "${PLUGIN_GCN_TRUE}" && test -z "${PLUGIN_GCN_FALSE}"; then as_fn_error $? "conditional \"PLUGIN_GCN\" was never defined. Usually this means the macro was only invoked conditionally." "$LINENO" 5 diff --git a/libgomp/plugin/Makefrag.am b/libgomp/plugin/Makefrag.am index 11929d4..66c8c12 100644 --- a/libgomp/plugin/Makefrag.am +++ b/libgomp/plugin/Makefrag.am @@ -26,17 +26,34 @@ # see the files COPYING3 and COPYING.RUNTIME respectively. If not, see # <http://www.gnu.org/licenses/>. +libgomp_la_LIBADD += $(DL_LIBS) + if PLUGIN_NVPTX # Nvidia PTX OpenACC plugin. libgomp_plugin_nvptx_version_info = -version-info $(libtool_VERSION) toolexeclib_LTLIBRARIES += libgomp-plugin-nvptx.la libgomp_plugin_nvptx_la_SOURCES = plugin/plugin-nvptx.c -libgomp_plugin_nvptx_la_CPPFLAGS = $(AM_CPPFLAGS) $(PLUGIN_NVPTX_CPPFLAGS) +libgomp_plugin_nvptx_la_CPPFLAGS = $(AM_CPPFLAGS) libgomp_plugin_nvptx_la_LDFLAGS = $(libgomp_plugin_nvptx_version_info) \ $(lt_host_flags) -libgomp_plugin_nvptx_la_LDFLAGS += $(PLUGIN_NVPTX_LDFLAGS) -libgomp_plugin_nvptx_la_LIBADD = libgomp.la $(PLUGIN_NVPTX_LIBS) +libgomp_plugin_nvptx_la_LIBADD = libgomp.la libgomp_plugin_nvptx_la_LIBTOOLFLAGS = --tag=disable-static + +# Including the GCC-shipped 'include/cuda/cuda.h' vs. system <cuda.h>. +if PLUGIN_NVPTX_DYNAMIC +else +libgomp_plugin_nvptx_la_CPPFLAGS += -DPLUGIN_NVPTX_INCLUDE_SYSTEM_CUDA_H +libgomp_plugin_nvptx_la_CPPFLAGS += $(PLUGIN_NVPTX_CPPFLAGS) +endif + +# 'dlopen'ing the CUDA Driver library vs. linking it. +if PLUGIN_NVPTX_DYNAMIC +libgomp_plugin_nvptx_la_LIBADD += $(DL_LIBS) +else +libgomp_plugin_nvptx_la_CPPFLAGS += -DPLUGIN_NVPTX_LINK_LIBCUDA +libgomp_plugin_nvptx_la_LDFLAGS += $(PLUGIN_NVPTX_LDFLAGS) +libgomp_plugin_nvptx_la_LIBADD += $(PLUGIN_NVPTX_LIBS) +endif endif if PLUGIN_GCN @@ -48,6 +65,8 @@ libgomp_plugin_gcn_la_CPPFLAGS = $(AM_CPPFLAGS) \ -D_GNU_SOURCE libgomp_plugin_gcn_la_LDFLAGS = $(libgomp_plugin_gcn_version_info) \ $(lt_host_flags) -libgomp_plugin_gcn_la_LIBADD = libgomp.la $(PLUGIN_GCN_LIBS) +libgomp_plugin_gcn_la_LIBADD = libgomp.la libgomp_plugin_gcn_la_LIBTOOLFLAGS = --tag=disable-static + +libgomp_plugin_gcn_la_LIBADD += $(DL_LIBS) endif diff --git a/libgomp/plugin/configfrag.ac b/libgomp/plugin/configfrag.ac index 9eeac45..1420304 100644 --- a/libgomp/plugin/configfrag.ac +++ b/libgomp/plugin/configfrag.ac @@ -27,7 +27,9 @@ # <http://www.gnu.org/licenses/>. plugin_support=yes -AC_CHECK_LIB(dl, dlsym, , [plugin_support=no]) +DL_LIBS= +AC_SUBST(DL_LIBS) +AC_CHECK_LIB(dl, dlsym, [DL_LIBS=-ldl], [plugin_support=no]) if test x"$plugin_support" = xyes; then AC_DEFINE(PLUGIN_SUPPORT, 1, [Define if all infrastructure, needed for plugins, is supported.]) @@ -86,15 +88,11 @@ PLUGIN_NVPTX_CPPFLAGS= PLUGIN_NVPTX_LDFLAGS= PLUGIN_NVPTX_LIBS= PLUGIN_NVPTX_DYNAMIC=0 -AC_SUBST(PLUGIN_NVPTX) AC_SUBST(PLUGIN_NVPTX_CPPFLAGS) AC_SUBST(PLUGIN_NVPTX_LDFLAGS) AC_SUBST(PLUGIN_NVPTX_LIBS) PLUGIN_GCN=0 -PLUGIN_GCN_LIBS= -AC_SUBST(PLUGIN_GCN) -AC_SUBST(PLUGIN_GCN_LIBS) # Parse '--enable-offload-targets', figure out the corresponding libgomp # plugins, and configure to find the corresponding offload compilers. @@ -156,7 +154,6 @@ if test x"$enable_offload_targets" != x; then && (test "x$CUDA_DRIVER_LIB" = x \ || test "x$CUDA_DRIVER_LIB" = xno); then PLUGIN_NVPTX=1 - PLUGIN_NVPTX_LIBS='-ldl' PLUGIN_NVPTX_DYNAMIC=1 else PLUGIN_NVPTX=0 @@ -182,8 +179,6 @@ if test x"$enable_offload_targets" != x; then ;; *) tgt_plugin=gcn - PLUGIN_GCN=$tgt - PLUGIN_GCN_LIBS="-ldl" PLUGIN_GCN=1 ;; esac @@ -221,10 +216,5 @@ fi AC_DEFINE_UNQUOTED(OFFLOAD_PLUGINS, "$offload_plugins", [Define to offload plugins, separated by commas.]) AM_CONDITIONAL([PLUGIN_NVPTX], [test $PLUGIN_NVPTX = 1]) -AC_DEFINE_UNQUOTED([PLUGIN_NVPTX], [$PLUGIN_NVPTX], - [Define to 1 if the NVIDIA plugin is built, 0 if not.]) -AC_DEFINE_UNQUOTED([PLUGIN_NVPTX_DYNAMIC], [$PLUGIN_NVPTX_DYNAMIC], - [Define to 1 if the NVIDIA plugin should dlopen libcuda.so.1, 0 if it should be linked against it.]) +AM_CONDITIONAL([PLUGIN_NVPTX_DYNAMIC], [test $PLUGIN_NVPTX_DYNAMIC = 1]) AM_CONDITIONAL([PLUGIN_GCN], [test $PLUGIN_GCN = 1]) -AC_DEFINE_UNQUOTED([PLUGIN_GCN], [$PLUGIN_GCN], - [Define to 1 if the GCN plugin is built, 0 if not.]) diff --git a/libgomp/plugin/plugin-nvptx.c b/libgomp/plugin/plugin-nvptx.c index b28dfca..387bcbb 100644 --- a/libgomp/plugin/plugin-nvptx.c +++ b/libgomp/plugin/plugin-nvptx.c @@ -41,7 +41,7 @@ #include "oacc-int.h" #include <pthread.h> -#if PLUGIN_NVPTX_DYNAMIC +#ifndef PLUGIN_NVPTX_INCLUDE_SYSTEM_CUDA_H # include "cuda/cuda.h" #else # include <cuda.h> @@ -85,7 +85,7 @@ CUresult cuOccupancyMaxPotentialBlockSize(int *, int *, CUfunction, #define DO_PRAGMA(x) _Pragma (#x) -#if PLUGIN_NVPTX_DYNAMIC +#ifndef PLUGIN_NVPTX_LINK_LIBCUDA # include <dlfcn.h> struct cuda_lib_s { diff --git a/libgomp/testsuite/Makefile.in b/libgomp/testsuite/Makefile.in index 32be337..048844f 100644 --- a/libgomp/testsuite/Makefile.in +++ b/libgomp/testsuite/Makefile.in @@ -152,6 +152,7 @@ CUDA_DRIVER_LIB = @CUDA_DRIVER_LIB@ CYGPATH_W = @CYGPATH_W@ DEFS = @DEFS@ DEPDIR = @DEPDIR@ +DL_LIBS = @DL_LIBS@ DSYMUTIL = @DSYMUTIL@ DUMPBIN = @DUMPBIN@ ECHO_C = @ECHO_C@ @@ -209,9 +210,6 @@ PACKAGE_URL = @PACKAGE_URL@ PACKAGE_VERSION = @PACKAGE_VERSION@ PATH_SEPARATOR = @PATH_SEPARATOR@ PERL = @PERL@ -PLUGIN_GCN = @PLUGIN_GCN@ -PLUGIN_GCN_LIBS = @PLUGIN_GCN_LIBS@ -PLUGIN_NVPTX = @PLUGIN_NVPTX@ PLUGIN_NVPTX_CPPFLAGS = @PLUGIN_NVPTX_CPPFLAGS@ PLUGIN_NVPTX_LDFLAGS = @PLUGIN_NVPTX_LDFLAGS@ PLUGIN_NVPTX_LIBS = @PLUGIN_NVPTX_LIBS@ diff --git a/libgomp/testsuite/libgomp.fortran/target-nowait-array-section.f90 b/libgomp/testsuite/libgomp.fortran/target-nowait-array-section.f90 new file mode 100644 index 0000000..3613b73 --- /dev/null +++ b/libgomp/testsuite/libgomp.fortran/target-nowait-array-section.f90 @@ -0,0 +1,56 @@ +! Runs the the target region asynchrolously and checks for it +! +! Note that map(alloc: work(:, i)) + nowait should be safe +! given that a nondescriptor array is used. However, it still +! violates a map clause restriction, added in OpenMP 5.1 [354:10-13]. + +PROGRAM test_target_teams_distribute_nowait + USE ISO_Fortran_env, only: INT64 + implicit none + INTEGER, parameter :: N = 1024, N_TASKS = 16 + INTEGER :: i, j, k, my_ticket + INTEGER :: order(n_tasks) + INTEGER(INT64) :: work(n, n_tasks) + INTEGER :: ticket + logical :: async + + ticket = 0 + + !$omp target enter data map(to: ticket, order) + + !$omp parallel do num_threads(n_tasks) + DO i = 1, n_tasks + !$omp target map(alloc: work(:, i), ticket) private(my_ticket) nowait + !!$omp target teams distribute map(alloc: work(:, i), ticket) private(my_ticket) nowait + DO j = 1, n + ! Waste cyles +! work(j, i) = 0 +! DO k = 1, n*(n_tasks - i) +! work(j, i) = work(j, i) + i*j*k +! END DO + my_ticket = 0 + !$omp atomic capture + ticket = ticket + 1 + my_ticket = ticket + !$omp end atomic + !$omp atomic write + order(i) = my_ticket + END DO + !$omp end target !teams distribute + END DO + !$omp end parallel do + + !$omp target exit data map(from:ticket, order) + + IF (ticket .ne. n_tasks*n) stop 1 + if (maxval(order) /= n_tasks*n) stop 2 + ! order(i) == n*i if synchronous and between n and n*n_tasks if run concurrently + do i = 1, n_tasks + if (order(i) < n .or. order(i) > n*n_tasks) stop 3 + end do + async = .false. + do i = 1, n_tasks + if (order(i) /= n*i) async = .true. + end do + if (.not. async) stop 4 ! Did not run asynchronously +end diff --git a/libstdc++-v3/ChangeLog b/libstdc++-v3/ChangeLog index a24f3d5..e6c2bb5 100644 --- a/libstdc++-v3/ChangeLog +++ b/libstdc++-v3/ChangeLog @@ -1,3 +1,131 @@ +2022-05-13 Jonathan Wakely <jwakely@redhat.com> + + * include/bits/std_thread.h (thread::_State, thread::_State_ptr): + Declare as private unless _GLIBCXX_THREAD_IMPL is defined. + * src/c++11/thread.cc (_GLIBCXX_THREAD_IMPL): Define. + +2022-05-13 Jonathan Wakely <jwakely@redhat.com> + + * include/std/future (launch): Make operators noexcept. + +2022-05-13 Jonathan Wakely <jwakely@redhat.com> + + * doc/doxygen/user.cfg.in (PREDEFINED): Replace __exception_ptr + with "__unspecified__". + * libsupc++/exception_ptr.h: Improve doxygen docs. + (__exception_ptr::swap): Also declare in namespace std. + +2022-05-13 Jonathan Wakely <jwakely@redhat.com> + + * libsupc++/nested_exception.h (throw_with_nested) [C++17]: Use + if-constexpr instead of tag dispatching. + (rethrow_if_nested) [C++17]: Likewise. + (rethrow_if_nested) [!__cpp_rtti]: Do not use dynamic_cast if it + would require RTTI. + * testsuite/18_support/nested_exception/rethrow_if_nested-term.cc: + New test. + +2022-05-13 Jonathan Wakely <jwakely@redhat.com> + + * doc/doxygen/user.cfg.in (PREDEFINED): Define + _GTHREAD_USE_MUTEX_TIMEDLOCK macro. + * include/bits/std_mutex.h (mutex, lock_guard): Use @since and + @headerfile. + * include/bits/unique_lock.h (unique_lock): Likewise. + * include/std/mutex (recursive_mutex, timed_mutex) + (recursive_timed_mutex, scoped_lock): Likewise. + +2022-05-13 Jonathan Wakely <jwakely@redhat.com> + + * doc/doxygen/user.cfg.in (PREDEFINED): Define + _GLIBCXX23_CONSTEXPR macro. + * include/backward/auto_ptr.h (auto_ptr): Use @deprecated. + * include/bits/unique_ptr.h (default_delete): Use @since and + @headerfile. + * include/std/scoped_allocator: Remove @ingroup from @file + block. + +2022-05-13 Jonathan Wakely <jwakely@redhat.com> + + * include/bits/std_thread.h (thread, thread::id): Improve + doxygen docs. + * include/std/future: Likewise. + * include/std/thread (jthread): Likewise. + +2022-05-13 Jonathan Wakely <jwakely@redhat.com> + + * include/bits/ostream_insert.h: Mark helper functions as + undocumented by Doxygen. + * include/bits/stl_algo.h: Use markdown for formatting and mark + helper functions as undocumented. + * include/bits/stl_numeric.h: Likewise. + * include/bits/stl_pair.h (pair): Add @headerfile. + +2022-05-13 Jonathan Wakely <jwakely@redhat.com> + + * doc/doxygen/user.cfg.in (PREDEFINED): Define __allocator_base + so that Doxygen shows the right base-class for std::allocator. + * include/bits/alloc_traits.h: Improve doxygen docs. + * include/bits/allocator.h: Likewise. + * include/bits/new_allocator.h: Likewise. + * include/ext/new_allocator.h: Likewise. + +2022-05-13 Jonathan Wakely <jwakely@redhat.com> + + * doc/doxygen/user.cfg.in (PREDEFINED): Define macro + _GLIBCXX_DOXYGEN_ONLY to expand its argument. + * include/bits/c++config (_GLIBCXX_DOXYGEN_ONLY): Define. + * include/bits/regex.h: Improve doxygen docs. + * include/bits/regex_constants.h: Likewise. + * include/bits/regex_error.h: Likewise. + +2022-05-13 Jonathan Wakely <jwakely@redhat.com> + + * include/std/atomic: Suppress doxygen docs for + implementation details. + * include/bits/atomic_base.h: Likewise. + * include/bits/shared_ptr_atomic.h: Use markdown. Fix grouping + so that std::atomic is not added to the pointer abstractions + group. + +2022-05-13 Jonathan Wakely <jwakely@redhat.com> + + * include/std/system_error: Improve doxygen comments. + +2022-05-13 Jonathan Wakely <jwakely@redhat.com> + + * include/bits/ptr_traits.h: Add some doxygen comments. + +2022-05-13 Jonathan Wakely <jwakely@redhat.com> + + * doc/doxygen/user.cfg.in (PREDEFINED): Expand new macros to + nothing. + * include/bits/c++config (_GLIBCXX_BEGIN_INLINE_ABI_NAMESPACE) + (_GLIBCXX_END_INLINE_ABI_NAMESPACE): Define new macros. + * include/bits/algorithmfwd.h (_V2::__rotate): Use new macros + for the namespace. + * include/bits/chrono.h (chrono::_V2::system_clock): Likewise. + * include/bits/stl_algo.h (_V2::__rotate): Likewise. + * include/std/condition_variable (_V2::condition_variable_any): + Likewise. + * include/std/system_error (_V2::error_category): Likewise. + +2022-05-13 Jonathan Wakely <jwakely@redhat.com> + + * include/bits/mofunc_impl.h: Fix doxygen command. + +2022-05-13 Jonathan Wakely <jwakely@redhat.com> + + * doc/doxygen/user.cfg.in (GROUP_NESTED_COMPOUNDS): Set to NO. + (CLASS_DIAGRAMS): Remove obsolete option. + +2022-05-12 Jonathan Wakely <jwakely@redhat.com> + + * config/locale/dragonfly/numeric_members.cc: Remove whitespace. + * config/locale/gnu/numeric_members.cc: Likewise. + * include/bits/locale_facets_nonio.h: Likewise. + * libsupc++/typeinfo: Likewise. + 2022-05-10 Jonathan Wakely <jwakely@redhat.com> PR libstdc++/105284 diff --git a/libstdc++-v3/config/locale/dragonfly/numeric_members.cc b/libstdc++-v3/config/locale/dragonfly/numeric_members.cc index 51a69dc..b3cf4ad 100644 --- a/libstdc++-v3/config/locale/dragonfly/numeric_members.cc +++ b/libstdc++-v3/config/locale/dragonfly/numeric_members.cc @@ -229,7 +229,7 @@ _GLIBCXX_BEGIN_NAMESPACE_VERSION delete [] _M_data->_M_grouping; delete _M_data; } - #endif +#endif _GLIBCXX_END_NAMESPACE_VERSION } // namespace diff --git a/libstdc++-v3/config/locale/gnu/numeric_members.cc b/libstdc++-v3/config/locale/gnu/numeric_members.cc index 591573f..c714d6a 100644 --- a/libstdc++-v3/config/locale/gnu/numeric_members.cc +++ b/libstdc++-v3/config/locale/gnu/numeric_members.cc @@ -267,7 +267,7 @@ _GLIBCXX_BEGIN_NAMESPACE_VERSION delete [] _M_data->_M_grouping; delete _M_data; } - #endif +#endif _GLIBCXX_END_NAMESPACE_VERSION } // namespace diff --git a/libstdc++-v3/doc/doxygen/user.cfg.in b/libstdc++-v3/doc/doxygen/user.cfg.in index 85955f8..57270bd 100644 --- a/libstdc++-v3/doc/doxygen/user.cfg.in +++ b/libstdc++-v3/doc/doxygen/user.cfg.in @@ -388,7 +388,7 @@ DISTRIBUTE_GROUP_DOC = YES # is disabled and one has to add nested compounds explicitly via \ingroup. # The default value is: NO. -GROUP_NESTED_COMPOUNDS = YES +GROUP_NESTED_COMPOUNDS = NO # Set the SUBGROUPING tag to YES to allow class member groups of the same type # (for instance a group of public functions) to be put as a subgroup of that @@ -2325,6 +2325,7 @@ INCLUDE_FILE_PATTERNS = PREDEFINED = __cplusplus=202002L \ __GTHREADS \ _GLIBCXX_HAS_GTHREADS \ + _GTHREAD_USE_MUTEX_TIMEDLOCK \ _GLIBCXX_HAVE_TLS \ _GLIBCXX_INCLUDE_AS_CXX11 \ "_GLIBCXX_PURE= " \ @@ -2347,6 +2348,8 @@ PREDEFINED = __cplusplus=202002L \ "_GLIBCXX_END_NAMESPACE_CONTAINER= " \ "_GLIBCXX_END_NAMESPACE_CXX11= " \ "_GLIBCXX_END_NAMESPACE_LDBL= " \ + "-D_GLIBCXX_BEGIN_INLINE_ABI_NAMESPACE(X)= " \ + "-D_GLIBCXX_END_INLINE_ABI_NAMESPACE(X)= " \ "_GLIBCXX_TEMPLATE_ARGS=... " \ "_GLIBCXX_DEPRECATED= " \ "_GLIBCXX_DEPRECATED_SUGGEST(E)= " \ @@ -2386,6 +2389,7 @@ PREDEFINED = __cplusplus=202002L \ _GLIBCXX14_CONSTEXPR=constexpr \ _GLIBCXX17_CONSTEXPR=constexpr \ _GLIBCXX20_CONSTEXPR=constexpr \ + _GLIBCXX23_CONSTEXPR=constexpr \ "_GLIBCXX11_DEPRECATED= " \ "_GLIBCXX11_DEPRECATED_SUGGEST(E)= " \ "_GLIBCXX17_DEPRECATED= " \ @@ -2402,6 +2406,9 @@ PREDEFINED = __cplusplus=202002L \ _GLIBCXX_HAVE_BUILTIN_IS_AGGREGATE \ _GLIBCXX_HAVE_IS_CONSTANT_EVALUATED \ _GLIBCXX_HAVE_BUILTIN_LAUNDER \ + "_GLIBCXX_DOXYGEN_ONLY(X)=X " \ + __allocator_base=std::__new_allocator \ + __exception_ptr=__unspecified__ \ # If the MACRO_EXPANSION and EXPAND_ONLY_PREDEF tags are set to YES then this # tag can be used to specify a list of macro names that should be expanded. The @@ -2472,15 +2479,6 @@ EXTERNAL_PAGES = YES # Configuration options related to the dot tool #--------------------------------------------------------------------------- -# If the CLASS_DIAGRAMS tag is set to YES, doxygen will generate a class diagram -# (in HTML and LaTeX) for classes with base or super classes. Setting the tag to -# NO turns the diagrams off. Note that this option also works with HAVE_DOT -# disabled, but it is recommended to install and use dot, since it yields more -# powerful graphs. -# The default value is: YES. - -CLASS_DIAGRAMS = YES - # You can include diagrams made with dia in doxygen documentation. Doxygen will # then run dia to produce the diagram and insert it in the documentation. The # DIA_PATH tag allows you to specify the directory where the dia binary resides. diff --git a/libstdc++-v3/include/backward/auto_ptr.h b/libstdc++-v3/include/backward/auto_ptr.h index 8725504..184ab40 100644 --- a/libstdc++-v3/include/backward/auto_ptr.h +++ b/libstdc++-v3/include/backward/auto_ptr.h @@ -84,6 +84,10 @@ _GLIBCXX_BEGIN_NAMESPACE_VERSION * _GLIBCXX_RESOLVE_LIB_DEFECTS * 127. auto_ptr<> conversion issues * These resolutions have all been incorporated. + * + * @headerfile memory + * @deprecated Deprecated in C++11, no longer in the standard since C++17. + * Use `unique_ptr` instead. */ template<typename _Tp> class auto_ptr diff --git a/libstdc++-v3/include/bits/algorithmfwd.h b/libstdc++-v3/include/bits/algorithmfwd.h index 5271a90..aacc34e 100644 --- a/libstdc++-v3/include/bits/algorithmfwd.h +++ b/libstdc++-v3/include/bits/algorithmfwd.h @@ -601,13 +601,14 @@ _GLIBCXX_BEGIN_NAMESPACE_VERSION _OIter reverse_copy(_BIter, _BIter, _OIter); - inline namespace _V2 - { - template<typename _FIter> - _GLIBCXX20_CONSTEXPR - _FIter - rotate(_FIter, _FIter, _FIter); - } +_GLIBCXX_BEGIN_INLINE_ABI_NAMESPACE(_V2) + + template<typename _FIter> + _GLIBCXX20_CONSTEXPR + _FIter + rotate(_FIter, _FIter, _FIter); + +_GLIBCXX_END_INLINE_ABI_NAMESPACE(_V2) template<typename _FIter, typename _OIter> _GLIBCXX20_CONSTEXPR diff --git a/libstdc++-v3/include/bits/alloc_traits.h b/libstdc++-v3/include/bits/alloc_traits.h index a4d06d3..f9ca37f 100644 --- a/libstdc++-v3/include/bits/alloc_traits.h +++ b/libstdc++-v3/include/bits/alloc_traits.h @@ -661,6 +661,7 @@ _GLIBCXX_BEGIN_NAMESPACE_VERSION { return __rhs; } }; + /// @cond undocumented #if __cplusplus < 201703L template<typename _Alloc> inline void @@ -818,8 +819,11 @@ _GLIBCXX_BEGIN_NAMESPACE_VERSION __a.deallocate(__a.allocate(1u), 1u); }; #endif + /// @endcond #endif // C++11 + /// @cond undocumented + /** * Destroy a range of objects using the supplied allocator. For * non-default allocators we do not optimize away invocation of @@ -849,6 +853,7 @@ _GLIBCXX_BEGIN_NAMESPACE_VERSION { _Destroy(__first, __last); } + /// @endcond _GLIBCXX_END_NAMESPACE_VERSION } // namespace std diff --git a/libstdc++-v3/include/bits/allocator.h b/libstdc++-v3/include/bits/allocator.h index f777016..ee1121b 100644 --- a/libstdc++-v3/include/bits/allocator.h +++ b/libstdc++-v3/include/bits/allocator.h @@ -67,7 +67,10 @@ _GLIBCXX_BEGIN_NAMESPACE_VERSION // explicit specialization, with the historical ABI properties, but with // the same members that are present in the primary template. - /// allocator<void> specialization. + /** std::allocator<void> specialization. + * + * @headerfile memory + */ template<> class allocator<void> { @@ -119,6 +122,8 @@ _GLIBCXX_BEGIN_NAMESPACE_VERSION * for further details. * * @tparam _Tp Type of allocated object. + * + * @headerfile memory */ template<typename _Tp> class allocator : public __allocator_base<_Tp> @@ -209,6 +214,11 @@ _GLIBCXX_BEGIN_NAMESPACE_VERSION // Inherit everything else. }; + /** Equality comparison for std::allocator objects + * + * @return true, for all std::allocator objects. + * @relates std::allocator + */ template<typename _T1, typename _T2> inline _GLIBCXX20_CONSTEXPR bool operator==(const allocator<_T1>&, const allocator<_T2>&) @@ -223,6 +233,8 @@ _GLIBCXX_BEGIN_NAMESPACE_VERSION { return false; } #endif + /// @cond undocumented + // Invalid allocator<cv T> partial specializations. // allocator_traits::rebind_alloc can be used to form a valid allocator type. template<typename _Tp> @@ -325,6 +337,7 @@ _GLIBCXX_BEGIN_NAMESPACE_VERSION } }; #endif + /// @endcond _GLIBCXX_END_NAMESPACE_VERSION } // namespace std diff --git a/libstdc++-v3/include/bits/atomic_base.h b/libstdc++-v3/include/bits/atomic_base.h index 5cf217d..d29e443 100644 --- a/libstdc++-v3/include/bits/atomic_base.h +++ b/libstdc++-v3/include/bits/atomic_base.h @@ -86,6 +86,7 @@ _GLIBCXX_BEGIN_NAMESPACE_VERSION } memory_order; #endif + /// @cond undocumented enum __memory_order_modifier { __memory_order_mask = 0x0ffff, @@ -93,6 +94,7 @@ _GLIBCXX_BEGIN_NAMESPACE_VERSION __memory_order_hle_acquire = 0x10000, __memory_order_hle_release = 0x20000 }; + /// @endcond constexpr memory_order operator|(memory_order __m, __memory_order_modifier __mod) @@ -106,6 +108,8 @@ _GLIBCXX_BEGIN_NAMESPACE_VERSION return memory_order(int(__m) & int(__mod)); } + /// @cond undocumented + // Drop release ordering as per [atomics.types.operations.req]/21 constexpr memory_order __cmpexch_failure_order2(memory_order __m) noexcept @@ -128,6 +132,12 @@ _GLIBCXX_BEGIN_NAMESPACE_VERSION && (__m & __memory_order_mask) != memory_order_acq_rel; } + // Base types for atomics. + template<typename _IntTp> + struct __atomic_base; + + /// @endcond + _GLIBCXX_ALWAYS_INLINE void atomic_thread_fence(memory_order __m) noexcept { __atomic_thread_fence(int(__m)); } @@ -145,16 +155,17 @@ _GLIBCXX_BEGIN_NAMESPACE_VERSION return __ret; } - // Base types for atomics. - template<typename _IntTp> - struct __atomic_base; - -#if __cplusplus <= 201703L -# define _GLIBCXX20_INIT(I) -#else +#if __cplusplus >= 202002L # define __cpp_lib_atomic_value_initialization 201911L +#endif + +/// @cond undocumented +#if __cpp_lib_atomic_value_initialization # define _GLIBCXX20_INIT(I) = I +#else +# define _GLIBCXX20_INIT(I) #endif +/// @endcond #define ATOMIC_VAR_INIT(_VI) { _VI } @@ -171,8 +182,10 @@ _GLIBCXX_BEGIN_NAMESPACE_VERSION typedef unsigned char __atomic_flag_data_type; #endif - /** - * @brief Base type for atomic_flag. + /// @cond undocumented + + /* + * Base type for atomic_flag. * * Base type is POD with data, allowing atomic_flag to derive from * it and meet the standard layout type requirement. In addition to @@ -190,6 +203,8 @@ _GLIBCXX_BEGIN_NAMESPACE_VERSION _GLIBCXX_END_EXTERN_C + /// @endcond + #define ATOMIC_FLAG_INIT { 0 } /// atomic_flag @@ -295,6 +310,7 @@ _GLIBCXX_BEGIN_NAMESPACE_VERSION { return __i ? __GCC_ATOMIC_TEST_AND_SET_TRUEVAL : 0; } }; + /// @cond undocumented /// Base class for atomic integrals. // @@ -936,7 +952,11 @@ _GLIBCXX_BEGIN_NAMESPACE_VERSION { return __atomic_fetch_sub(&_M_p, _M_type_size(__d), int(__m)); } }; + /// @endcond + #if __cplusplus > 201703L + /// @cond undocumented + // Implementation details of atomic_ref and atomic<floating-point>. namespace __atomic_impl { @@ -1936,6 +1956,7 @@ _GLIBCXX_BEGIN_NAMESPACE_VERSION _Tp** _M_ptr; }; + /// @endcond #endif // C++2a /// @} group atomics diff --git a/libstdc++-v3/include/bits/c++config b/libstdc++-v3/include/bits/c++config index 2798b97..191880f 100644 --- a/libstdc++-v3/include/bits/c++config +++ b/libstdc++-v3/include/bits/c++config @@ -345,13 +345,16 @@ namespace __gnu_cxx # define _GLIBCXX_DEFAULT_ABI_TAG #endif -// Defined if inline namespaces are used for versioning. +// Non-zero if inline namespaces are used for versioning the entire library. #define _GLIBCXX_INLINE_VERSION -// Inline namespace for symbol versioning. #if _GLIBCXX_INLINE_VERSION +// Inline namespace for symbol versioning of (nearly) everything in std. # define _GLIBCXX_BEGIN_NAMESPACE_VERSION namespace __8 { # define _GLIBCXX_END_NAMESPACE_VERSION } +// Unused when everything in std is versioned anyway. +# define _GLIBCXX_BEGIN_INLINE_ABI_NAMESPACE(X) +# define _GLIBCXX_END_INLINE_ABI_NAMESPACE(X) namespace std { @@ -376,8 +379,12 @@ _GLIBCXX_END_NAMESPACE_VERSION } #else +// Unused. # define _GLIBCXX_BEGIN_NAMESPACE_VERSION # define _GLIBCXX_END_NAMESPACE_VERSION +// Used to version individual components, e.g. std::_V2::error_category. +# define _GLIBCXX_BEGIN_INLINE_ABI_NAMESPACE(X) inline namespace X { +# define _GLIBCXX_END_INLINE_ABI_NAMESPACE(X) } // inline namespace X #endif // Inline namespaces for special modes: debug, parallel. @@ -816,6 +823,9 @@ namespace std #undef _GLIBCXX_HAS_BUILTIN +// Mark code that should be ignored by the compiler, but seen by Doxygen. +#define _GLIBCXX_DOXYGEN_ONLY(X) + // PSTL configuration #if __cplusplus >= 201703L diff --git a/libstdc++-v3/include/bits/chrono.h b/libstdc++-v3/include/bits/chrono.h index 4218985..745f9a8 100644 --- a/libstdc++-v3/include/bits/chrono.h +++ b/libstdc++-v3/include/bits/chrono.h @@ -1099,7 +1099,7 @@ _GLIBCXX_BEGIN_NAMESPACE_VERSION // compatibility definitions for previous versions. At some // point, when these clocks settle down, the inlined namespaces // can be removed. XXX GLIBCXX_ABI Deprecated - inline namespace _V2 { +_GLIBCXX_BEGIN_INLINE_ABI_NAMESPACE(_V2) /** * @brief System clock. @@ -1171,7 +1171,7 @@ _GLIBCXX_BEGIN_NAMESPACE_VERSION */ using high_resolution_clock = system_clock; - } // end inline namespace _V2 +_GLIBCXX_END_INLINE_ABI_NAMESPACE(_V2) #if __cplusplus >= 202002L /// @addtogroup chrono diff --git a/libstdc++-v3/include/bits/locale_facets_nonio.h b/libstdc++-v3/include/bits/locale_facets_nonio.h index 71a82af..75aef5b 100644 --- a/libstdc++-v3/include/bits/locale_facets_nonio.h +++ b/libstdc++-v3/include/bits/locale_facets_nonio.h @@ -348,8 +348,8 @@ _GLIBCXX_BEGIN_NAMESPACE_VERSION _GLIBCXX_END_NAMESPACE_VERSION } // namespace - // Include host and configuration specific timepunct functions. - #include <bits/time_members.h> +// Include host and configuration specific timepunct functions. +#include <bits/time_members.h> namespace std _GLIBCXX_VISIBILITY(default) { diff --git a/libstdc++-v3/include/bits/mofunc_impl.h b/libstdc++-v3/include/bits/mofunc_impl.h index 6cc9711..405c405 100644 --- a/libstdc++-v3/include/bits/mofunc_impl.h +++ b/libstdc++-v3/include/bits/mofunc_impl.h @@ -48,7 +48,7 @@ _GLIBCXX_BEGIN_NAMESPACE_VERSION * @brief Polymorphic function wrapper. * @ingroup functors * @since C++23 - * @headername functional + * @headerfile functional * * The `std::move_only_function` class template is a call wrapper similar * to * `std::function`, but does not require the stored target function diff --git a/libstdc++-v3/include/bits/new_allocator.h b/libstdc++-v3/include/bits/new_allocator.h index 20ef20f..1a5bc51 100644 --- a/libstdc++-v3/include/bits/new_allocator.h +++ b/libstdc++-v3/include/bits/new_allocator.h @@ -43,14 +43,21 @@ namespace std _GLIBCXX_VISIBILITY(default) _GLIBCXX_BEGIN_NAMESPACE_VERSION /** - * @brief An allocator that uses global new, as per C++03 [20.4.1]. - * @ingroup allocators + * @brief An allocator that uses global `new`, as per C++03 [20.4.1]. + * @ingroup allocators * - * This is precisely the allocator defined in the C++ Standard. - * - all allocation calls operator new - * - all deallocation calls operator delete + * This is precisely the allocator defined in the C++ Standard. + * - all allocation calls `operator new` + * - all deallocation calls `operator delete` * - * @tparam _Tp Type of allocated object. + * This is the default base-class implementation of `std::allocator`, + * and is also the base-class of the `__gnu_cxx::new_allocator` extension. + * You should use either `std::allocator` or `__gnu_cxx::new_allocator` + * instead of using this directly. + * + * @tparam _Tp Type of allocated object. + * + * @headerfile memory */ template<typename _Tp> class __new_allocator diff --git a/libstdc++-v3/include/bits/ostream_insert.h b/libstdc++-v3/include/bits/ostream_insert.h index 9442ea1..f236353 100644 --- a/libstdc++-v3/include/bits/ostream_insert.h +++ b/libstdc++-v3/include/bits/ostream_insert.h @@ -40,6 +40,8 @@ namespace std _GLIBCXX_VISIBILITY(default) { _GLIBCXX_BEGIN_NAMESPACE_VERSION + /// @cond undocumented + template<typename _CharT, typename _Traits> inline void __ostream_write(basic_ostream<_CharT, _Traits>& __out, @@ -124,6 +126,8 @@ _GLIBCXX_BEGIN_NAMESPACE_VERSION #endif #endif + /// @endcond + _GLIBCXX_END_NAMESPACE_VERSION } // namespace std diff --git a/libstdc++-v3/include/bits/ptr_traits.h b/libstdc++-v3/include/bits/ptr_traits.h index 047efa5..8360c3b 100644 --- a/libstdc++-v3/include/bits/ptr_traits.h +++ b/libstdc++-v3/include/bits/ptr_traits.h @@ -47,6 +47,8 @@ namespace std _GLIBCXX_VISIBILITY(default) { _GLIBCXX_BEGIN_NAMESPACE_VERSION + /// @cond undocumented + class __undefined; // For a specialization `SomeTemplate<T, Types...>` the member `type` is T, @@ -91,6 +93,8 @@ _GLIBCXX_BEGIN_NAMESPACE_VERSION using __ptr_traits_elem_t = typename __ptr_traits_elem<_Ptr>::type; #endif + /// @endcond + // Define pointer_traits<P>::pointer_to. template<typename _Ptr, typename _Elt, bool = is_void<_Elt>::value> struct __ptr_traits_ptr_to @@ -187,6 +191,7 @@ _GLIBCXX_BEGIN_NAMESPACE_VERSION /** * @brief Uniform interface to all pointer-like types + * @headerfile memory * @ingroup pointer_abstractions * @since C++11 */ @@ -203,6 +208,7 @@ _GLIBCXX_BEGIN_NAMESPACE_VERSION /** * @brief Partial specialization for built-in pointers. + * @headerfile memory * @ingroup pointer_abstractions * @since C++11 */ diff --git a/libstdc++-v3/include/bits/regex.h b/libstdc++-v3/include/bits/regex.h index 46c1680..24298e3 100644 --- a/libstdc++-v3/include/bits/regex.h +++ b/libstdc++-v3/include/bits/regex.h @@ -84,6 +84,9 @@ _GLIBCXX_BEGIN_NAMESPACE_CXX11 * The class %regex is parameterized around a set of related types and * functions used to complete the definition of its semantics. This class * satisfies the requirements of such a traits class. + * + * @headerfile regex + * @since C++11 */ template<typename _Ch_type> class regex_traits @@ -388,11 +391,24 @@ _GLIBCXX_BEGIN_NAMESPACE_CXX11 // [7.8] Class basic_regex /** - * Objects of specializations of this class represent regular expressions - * constructed from sequences of character type @p _Ch_type. + * @brief A regular expression + * + * Specializations of this class template represent regular expressions + * constructed from sequences of character type `_Ch_type`. + * Use the `std::regex` typedef for `std::basic_regex<char>`. + * + * A character sequence passed to the constructor will be parsed according + * to the chosen grammar, and used to create a state machine representing + * the regular expression. The regex object can then be passed to algorithms + * such as `std::regex_match` to match sequences of characters. + * + * The `syntax_option_type` flag passed to the constructor selects from + * one of the supported regular expression grammars. The default is + * `ECMAScript` and the others are `basic`, `extended`, `awk`, `grep`, and + * `egrep`, which are variations on POSIX regular expressions. * - * Storage for the regular expression is allocated and deallocated as - * necessary by the member functions of this class. + * @headerfile regex + * @since C++11 */ template<typename _Ch_type, typename _Rx_traits = regex_traits<_Ch_type>> class basic_regex @@ -885,14 +901,22 @@ _GLIBCXX_BEGIN_NAMESPACE_CXX11 * An object of this class is essentially a pair of iterators marking a * matched subexpression within a regular expression pattern match. Such * objects can be converted to and compared with std::basic_string objects - * of a similar base character type as the pattern matched by the regular + * of the same character type as the pattern matched by the regular * expression. * + * A `sub_match<Iter>` has a public base class of type `pair<Iter, Iter>`, + * so inherits pair's data members named `first` and `second`. * The iterators that make up the pair are the usual half-open interval * referencing the actual original pattern matched. + * + * @headerfile regex + * @since C++11 */ template<typename _BiIter> - class sub_match : public std::pair<_BiIter, _BiIter> + class sub_match + /// @cond undocumented + : public std::pair<_BiIter, _BiIter> + /// @endcond { typedef iterator_traits<_BiIter> __iter_traits; @@ -902,6 +926,8 @@ _GLIBCXX_BEGIN_NAMESPACE_CXX11 typedef _BiIter iterator; typedef basic_string<value_type> string_type; + _GLIBCXX_DOXYGEN_ONLY(iterator first; iterator second;) + bool matched; constexpr sub_match() noexcept : matched() { } @@ -1699,6 +1725,9 @@ _GLIBCXX_BEGIN_NAMESPACE_CXX11 * of characters [first, second) which formed that match. Otherwise matched * is false, and members first and second point to the end of the sequence * that was searched. + * + * @headerfile regex + * @since C++11 */ template<typename _Bi_iter, typename _Alloc = allocator<sub_match<_Bi_iter> > > @@ -2125,6 +2154,8 @@ _GLIBCXX_BEGIN_NAMESPACE_CXX11 * @brief Compares two match_results for equality. * @returns true if the two objects refer to the same match, * false otherwise. + * + * @relates match_results */ template<typename _Bi_iter, typename _Alloc> inline bool @@ -2150,6 +2181,8 @@ _GLIBCXX_BEGIN_NAMESPACE_CXX11 * @brief Compares two match_results for inequality. * @returns true if the two objects do not refer to the same match, * false otherwise. + * + * @relates match_results */ template<typename _Bi_iter, class _Alloc> inline bool @@ -2165,6 +2198,8 @@ _GLIBCXX_BEGIN_NAMESPACE_CXX11 * @param __rhs A match result. * * The contents of the two match_results objects are swapped. + * + * @relates match_results */ template<typename _Bi_iter, typename _Alloc> inline void @@ -2177,8 +2212,9 @@ _GLIBCXX_END_NAMESPACE_CXX11 // [28.11.2] Function template regex_match /** * @name Matching, Searching, and Replacing + * + * @{ */ - ///@{ /** * @brief Determines if there is a match between the regular expression @p e @@ -2486,6 +2522,7 @@ _GLIBCXX_END_NAMESPACE_CXX11 // std [28.11.4] Function template regex_replace + /// @cond undocumented template<typename _Out_iter, typename _Bi_iter, typename _Rx_traits, typename _Ch_type> _Out_iter @@ -2493,6 +2530,7 @@ _GLIBCXX_END_NAMESPACE_CXX11 const basic_regex<_Ch_type, _Rx_traits>& __e, const _Ch_type* __fmt, size_t __len, regex_constants::match_flag_type __flags); + /// @endcond /** * @brief Search for a regular expression within a range for multiple times, @@ -2654,7 +2692,7 @@ _GLIBCXX_END_NAMESPACE_CXX11 return __result; } - ///@} + /// @} _GLIBCXX_BEGIN_NAMESPACE_CXX11 @@ -2662,6 +2700,9 @@ _GLIBCXX_BEGIN_NAMESPACE_CXX11 /** * An iterator adaptor that will provide repeated calls of regex_search over * a range until no more matches remain. + * + * @headerfile regex + * @since C++11 */ template<typename _Bi_iter, typename _Ch_type = typename iterator_traits<_Bi_iter>::value_type, @@ -2779,6 +2820,9 @@ _GLIBCXX_BEGIN_NAMESPACE_CXX11 * The purpose of this iterator is to enumerate all, or all specified, * matches of a regular expression within a text range. The dereferenced * value of an iterator of this class is a std::sub_match object. + * + * @headerfile regex + * @since C++11 */ template<typename _Bi_iter, typename _Ch_type = typename iterator_traits<_Bi_iter>::value_type, diff --git a/libstdc++-v3/include/bits/regex_constants.h b/libstdc++-v3/include/bits/regex_constants.h index 35a8956..c7e1d85 100644 --- a/libstdc++-v3/include/bits/regex_constants.h +++ b/libstdc++-v3/include/bits/regex_constants.h @@ -1,4 +1,4 @@ -// class template regex -*- C++ -*- +// Namespace std::regex_constants -*- C++ -*- // Copyright (C) 2010-2022 Free Software Foundation, Inc. // @@ -38,6 +38,9 @@ _GLIBCXX_BEGIN_NAMESPACE_VERSION * @defgroup regex Regular Expressions * * A facility for performing regular expression pattern matching. + * + * @since C++11 + * * @{ */ diff --git a/libstdc++-v3/include/bits/regex_error.h b/libstdc++-v3/include/bits/regex_error.h index 77d4925..74a1428 100644 --- a/libstdc++-v3/include/bits/regex_error.h +++ b/libstdc++-v3/include/bits/regex_error.h @@ -1,4 +1,4 @@ -// class template regex -*- C++ -*- +// Errors for std::regex -*- C++ -*- // Copyright (C) 2010-2022 Free Software Foundation, Inc. // @@ -130,6 +130,9 @@ namespace regex_constants * @ingroup exceptions * * The regular expression library throws objects of this class on error. + * + * @headerfile regex + * @since C++11 */ class regex_error : public std::runtime_error { @@ -158,6 +161,7 @@ namespace regex_constants { return _M_code; } private: + /// @cond undocumented regex_error(error_type __ecode, const char* __what) : std::runtime_error(__what), _M_code(__ecode) { } @@ -167,6 +171,7 @@ namespace regex_constants __throw_regex_error(error_type __ecode __attribute__((__unused__)), const char* __what __attribute__((__unused__))) { _GLIBCXX_THROW_OR_ABORT(regex_error(__ecode, __what)); } + /// @endcond }; /// @cond undocumented diff --git a/libstdc++-v3/include/bits/shared_ptr_atomic.h b/libstdc++-v3/include/bits/shared_ptr_atomic.h index ff86432..d4bd712 100644 --- a/libstdc++-v3/include/bits/shared_ptr_atomic.h +++ b/libstdc++-v3/include/bits/shared_ptr_atomic.h @@ -38,9 +38,9 @@ _GLIBCXX_BEGIN_NAMESPACE_VERSION /** * @addtogroup pointer_abstractions + * @relates shared_ptr * @{ */ - /// @relates shared_ptr @{ /// @cond undocumented @@ -94,8 +94,8 @@ _GLIBCXX_BEGIN_NAMESPACE_VERSION * @param __p A non-null pointer to a shared_ptr object. * @return @c *__p * - * The memory order shall not be @c memory_order_release or - * @c memory_order_acq_rel. + * The memory order shall not be `memory_order_release` or + * `memory_order_acq_rel`. * @{ */ template<typename _Tp> @@ -130,8 +130,8 @@ _GLIBCXX_BEGIN_NAMESPACE_VERSION * @param __p A non-null pointer to a shared_ptr object. * @param __r The value to store. * - * The memory order shall not be @c memory_order_acquire or - * @c memory_order_acq_rel. + * The memory order shall not be `memory_order_acquire` or + * `memory_order_acq_rel`. * @{ */ template<typename _Tp> @@ -167,8 +167,8 @@ _GLIBCXX_BEGIN_NAMESPACE_VERSION /** * @brief Atomic exchange for shared_ptr objects. * @param __p A non-null pointer to a shared_ptr object. - * @param __r New value to store in @c *__p. - * @return The original value of @c *__p + * @param __r New value to store in `*__p`. + * @return The original value of `*__p` * @{ */ template<typename _Tp> @@ -214,10 +214,10 @@ _GLIBCXX_BEGIN_NAMESPACE_VERSION * @param __p A non-null pointer to a shared_ptr object. * @param __v A non-null pointer to a shared_ptr object. * @param __w A non-null pointer to a shared_ptr object. - * @return True if @c *__p was equivalent to @c *__v, false otherwise. + * @return True if `*__p` was equivalent to `*__v`, false otherwise. * - * The memory order for failure shall not be @c memory_order_release or - * @c memory_order_acq_rel, or stronger than the memory order for success. + * The memory order for failure shall not be `memory_order_release` or + * `memory_order_acq_rel`. * @{ */ template<typename _Tp> @@ -327,11 +327,19 @@ _GLIBCXX_BEGIN_NAMESPACE_VERSION } /// @} + /// @} group pointer_abstractions + #if __cplusplus >= 202002L # define __cpp_lib_atomic_shared_ptr 201711L template<typename _Tp> class atomic; + /** + * @addtogroup pointer_abstractions + * @relates shared_ptr + * @{ + */ + template<typename _Up> static constexpr bool __is_shared_ptr = false; template<typename _Up> @@ -788,10 +796,8 @@ _GLIBCXX_BEGIN_NAMESPACE_VERSION private: _Sp_atomic<weak_ptr<_Tp>> _M_impl; }; -#endif // C++20 - - /// @} relates shared_ptr /// @} group pointer_abstractions +#endif // C++20 _GLIBCXX_END_NAMESPACE_VERSION } // namespace diff --git a/libstdc++-v3/include/bits/std_mutex.h b/libstdc++-v3/include/bits/std_mutex.h index d3a1d5e..b22e0e1 100644 --- a/libstdc++-v3/include/bits/std_mutex.h +++ b/libstdc++-v3/include/bits/std_mutex.h @@ -53,6 +53,8 @@ _GLIBCXX_BEGIN_NAMESPACE_VERSION */ #ifdef _GLIBCXX_HAS_GTHREADS + /// @cond undocumented + // Common base class for std::mutex and std::timed_mutex class __mutex_base { @@ -78,8 +80,19 @@ _GLIBCXX_BEGIN_NAMESPACE_VERSION __mutex_base(const __mutex_base&) = delete; __mutex_base& operator=(const __mutex_base&) = delete; }; + /// @endcond - /// The standard mutex type. + /** The standard mutex type. + * + * A simple, non-recursive, non-timed mutex. + * + * Do not call `lock()` and `unlock()` directly, use a scoped lock type + * such as `std::unique_lock`, `std::lock_guard`, or (since C++17) + * `std::scoped_lock`. + * + * @headerfile mutex + * @since C++11 + */ class mutex : private __mutex_base { public: @@ -123,6 +136,8 @@ _GLIBCXX_BEGIN_NAMESPACE_VERSION { return &_M_mutex; } }; + /// @cond undocumented + // Implementation details for std::condition_variable class __condvar { @@ -192,6 +207,7 @@ _GLIBCXX_BEGIN_NAMESPACE_VERSION __gthread_cond_t _M_cond; #endif }; + /// @endcond #endif // _GLIBCXX_HAS_GTHREADS @@ -218,6 +234,9 @@ _GLIBCXX_BEGIN_NAMESPACE_VERSION * * A lock_guard controls mutex ownership within a scope, releasing * ownership in the destructor. + * + * @headerfile mutex + * @since C++11 */ template<typename _Mutex> class lock_guard diff --git a/libstdc++-v3/include/bits/std_thread.h b/libstdc++-v3/include/bits/std_thread.h index dd625de..d7fc012 100644 --- a/libstdc++-v3/include/bits/std_thread.h +++ b/libstdc++-v3/include/bits/std_thread.h @@ -57,26 +57,38 @@ _GLIBCXX_BEGIN_NAMESPACE_VERSION * @{ */ - /// thread + /** A std::thread represents a new thread of execution. + * + * The default constructor creates an object that does not own a thread. + * The `thread(F&&, Args&&...)` constructor invokes a callable in a new + * thread, and owns that new thread. A `std::thread` that owns a thread + * is *joinable*. Joining a thread waits for it to finish executing, + * which happens when the callable running in that thread returns. + * + * A `std::thread` cannot be copied, but can be moved. Moving a joinable + * object transfers ownership of its thread to another object. + * + * A joinable `std::thread` must be explicitly joined (or detached) before + * it is destroyed or assigned to. Attempting to destroy a joinable thread + * will terminate the whole process. + * + * @headerfile thread + * @since C++11 + */ class thread { public: #ifdef _GLIBCXX_HAS_GTHREADS - // Abstract base class for types that wrap arbitrary functors to be - // invoked in the new thread of execution. - struct _State - { - virtual ~_State(); - virtual void _M_run() = 0; - }; - using _State_ptr = unique_ptr<_State>; - using native_handle_type = __gthread_t; #else using native_handle_type = int; #endif - /// thread::id + /** A std::thread::id is a unique identifier for a thread. + * + * @headerfile thread + * @since C++11 + */ class id { native_handle_type _M_thread; @@ -195,6 +207,18 @@ _GLIBCXX_BEGIN_NAMESPACE_VERSION hardware_concurrency() noexcept; #ifdef _GLIBCXX_HAS_GTHREADS +#ifndef _GLIBCXX_THREAD_IMPL + private: +#endif + // Abstract base class for types that wrap arbitrary functors to be + // invoked in the new thread of execution. + struct _State + { + virtual ~_State(); + virtual void _M_run() = 0; + }; + using _State_ptr = unique_ptr<_State>; + private: template<typename _Callable> struct _State_impl : public _State @@ -261,8 +285,10 @@ _GLIBCXX_BEGIN_NAMESPACE_VERSION }; public: + /// @cond undocumented template<typename... _Tp> using _Call_wrapper = _Invoker<tuple<typename decay<_Tp>::type...>>; + /// @endcond #endif // _GLIBCXX_HAS_GTHREADS }; @@ -272,10 +298,12 @@ _GLIBCXX_BEGIN_NAMESPACE_VERSION inline unsigned int thread::hardware_concurrency() noexcept { return 0; } #endif + /// @relates std::thread inline void swap(thread& __x, thread& __y) noexcept { __x.swap(__y); } + /// @relates std::thread::id inline bool operator==(thread::id __x, thread::id __y) noexcept { @@ -301,7 +329,7 @@ _GLIBCXX_BEGIN_NAMESPACE_VERSION namespace this_thread { - /// this_thread::get_id + /// The unique identifier of the current thread. inline thread::id get_id() noexcept { @@ -314,7 +342,7 @@ _GLIBCXX_BEGIN_NAMESPACE_VERSION #endif } - /// this_thread::yield + /// Allow the implementation to schedule a different thread. inline void yield() noexcept { diff --git a/libstdc++-v3/include/bits/stl_algo.h b/libstdc++-v3/include/bits/stl_algo.h index 1f07b9e..1d8ed4e 100644 --- a/libstdc++-v3/include/bits/stl_algo.h +++ b/libstdc++-v3/include/bits/stl_algo.h @@ -1190,8 +1190,7 @@ _GLIBCXX_BEGIN_NAMESPACE_VERSION return __m; } - inline namespace _V2 - { +_GLIBCXX_BEGIN_INLINE_ABI_NAMESPACE(_V2) /// This is a helper function for the rotate algorithm. template<typename _ForwardIterator> @@ -1398,7 +1397,7 @@ _GLIBCXX_BEGIN_NAMESPACE_VERSION std::__iterator_category(__first)); } - } // namespace _V2 +_GLIBCXX_END_INLINE_ABI_NAMESPACE(_V2) /** * @brief Copy a sequence, rotating its elements. @@ -1618,6 +1617,8 @@ _GLIBCXX_BEGIN_NAMESPACE_VERSION __gnu_cxx::__ops::__pred_iter(__pred)); } + /// @cond undocumented + /// This is a helper function for the sort routines. template<typename _RandomAccessIterator, typename _Compare> _GLIBCXX20_CONSTEXPR @@ -1672,6 +1673,8 @@ _GLIBCXX_BEGIN_NAMESPACE_VERSION return __result_real_last; } + /// @endcond + /** * @brief Copy the smallest elements of a sequence. * @ingroup sorting_algorithms @@ -1681,14 +1684,14 @@ _GLIBCXX_BEGIN_NAMESPACE_VERSION * @param __result_last Another random-access iterator. * @return An iterator indicating the end of the resulting sequence. * - * Copies and sorts the smallest N values from the range @p [__first,__last) - * to the range beginning at @p __result_first, where the number of - * elements to be copied, @p N, is the smaller of @p (__last-__first) and - * @p (__result_last-__result_first). - * After the sort if @e i and @e j are iterators in the range - * @p [__result_first,__result_first+N) such that i precedes j then - * *j<*i is false. - * The value returned is @p __result_first+N. + * Copies and sorts the smallest `N` values from the range + * `[__first, __last)` to the range beginning at `__result_first`, where + * the number of elements to be copied, `N`, is the smaller of + * `(__last - __first)` and `(__result_last - __result_first)`. + * After the sort if `i` and `j` are iterators in the range + * `[__result_first,__result_first + N)` such that `i` precedes `j` then + * `*j < *i` is false. + * The value returned is `__result_first + N`. */ template<typename _InputIterator, typename _RandomAccessIterator> _GLIBCXX20_CONSTEXPR @@ -1731,14 +1734,14 @@ _GLIBCXX_BEGIN_NAMESPACE_VERSION * @param __comp A comparison functor. * @return An iterator indicating the end of the resulting sequence. * - * Copies and sorts the smallest N values from the range @p [__first,__last) - * to the range beginning at @p result_first, where the number of - * elements to be copied, @p N, is the smaller of @p (__last-__first) and - * @p (__result_last-__result_first). - * After the sort if @e i and @e j are iterators in the range - * @p [__result_first,__result_first+N) such that i precedes j then - * @p __comp(*j,*i) is false. - * The value returned is @p __result_first+N. + * Copies and sorts the smallest `N` values from the range + * `[__first, __last)` to the range beginning at `result_first`, where + * the number of elements to be copied, `N`, is the smaller of + * `(__last - __first)` and `(__result_last - __result_first)`. + * After the sort if `i` and `j` are iterators in the range + * `[__result_first, __result_first + N)` such that `i` precedes `j` then + * `__comp(*j, *i)` is false. + * The value returned is `__result_first + N`. */ template<typename _InputIterator, typename _RandomAccessIterator, typename _Compare> @@ -1775,6 +1778,8 @@ _GLIBCXX_BEGIN_NAMESPACE_VERSION __gnu_cxx::__ops::__iter_comp_iter(__comp)); } + /// @cond undocumented + /// This is a helper function for the sort routine. template<typename _RandomAccessIterator, typename _Compare> _GLIBCXX20_CONSTEXPR @@ -1968,21 +1973,22 @@ _GLIBCXX_BEGIN_NAMESPACE_VERSION std::__insertion_sort(__first, __last, __comp); } + /// @endcond + // nth_element // lower_bound moved to stl_algobase.h /** - * @brief Finds the first position in which @p __val could be inserted + * @brief Finds the first position in which `__val` could be inserted * without changing the ordering. * @ingroup binary_search_algorithms - * @param __first An iterator. - * @param __last Another iterator. + * @param __first An iterator to the start of a sorted range. + * @param __last A past-the-end iterator for the sorted range. * @param __val The search term. * @param __comp A functor to use for comparisons. - * @return An iterator pointing to the first element <em>not less - * than</em> @p __val, or end() if every element is less - * than @p __val. + * @return An iterator pointing to the first element _not less than_ + * `__val`, or `end()` if every element is less than `__val`. * @ingroup binary_search_algorithms * * The comparison function should have the same effects on ordering as @@ -4314,8 +4320,8 @@ _GLIBCXX_BEGIN_NAMESPACE_ALGO * @param __new_value The replacement value. * @return replace() returns no value. * - * For each iterator @c i in the range @p [__first,__last) if @c *i == - * @p __old_value then the assignment @c *i = @p __new_value is performed. + * For each iterator `i` in the range `[__first,__last)` if + * `*i == __old_value` then the assignment `*i = __new_value` is performed. */ template<typename _ForwardIterator, typename _Tp> _GLIBCXX20_CONSTEXPR @@ -4347,8 +4353,8 @@ _GLIBCXX_BEGIN_NAMESPACE_ALGO * @param __new_value The replacement value. * @return replace_if() returns no value. * - * For each iterator @c i in the range @p [__first,__last) if @p __pred(*i) - * is true then the assignment @c *i = @p __new_value is performed. + * For each iterator `i` in the range `[__first,__last)` if `__pred(*i)` + * is true then the assignment `*i = __new_value` is performed. */ template<typename _ForwardIterator, typename _Predicate, typename _Tp> _GLIBCXX20_CONSTEXPR @@ -4376,12 +4382,11 @@ _GLIBCXX_BEGIN_NAMESPACE_ALGO * @ingroup mutating_algorithms * @param __first A forward iterator. * @param __last A forward iterator. - * @param __gen A function object taking no arguments and returning - * std::iterator_traits<_ForwardIterator>::value_type + * @param __gen A function object callable with no arguments. * @return generate() returns no value. * - * Performs the assignment @c *i = @p __gen() for each @c i in the range - * @p [__first,__last). + * Performs the assignment `*i = __gen()` for each `i` in the range + * `[__first, __last)`. */ template<typename _ForwardIterator, typename _Generator> _GLIBCXX20_CONSTEXPR @@ -4405,14 +4410,13 @@ _GLIBCXX_BEGIN_NAMESPACE_ALGO * @ingroup mutating_algorithms * @param __first A forward iterator. * @param __n The length of the sequence. - * @param __gen A function object taking no arguments and returning - * std::iterator_traits<_ForwardIterator>::value_type - * @return The end of the sequence, @p __first+__n + * @param __gen A function object callable with no arguments. + * @return The end of the sequence, i.e., `__first + __n` * - * Performs the assignment @c *i = @p __gen() for each @c i in the range - * @p [__first,__first+__n). + * Performs the assignment `*i = __gen()` for each `i` in the range + * `[__first, __first + __n)`. * - * If @p __n is negative, the function does nothing and returns @p __first. + * If `__n` is negative, the function does nothing and returns `__first`. */ // _GLIBCXX_RESOLVE_LIB_DEFECTS // DR 865. More algorithms that throw away information @@ -4442,19 +4446,16 @@ _GLIBCXX_BEGIN_NAMESPACE_ALGO * @param __result An output iterator. * @return An iterator designating the end of the resulting sequence. * - * Copies each element in the range @p [__first,__last) to the range - * beginning at @p __result, except that only the first element is copied + * Copies each element in the range `[__first, __last)` to the range + * beginning at `__result`, except that only the first element is copied * from groups of consecutive elements that compare equal. - * unique_copy() is stable, so the relative order of elements that are + * `unique_copy()` is stable, so the relative order of elements that are * copied is unchanged. - * - * _GLIBCXX_RESOLVE_LIB_DEFECTS - * DR 241. Does unique_copy() require CopyConstructible and Assignable? - * - * _GLIBCXX_RESOLVE_LIB_DEFECTS - * DR 538. 241 again: Does unique_copy() require CopyConstructible and - * Assignable? - */ + */ + // _GLIBCXX_RESOLVE_LIB_DEFECTS + // DR 241. Does unique_copy() require CopyConstructible and Assignable? + // DR 538. 241 again: Does unique_copy() require CopyConstructible and + // Assignable? template<typename _InputIterator, typename _OutputIterator> _GLIBCXX20_CONSTEXPR inline _OutputIterator @@ -4486,16 +4487,15 @@ _GLIBCXX_BEGIN_NAMESPACE_ALGO * @param __binary_pred A binary predicate. * @return An iterator designating the end of the resulting sequence. * - * Copies each element in the range @p [__first,__last) to the range - * beginning at @p __result, except that only the first element is copied - * from groups of consecutive elements for which @p __binary_pred returns + * Copies each element in the range `[__first, __last)` to the range + * beginning at `__result`, except that only the first element is copied + * from groups of consecutive elements for which `__binary_pred` returns * true. - * unique_copy() is stable, so the relative order of elements that are + * `unique_copy()` is stable, so the relative order of elements that are * copied is unchanged. - * - * _GLIBCXX_RESOLVE_LIB_DEFECTS - * DR 241. Does unique_copy() require CopyConstructible and Assignable? - */ + */ + // _GLIBCXX_RESOLVE_LIB_DEFECTS + // DR 241. Does unique_copy() require CopyConstructible and Assignable? template<typename _InputIterator, typename _OutputIterator, typename _BinaryPredicate> _GLIBCXX20_CONSTEXPR @@ -4527,7 +4527,7 @@ _GLIBCXX_BEGIN_NAMESPACE_ALGO * @param __last A forward iterator. * @return Nothing. * - * Reorder the elements in the range @p [__first,__last) using a random + * Reorder the elements in the range `[__first, __last)` using a random * distribution, so that every possible ordering of the sequence is * equally likely. * @@ -4566,10 +4566,10 @@ _GLIBCXX_BEGIN_NAMESPACE_ALGO * @param __rand The RNG functor or function. * @return Nothing. * - * Reorders the elements in the range @p [__first,__last) using @p __rand to - * provide a random distribution. Calling @p __rand(N) for a positive - * integer @p N should return a randomly chosen integer from the - * range [0,N). + * Reorders the elements in the range `[__first, __last)` using `__rand` + * to provide a random distribution. Calling `__rand(N)` for a positive + * integer `N` should return a randomly chosen integer from the + * range `[0, N)`. * * @deprecated * Since C++14 `std::random_shuffle` is not part of the C++ standard. @@ -4608,13 +4608,13 @@ _GLIBCXX_BEGIN_NAMESPACE_ALGO * @param __first A forward iterator. * @param __last A forward iterator. * @param __pred A predicate functor. - * @return An iterator @p middle such that @p __pred(i) is true for each - * iterator @p i in the range @p [__first,middle) and false for each @p i - * in the range @p [middle,__last). + * @return An iterator `middle` such that `__pred(i)` is true for each + * iterator `i` in the range `[__first, middle)` and false for each `i` + * in the range `[middle, __last)`. * - * @p __pred must not modify its operand. @p partition() does not preserve + * `__pred` must not modify its operand. `partition()` does not preserve * the relative ordering of elements in each group, use - * @p stable_partition() if this is needed. + * `stable_partition()` if this is needed. */ template<typename _ForwardIterator, typename _Predicate> _GLIBCXX20_CONSTEXPR @@ -4642,13 +4642,14 @@ _GLIBCXX_BEGIN_NAMESPACE_ALGO * @param __last Another iterator. * @return Nothing. * - * Sorts the smallest @p (__middle-__first) elements in the range - * @p [first,last) and moves them to the range @p [__first,__middle). The - * order of the remaining elements in the range @p [__middle,__last) is - * undefined. - * After the sort if @e i and @e j are iterators in the range - * @p [__first,__middle) such that i precedes j and @e k is an iterator in - * the range @p [__middle,__last) then *j<*i and *k<*i are both false. + * Sorts the smallest `(__middle - __first)` elements in the range + * `[first, last)` and moves them to the range `[__first, __middle)`. The + * order of the remaining elements in the range `[__middle, __last)` is + * unspecified. + * After the sort if `i` and `j` are iterators in the range + * `[__first, __middle)` such that `i` precedes `j` and `k` is an iterator + * in the range `[__middle, __last)` then `*j < *i` and `*k < *i` are + * both false. */ template<typename _RandomAccessIterator> _GLIBCXX20_CONSTEXPR @@ -4680,14 +4681,14 @@ _GLIBCXX_BEGIN_NAMESPACE_ALGO * @param __comp A comparison functor. * @return Nothing. * - * Sorts the smallest @p (__middle-__first) elements in the range - * @p [__first,__last) and moves them to the range @p [__first,__middle). The - * order of the remaining elements in the range @p [__middle,__last) is - * undefined. - * After the sort if @e i and @e j are iterators in the range - * @p [__first,__middle) such that i precedes j and @e k is an iterator in - * the range @p [__middle,__last) then @p *__comp(j,*i) and @p __comp(*k,*i) - * are both false. + * Sorts the smallest `(__middle - __first)` elements in the range + * `[__first, __last)` and moves them to the range `[__first, __middle)`. + * The order of the remaining elements in the range `[__middle, __last)` is + * unspecified. + * After the sort if `i` and `j` are iterators in the range + * `[__first, __middle)` such that `i` precedes `j` and `k` is an iterator + * in the range `[__middle, __last)` then `*__comp(j, *i)` and + * `__comp(*k, *i)` are both false. */ template<typename _RandomAccessIterator, typename _Compare> _GLIBCXX20_CONSTEXPR @@ -4719,12 +4720,12 @@ _GLIBCXX_BEGIN_NAMESPACE_ALGO * @param __last Another iterator. * @return Nothing. * - * Rearranges the elements in the range @p [__first,__last) so that @p *__nth + * Rearranges the elements in the range `[__first, __last)` so that `*__nth` * is the same element that would have been in that position had the - * whole sequence been sorted. The elements either side of @p *__nth are - * not completely sorted, but for any iterator @e i in the range - * @p [__first,__nth) and any iterator @e j in the range @p [__nth,__last) it - * holds that *j < *i is false. + * whole sequence been sorted. The elements either side of `*__nth` are + * not completely sorted, but for any iterator `i` in the range + * `[__first, __nth)` and any iterator `j` in the range `[__nth, __last)` it + * holds that `*j < *i` is false. */ template<typename _RandomAccessIterator> _GLIBCXX20_CONSTEXPR @@ -4759,12 +4760,12 @@ _GLIBCXX_BEGIN_NAMESPACE_ALGO * @param __comp A comparison functor. * @return Nothing. * - * Rearranges the elements in the range @p [__first,__last) so that @p *__nth + * Rearranges the elements in the range `[__first, __last)` so that `*__nth` * is the same element that would have been in that position had the - * whole sequence been sorted. The elements either side of @p *__nth are - * not completely sorted, but for any iterator @e i in the range - * @p [__first,__nth) and any iterator @e j in the range @p [__nth,__last) it - * holds that @p __comp(*j,*i) is false. + * whole sequence been sorted. The elements either side of `*__nth` are + * not completely sorted, but for any iterator `i` in the range + * `[__first, __nth)` and any iterator `j` in the range `[__nth, __last)` + * it holds that `__comp(*j, *i)` is false. */ template<typename _RandomAccessIterator, typename _Compare> _GLIBCXX20_CONSTEXPR @@ -4797,12 +4798,12 @@ _GLIBCXX_BEGIN_NAMESPACE_ALGO * @param __last Another iterator. * @return Nothing. * - * Sorts the elements in the range @p [__first,__last) in ascending order, - * such that for each iterator @e i in the range @p [__first,__last-1), - * *(i+1)<*i is false. + * Sorts the elements in the range `[__first, __last)` in ascending order, + * such that for each iterator `i` in the range `[__first, __last - 1)`, + * `*(i+1) < *i` is false. * * The relative ordering of equivalent elements is not preserved, use - * @p stable_sort() if this is needed. + * `stable_sort()` if this is needed. */ template<typename _RandomAccessIterator> _GLIBCXX20_CONSTEXPR @@ -4828,12 +4829,12 @@ _GLIBCXX_BEGIN_NAMESPACE_ALGO * @param __comp A comparison functor. * @return Nothing. * - * Sorts the elements in the range @p [__first,__last) in ascending order, - * such that @p __comp(*(i+1),*i) is false for every iterator @e i in the - * range @p [__first,__last-1). + * Sorts the elements in the range `[__first, __last)` in ascending order, + * such that `__comp(*(i+1), *i)` is false for every iterator `i` in the + * range `[__first, __last - 1)`. * * The relative ordering of equivalent elements is not preserved, use - * @p stable_sort() if this is needed. + * `stable_sort()` if this is needed. */ template<typename _RandomAccessIterator, typename _Compare> _GLIBCXX20_CONSTEXPR diff --git a/libstdc++-v3/include/bits/stl_numeric.h b/libstdc++-v3/include/bits/stl_numeric.h index ea017d4..f71236c 100644 --- a/libstdc++-v3/include/bits/stl_numeric.h +++ b/libstdc++-v3/include/bits/stl_numeric.h @@ -328,10 +328,9 @@ _GLIBCXX_BEGIN_NAMESPACE_ALGO * @param __last End of input range. * @param __result Output sums. * @return Iterator pointing just beyond the values written to result. - * - * _GLIBCXX_RESOLVE_LIB_DEFECTS - * DR 539. partial_sum and adjacent_difference should mention requirements */ + // _GLIBCXX_RESOLVE_LIB_DEFECTS + // DR 539. partial_sum and adjacent_difference should mention requirements template<typename _InputIterator, typename _OutputIterator> _GLIBCXX20_CONSTEXPR _OutputIterator @@ -371,10 +370,9 @@ _GLIBCXX_BEGIN_NAMESPACE_ALGO * @param __result Output sum. * @param __binary_op Function object. * @return Iterator pointing just beyond the values written to result. - * - * _GLIBCXX_RESOLVE_LIB_DEFECTS - * DR 539. partial_sum and adjacent_difference should mention requirements */ + // _GLIBCXX_RESOLVE_LIB_DEFECTS + // DR 539. partial_sum and adjacent_difference should mention requirements template<typename _InputIterator, typename _OutputIterator, typename _BinaryOperation> _GLIBCXX20_CONSTEXPR diff --git a/libstdc++-v3/include/bits/stl_pair.h b/libstdc++-v3/include/bits/stl_pair.h index 0eb7834..831e770 100644 --- a/libstdc++-v3/include/bits/stl_pair.h +++ b/libstdc++-v3/include/bits/stl_pair.h @@ -180,6 +180,8 @@ _GLIBCXX_BEGIN_NAMESPACE_VERSION * @tparam _T2 Type of second object. * * <https://gcc.gnu.org/onlinedocs/libstdc++/manual/utilities.html> + * + * @headerfile utility */ template<typename _T1, typename _T2> struct pair @@ -757,9 +759,11 @@ _GLIBCXX_BEGIN_NAMESPACE_VERSION #if __cplusplus >= 201103L // Various functions which give std::pair a tuple-like interface. + /// @cond undocumented template<typename _T1, typename _T2> struct __is_tuple_like_impl<pair<_T1, _T2>> : true_type { }; + /// @endcond /// Partial specialization for std::pair template<class _Tp1, class _Tp2> diff --git a/libstdc++-v3/include/bits/unique_lock.h b/libstdc++-v3/include/bits/unique_lock.h index 1f1aa15..9ed7ba2 100644 --- a/libstdc++-v3/include/bits/unique_lock.h +++ b/libstdc++-v3/include/bits/unique_lock.h @@ -51,7 +51,9 @@ _GLIBCXX_BEGIN_NAMESPACE_VERSION * to another unique_lock by move construction or move assignment. If a * mutex lock is owned when the destructor runs ownership will be released. * + * @headerfile mutex * @ingroup mutexes + * @since C++11 */ template<typename _Mutex> class unique_lock diff --git a/libstdc++-v3/include/bits/unique_ptr.h b/libstdc++-v3/include/bits/unique_ptr.h index ad60fad..e1ad772 100644 --- a/libstdc++-v3/include/bits/unique_ptr.h +++ b/libstdc++-v3/include/bits/unique_ptr.h @@ -65,8 +65,11 @@ _GLIBCXX_BEGIN_NAMESPACE_VERSION #pragma GCC diagnostic pop #endif - /// Primary template of default_delete, used by unique_ptr for single objects - /// @since C++11 + /** Primary template of default_delete, used by unique_ptr for single objects + * + * @headerfile memory + * @since C++11 + */ template<typename _Tp> struct default_delete { @@ -99,7 +102,11 @@ _GLIBCXX_BEGIN_NAMESPACE_VERSION // _GLIBCXX_RESOLVE_LIB_DEFECTS // DR 740 - omit specialization for array objects with a compile time length - /// Specialization of default_delete for arrays, used by `unique_ptr<T[]>` + /** Specialization of default_delete for arrays, used by `unique_ptr<T[]>` + * + * @headerfile memory + * @since C++11 + */ template<typename _Tp> struct default_delete<_Tp[]> { diff --git a/libstdc++-v3/include/ext/new_allocator.h b/libstdc++-v3/include/ext/new_allocator.h index b8f5fcc..96e6523 100644 --- a/libstdc++-v3/include/ext/new_allocator.h +++ b/libstdc++-v3/include/ext/new_allocator.h @@ -36,14 +36,20 @@ namespace __gnu_cxx _GLIBCXX_VISIBILITY(default) _GLIBCXX_BEGIN_NAMESPACE_VERSION /** - * @brief An allocator that uses global new, as per C++03 [20.4.1]. + * @brief An allocator that uses global `new`, as per C++03 [20.4.1]. * @ingroup allocators * * This is precisely the allocator defined in the C++ Standard. - * - all allocation calls operator new - * - all deallocation calls operator delete + * - all allocation calls `operator new` + * - all deallocation calls `operator delete` + * + * This is a non-standard extension that can be used to guarantee + * allocation from `new` even if the library has been configured to + * use a different implementation for `std::allocator`. * * @tparam _Tp Type of allocated object. + * + * @headerfile ext/new_allocator.h */ template<typename _Tp> class new_allocator : public std::__new_allocator<_Tp> diff --git a/libstdc++-v3/include/std/atomic b/libstdc++-v3/include/std/atomic index d819b6b..1c6acfa 100644 --- a/libstdc++-v3/include/std/atomic +++ b/libstdc++-v3/include/std/atomic @@ -181,11 +181,13 @@ _GLIBCXX_BEGIN_NAMESPACE_VERSION #endif // __cpp_lib_atomic_wait }; -#if __cplusplus <= 201703L -# define _GLIBCXX20_INIT(I) -#else +/// @cond undocumented +#if __cpp_lib_atomic_value_initialization # define _GLIBCXX20_INIT(I) = I +#else +# define _GLIBCXX20_INIT(I) #endif +/// @endcond /** * @brief Generic atomic type, primary class template. @@ -1241,11 +1243,12 @@ _GLIBCXX_BEGIN_NAMESPACE_VERSION atomic_flag_clear(volatile atomic_flag* __a) noexcept { atomic_flag_clear_explicit(__a, memory_order_seq_cst); } - + /// @cond undocumented template<typename _Tp> using __atomic_val_t = typename atomic<_Tp>::value_type; template<typename _Tp> using __atomic_diff_t = typename atomic<_Tp>::difference_type; + /// @endcond // [atomics.nonmembers] Non-member functions. // Function templates generally applicable to atomic types. diff --git a/libstdc++-v3/include/std/condition_variable b/libstdc++-v3/include/std/condition_variable index 2a23e65..06c4ff9 100644 --- a/libstdc++-v3/include/std/condition_variable +++ b/libstdc++-v3/include/std/condition_variable @@ -234,7 +234,7 @@ _GLIBCXX_BEGIN_NAMESPACE_VERSION void (*_M_cb)(void*); }; - inline namespace _V2 { +_GLIBCXX_BEGIN_INLINE_ABI_NAMESPACE(_V2) /// condition_variable_any // Like above, but mutex is not required to have try_lock. @@ -439,7 +439,7 @@ _GLIBCXX_BEGIN_NAMESPACE_VERSION #endif }; - } // end inline namespace +_GLIBCXX_END_INLINE_ABI_NAMESPACE(_V2) /// @} group condition_variables _GLIBCXX_END_NAMESPACE_VERSION diff --git a/libstdc++-v3/include/std/future b/libstdc++-v3/include/std/future index a9268ca..f7de8dd 100644 --- a/libstdc++-v3/include/std/future +++ b/libstdc++-v3/include/std/future @@ -58,7 +58,13 @@ _GLIBCXX_BEGIN_NAMESPACE_VERSION * @defgroup futures Futures * @ingroup concurrency * - * Classes for futures support. + * Futures and promises provide support for retrieving the result from + * an asynchronous function, e.g. one that is running in another thread. + * A `std::future` represents an asynchronous result that will become + * ready at some later time. A consumer can wait on a future until the + * result is ready to be accessed. + * + * @since C++11 * @{ */ @@ -71,7 +77,7 @@ _GLIBCXX_BEGIN_NAMESPACE_VERSION broken_promise }; - /// Specialization. + /// Specialization that allows `future_errc` to convert to `error_code`. template<> struct is_error_code_enum<future_errc> : public true_type { }; @@ -79,12 +85,12 @@ _GLIBCXX_BEGIN_NAMESPACE_VERSION const error_category& future_category() noexcept; - /// Overload for make_error_code. + /// Overload of make_error_code for `future_errc`. inline error_code make_error_code(future_errc __errc) noexcept { return error_code(static_cast<int>(__errc), future_category()); } - /// Overload for make_error_condition. + /// Overload of make_error_condition for `future_errc`. inline error_condition make_error_condition(future_errc __errc) noexcept { return error_condition(static_cast<int>(__errc), future_category()); } @@ -92,6 +98,7 @@ _GLIBCXX_BEGIN_NAMESPACE_VERSION /** * @brief Exception type thrown by futures. * @ingroup exceptions + * @since C++11 */ class future_error : public logic_error { @@ -140,34 +147,34 @@ _GLIBCXX_BEGIN_NAMESPACE_VERSION deferred = 2 }; - constexpr launch operator&(launch __x, launch __y) + constexpr launch operator&(launch __x, launch __y) noexcept { return static_cast<launch>( static_cast<int>(__x) & static_cast<int>(__y)); } - constexpr launch operator|(launch __x, launch __y) + constexpr launch operator|(launch __x, launch __y) noexcept { return static_cast<launch>( static_cast<int>(__x) | static_cast<int>(__y)); } - constexpr launch operator^(launch __x, launch __y) + constexpr launch operator^(launch __x, launch __y) noexcept { return static_cast<launch>( static_cast<int>(__x) ^ static_cast<int>(__y)); } - constexpr launch operator~(launch __x) + constexpr launch operator~(launch __x) noexcept { return static_cast<launch>(~static_cast<int>(__x)); } - inline launch& operator&=(launch& __x, launch __y) + inline launch& operator&=(launch& __x, launch __y) noexcept { return __x = __x & __y; } - inline launch& operator|=(launch& __x, launch __y) + inline launch& operator|=(launch& __x, launch __y) noexcept { return __x = __x | __y; } - inline launch& operator^=(launch& __x, launch __y) + inline launch& operator^=(launch& __x, launch __y) noexcept { return __x = __x ^ __y; } /// Status code for futures @@ -178,11 +185,13 @@ _GLIBCXX_BEGIN_NAMESPACE_VERSION deferred }; + /// @cond undocumented // _GLIBCXX_RESOLVE_LIB_DEFECTS // 2021. Further incorrect usages of result_of template<typename _Fn, typename... _Args> using __async_result_of = typename __invoke_result< typename decay<_Fn>::type, typename decay<_Args>::type...>::type; + /// @endcond template<typename _Fn, typename... _Args> future<__async_result_of<_Fn, _Args...>> @@ -194,6 +203,8 @@ _GLIBCXX_BEGIN_NAMESPACE_VERSION #if defined(_GLIBCXX_HAS_GTHREADS) + /// @cond undocumented + /// Base class and enclosing scope. struct __future_base { @@ -655,8 +666,11 @@ _GLIBCXX_BEGIN_NAMESPACE_VERSION void _M_destroy() { delete this; } }; + /// @endcond + #ifndef _GLIBCXX_ASYNC_ABI_COMPAT + /// @cond undocumented // Allow _Setter objects to be stored locally in std::function template<typename _Res, typename _Arg> struct __is_location_invariant @@ -668,6 +682,7 @@ _GLIBCXX_BEGIN_NAMESPACE_VERSION struct __is_location_invariant <__future_base::_Task_setter<_Res_ptr, _Fn, _Res>> : true_type { }; + /// @endcond /// Common implementation for future and shared_future. template<typename _Res> @@ -1376,6 +1391,7 @@ _GLIBCXX_BEGIN_NAMESPACE_VERSION } }; + /// @cond undocumented template<typename _Ptr_type, typename _Fn, typename _Res> struct __future_base::_Task_setter { @@ -1512,6 +1528,7 @@ _GLIBCXX_BEGIN_NAMESPACE_VERSION return __create_task_state<_Res(_Args...)>(std::move(_M_impl._M_fn), static_cast<_Alloc&>(_M_impl)); } + /// @endcond /// packaged_task template<typename _Res, typename... _ArgTypes> @@ -1648,6 +1665,8 @@ _GLIBCXX_BEGIN_NAMESPACE_VERSION : public true_type { }; #endif + /// @cond undocumented + // Shared state created by std::async(). // Holds a deferred function and storage for its result. template<typename _BoundFn, typename _Res> @@ -1761,7 +1780,7 @@ _GLIBCXX_BEGIN_NAMESPACE_VERSION _Ptr_type _M_result; _BoundFn _M_fn; }; - + /// @endcond /// async template<typename _Fn, typename... _Args> diff --git a/libstdc++-v3/include/std/mutex b/libstdc++-v3/include/std/mutex index f500818..b9590bb 100644 --- a/libstdc++-v3/include/std/mutex +++ b/libstdc++-v3/include/std/mutex @@ -62,6 +62,7 @@ _GLIBCXX_BEGIN_NAMESPACE_VERSION */ #ifdef _GLIBCXX_HAS_GTHREADS + /// @cond undocumented // Common base class for std::recursive_mutex and std::recursive_timed_mutex class __recursive_mutex_base @@ -89,8 +90,17 @@ _GLIBCXX_BEGIN_NAMESPACE_VERSION { __gthread_recursive_mutex_destroy(&_M_mutex); } #endif }; + /// @endcond - /// The standard recursive mutex type. + /** The standard recursive mutex type. + * + * A recursive mutex can be locked more than once by the same thread. + * Other threads cannot lock the mutex until the owning thread unlocks it + * as many times as it was locked. + * + * @headerfile mutex + * @since C++11 + */ class recursive_mutex : private __recursive_mutex_base { public: @@ -132,6 +142,8 @@ _GLIBCXX_BEGIN_NAMESPACE_VERSION }; #if _GTHREAD_USE_MUTEX_TIMEDLOCK + /// @cond undocumented + template<typename _Derived> class __timed_mutex_impl { @@ -207,8 +219,16 @@ _GLIBCXX_BEGIN_NAMESPACE_VERSION return false; } }; + /// @endcond - /// The standard timed mutex type. + /** The standard timed mutex type. + * + * A non-recursive mutex that supports a timeout when trying to acquire the + * lock. + * + * @headerfile mutex + * @since C++11 + */ class timed_mutex : private __mutex_base, public __timed_mutex_impl<timed_mutex> { @@ -273,7 +293,16 @@ _GLIBCXX_BEGIN_NAMESPACE_VERSION #endif }; - /// recursive_timed_mutex + /** The standard recursive timed mutex type. + * + * A recursive mutex that supports a timeout when trying to acquire the + * lock. A recursive mutex can be locked more than once by the same thread. + * Other threads cannot lock the mutex until the owning thread unlocks it + * as many times as it was locked. + * + * @headerfile mutex + * @since C++11 + */ class recursive_timed_mutex : private __recursive_mutex_base, public __timed_mutex_impl<recursive_timed_mutex> @@ -687,6 +716,9 @@ _GLIBCXX_BEGIN_NAMESPACE_VERSION * * A scoped_lock controls mutex ownership within a scope, releasing * ownership in the destructor. + * + * @headerfile mutex + * @since C++17 */ template<typename... _MutexTypes> class scoped_lock diff --git a/libstdc++-v3/include/std/scoped_allocator b/libstdc++-v3/include/std/scoped_allocator index f2e3ed9..c62b048 100644 --- a/libstdc++-v3/include/std/scoped_allocator +++ b/libstdc++-v3/include/std/scoped_allocator @@ -24,7 +24,6 @@ /** @file include/scoped_allocator * This is a Standard C++ Library header. - * @ingroup allocators */ #ifndef _SCOPED_ALLOCATOR diff --git a/libstdc++-v3/include/std/system_error b/libstdc++-v3/include/std/system_error index 45a1d28..95508da 100644 --- a/libstdc++-v3/include/std/system_error +++ b/libstdc++-v3/include/std/system_error @@ -77,7 +77,7 @@ _GLIBCXX_BEGIN_NAMESPACE_VERSION #endif // C++17 /// @} - inline namespace _V2 { +_GLIBCXX_BEGIN_INLINE_ABI_NAMESPACE(_V2) /** @addtogroup diagnostics * @{ @@ -85,13 +85,20 @@ _GLIBCXX_BEGIN_NAMESPACE_VERSION /** Abstract base class for types defining a category of error codes. * - * An error category defines a context that give meaning to the integer + * An error category defines a context that gives meaning to the integer * stored in an `error_code` or `error_condition` object. For example, * the standard `errno` constants such a `EINVAL` and `ENOMEM` are * associated with the "generic" category and other OS-specific error * numbers are associated with the "system" category, but a user-defined * category might give different meanings to the same numerical values. * + * A user-defined category can override the `equivalent` member functions + * to define correspondence between errors in different categories. + * For example, a category for errors from disk I/O could consider some + * of its error numbers equivalent to ENOSPC and ENOENT in the generic + * category. + * + * @headerfile system_error * @since C++11 */ class error_category @@ -104,6 +111,7 @@ _GLIBCXX_BEGIN_NAMESPACE_VERSION error_category(const error_category&) = delete; error_category& operator=(const error_category&) = delete; + /// A string that identifies the error category. virtual const char* name() const noexcept = 0; @@ -118,6 +126,7 @@ _GLIBCXX_BEGIN_NAMESPACE_VERSION _M_message(int) const; public: + /// A description of the error condition corresponding to the number. _GLIBCXX_DEFAULT_ABI_TAG virtual string message(int) const = 0; @@ -131,31 +140,36 @@ _GLIBCXX_BEGIN_NAMESPACE_VERSION #endif public: + /// Return an error_condition corresponding to `i` in this category. virtual error_condition default_error_condition(int __i) const noexcept; + /// Test whether `cond` corresponds to `i` for this category. virtual bool equivalent(int __i, const error_condition& __cond) const noexcept; + /// Test whether `code` corresponds to `i` for this category. virtual bool equivalent(const error_code& __code, int __i) const noexcept; + /// An error_category only compares equal to itself. bool operator==(const error_category& __other) const noexcept { return this == &__other; } + /// Ordered comparison that defines a total order for error categories. #if __cpp_lib_three_way_comparison strong_ordering operator<=>(const error_category& __rhs) const noexcept { return std::compare_three_way()(this, &__rhs); } #else bool - operator!=(const error_category& __other) const noexcept - { return this != &__other; } - - bool operator<(const error_category& __other) const noexcept { return less<const error_category*>()(this, &__other); } + + bool + operator!=(const error_category& __other) const noexcept + { return this != &__other; } #endif }; @@ -168,7 +182,8 @@ _GLIBCXX_BEGIN_NAMESPACE_VERSION _GLIBCXX_CONST const error_category& system_category() noexcept; /// @} - } // end inline namespace + +_GLIBCXX_END_INLINE_ABI_NAMESPACE(_V2) /** @addtogroup diagnostics * @{ @@ -190,8 +205,8 @@ _GLIBCXX_BEGIN_NAMESPACE_VERSION * library might be represented by an HTTP response status code (e.g. 404) * and a custom category defined by the library. * + * @headerfile system_error * @since C++11 - * @ingroup diagnostics */ class error_code { @@ -225,20 +240,25 @@ _GLIBCXX_BEGIN_NAMESPACE_VERSION operator=(_ErrorCodeEnum __e) noexcept { return *this = make_error_code(__e); } + /// The error value. int value() const noexcept { return _M_value; } + /// The error category that this error belongs to. const error_category& category() const noexcept { return *_M_cat; } + /// An `error_condition` for this error's category and value. error_condition default_error_condition() const noexcept; + /// The category's description of the value. _GLIBCXX_DEFAULT_ABI_TAG string message() const { return category().message(value()); } + /// Test whether `value()` is non-zero. explicit operator bool() const noexcept { return _M_value != 0; } @@ -248,14 +268,28 @@ _GLIBCXX_BEGIN_NAMESPACE_VERSION const error_category* _M_cat; }; - // 19.4.2.6 non-member functions - - /// @relates error_code @{ + // C++11 19.5.2.5 non-member functions + /** Create an `error_code` representing a standard `errc` condition. + * + * The `std::errc` constants correspond to `errno` macros and so use the + * generic category. + * + * @relates error_code + * @since C++11 + */ inline error_code make_error_code(errc __e) noexcept { return error_code(static_cast<int>(__e), generic_category()); } + /** Ordered comparison for std::error_code. + * + * This defines a total order by comparing the categories, and then + * if they are equal comparing the values. + * + * @relates error_code + * @since C++11 + */ #if __cpp_lib_three_way_comparison inline strong_ordering operator<=>(const error_code& __lhs, const error_code& __rhs) noexcept @@ -274,13 +308,16 @@ _GLIBCXX_BEGIN_NAMESPACE_VERSION } #endif + /** Write a std::error_code to an ostream. + * + * @relates error_code + * @since C++11 + */ template<typename _CharT, typename _Traits> basic_ostream<_CharT, _Traits>& operator<<(basic_ostream<_CharT, _Traits>& __os, const error_code& __e) { return (__os << __e.category().name() << ':' << __e.value()); } - /// @} - error_condition make_error_condition(errc) noexcept; /** Class error_condition @@ -292,14 +329,17 @@ _GLIBCXX_BEGIN_NAMESPACE_VERSION * An `error_condition` represents something that the program can test for, * and subsequently take appropriate action. * + * @headerfile system_error * @since C++11 */ class error_condition { public: + /// Initialize with a zero (no error) value and the generic category. error_condition() noexcept : _M_value(0), _M_cat(&generic_category()) { } + /// Initialize with the specified value and category. error_condition(int __v, const error_category& __cat) noexcept : _M_value(__v), _M_cat(&__cat) { } @@ -308,6 +348,7 @@ _GLIBCXX_BEGIN_NAMESPACE_VERSION error_condition(_ErrorConditionEnum __e) noexcept { *this = make_error_condition(__e); } + /// Set the value and category. void assign(int __v, const error_category& __cat) noexcept { @@ -322,22 +363,28 @@ _GLIBCXX_BEGIN_NAMESPACE_VERSION operator=(_ErrorConditionEnum __e) noexcept { return *this = make_error_condition(__e); } + /// Reset the value and category to the default-constructed state. void clear() noexcept { assign(0, generic_category()); } - // 19.4.3.4 observers + // C++11 19.5.3.4 observers + + /// The error value. int value() const noexcept { return _M_value; } + /// The error category that this error belongs to. const error_category& category() const noexcept { return *_M_cat; } + /// The category's description of the value. _GLIBCXX_DEFAULT_ABI_TAG string message() const { return category().message(value()); } + /// Test whether `value()` is non-zero. explicit operator bool() const noexcept { return _M_value != 0; } @@ -347,42 +394,75 @@ _GLIBCXX_BEGIN_NAMESPACE_VERSION const error_category* _M_cat; }; - // 19.4.3.6 non-member functions + // C++11 19.5.3.5 non-member functions - /// Create an `error_condition` representing a standard `errc` condition. - /// @relates error_condition + /** Create an `error_condition` representing a standard `errc` condition. + * + * The `std::errc` constants correspond to `errno` macros and so use the + * generic category. + * + * @relates error_condition + * @since C++11 + */ inline error_condition make_error_condition(errc __e) noexcept { return error_condition(static_cast<int>(__e), generic_category()); } - // 19.4.4 Comparison operators + // C++11 19.5.4 Comparison operators - /// @relates error_code + /** Equality comparison for std::error_code. + * + * Returns true only if they have the same category and the same value. + * + * @relates error_condition + * @since C++11 + */ inline bool operator==(const error_code& __lhs, const error_code& __rhs) noexcept - { return (__lhs.category() == __rhs.category() - && __lhs.value() == __rhs.value()); } + { + return __lhs.category() == __rhs.category() + && __lhs.value() == __rhs.value(); + } - /// @relates error_code + /** Equality comparison for std::error_code and std::error_condition. + * + * Uses each category's `equivalent` member function to check whether + * the values correspond to an equivalent error in that category. + * + * @relates error_condition + * @since C++11 + */ inline bool operator==(const error_code& __lhs, const error_condition& __rhs) noexcept { - return (__lhs.category().equivalent(__lhs.value(), __rhs) - || __rhs.category().equivalent(__lhs, __rhs.value())); + return __lhs.category().equivalent(__lhs.value(), __rhs) + || __rhs.category().equivalent(__lhs, __rhs.value()); } - /// @relates error_condition + /** Equality comparison for std::error_condition. + * + * Returns true only if they have the same category and the same value. + * + * @relates error_condition + * @since C++11 + */ inline bool operator==(const error_condition& __lhs, const error_condition& __rhs) noexcept { - return (__lhs.category() == __rhs.category() - && __lhs.value() == __rhs.value()); + return __lhs.category() == __rhs.category() + && __lhs.value() == __rhs.value(); } + /** Ordered comparison for std::error_condition. + * + * This defines a total order by comparing the categories, and then + * if they are equal comparing the values. + * + * @relates error_condition + * @since C++11 + */ #if __cpp_lib_three_way_comparison - /// Define an ordering for error_condition objects. - /// @relates error_condition inline strong_ordering operator<=>(const error_condition& __lhs, const error_condition& __rhs) noexcept @@ -392,8 +472,6 @@ _GLIBCXX_BEGIN_NAMESPACE_VERSION return __lhs.value() <=> __rhs.value(); } #else - /// Define an ordering for error_condition objects. - /// @relates error_condition inline bool operator<(const error_condition& __lhs, const error_condition& __rhs) noexcept @@ -440,6 +518,7 @@ _GLIBCXX_BEGIN_NAMESPACE_VERSION * Typically used to report errors from the operating system and other * low-level APIs. * + * @headerfile system_error * @since C++11 * @ingroup exceptions */ diff --git a/libstdc++-v3/include/std/thread b/libstdc++-v3/include/std/thread index 92b2426..82f191a 100644 --- a/libstdc++-v3/include/std/thread +++ b/libstdc++-v3/include/std/thread @@ -50,6 +50,7 @@ _GLIBCXX_BEGIN_NAMESPACE_VERSION /** * @defgroup threads Threads * @ingroup concurrency + * @since C++11 * * Classes for thread support. * @{ @@ -57,6 +58,8 @@ _GLIBCXX_BEGIN_NAMESPACE_VERSION // std::thread is defined in <bits/std_thread.h> + /// @relates std::thread::id @{ + #if __cpp_lib_three_way_comparison inline strong_ordering operator<=>(thread::id __x, thread::id __y) noexcept @@ -96,9 +99,11 @@ _GLIBCXX_BEGIN_NAMESPACE_VERSION else return __out << __id._M_thread; } + /// @} #ifdef __cpp_lib_jthread + /// @cond undocumented #ifndef __STRICT_ANSI__ template<typename _Callable, typename... _Args> constexpr bool __pmf_expects_stop_token = false; @@ -108,8 +113,22 @@ _GLIBCXX_BEGIN_NAMESPACE_VERSION = __and_<is_member_function_pointer<remove_reference_t<_Callable>>, is_invocable<_Callable, _Obj, stop_token, _Args...>>::value; #endif + /// @endcond - /// A thread that can be requested to stop and automatically joined. + /** A thread with cancellation and automatic joining. + * + * Unlike `std::thread`, destroying a joinable `std::jthread` will not + * terminate the process. Instead, it will try to request its thread to + * stop, then will join it. + * + * A `std::jthread` has a `std::stop_source` member which will be passed + * as the first argument to the callable that runs in the new thread + * (as long as the callable will accept that argument). That can then + * be used to send a stop request that the new thread can test for. + * + * @headerfile thread + * @since C++20 + */ class jthread { public: diff --git a/libstdc++-v3/libsupc++/exception_ptr.h b/libstdc++-v3/libsupc++/exception_ptr.h index 21c53f6..fd9ceec 100644 --- a/libstdc++-v3/libsupc++/exception_ptr.h +++ b/libstdc++-v3/libsupc++/exception_ptr.h @@ -65,9 +65,12 @@ namespace std _GLIBCXX_VISIBILITY(default) using __exception_ptr::exception_ptr; - /** Obtain an exception_ptr to the currently handled exception. If there - * is none, or the currently handled exception is foreign, return the null - * value. + /** Obtain an exception_ptr to the currently handled exception. + * + * If there is none, or the currently handled exception is foreign, + * return the null value. + * + * @since C++11 */ exception_ptr current_exception() _GLIBCXX_USE_NOEXCEPT; @@ -79,10 +82,16 @@ namespace std _GLIBCXX_VISIBILITY(default) namespace __exception_ptr { - using std::rethrow_exception; + using std::rethrow_exception; // So that ADL finds it. /** * @brief An opaque pointer to an arbitrary exception. + * + * The actual name of this type is unspecified, so the alias + * `std::exception_ptr` should be used to refer to it. + * + * @headerfile exception + * @since C++11 (but usable in C++98 as a GCC extension) * @ingroup exceptions */ class exception_ptr @@ -231,6 +240,8 @@ namespace std _GLIBCXX_VISIBILITY(default) } // namespace __exception_ptr + using __exception_ptr::swap; // So that std::swap(exp1, exp2) finds it. + /// Obtain an exception_ptr pointing to a copy of the supplied object. #if (__cplusplus >= 201103L && __cpp_rtti) || __cpp_exceptions template<typename _Ex> diff --git a/libstdc++-v3/libsupc++/nested_exception.h b/libstdc++-v3/libsupc++/nested_exception.h index 002a54e..dec3c0c 100644 --- a/libstdc++-v3/libsupc++/nested_exception.h +++ b/libstdc++-v3/libsupc++/nested_exception.h @@ -35,6 +35,7 @@ #else #include <bits/move.h> +#include <bits/exception_ptr.h> extern "C++" { @@ -45,12 +46,22 @@ namespace std _GLIBCXX_VISIBILITY(default) * @{ */ - /// Exception class with exception_ptr data member. + /** Mixin class that stores the current exception. + * + * This type can be used via `std::throw_with_nested` to store + * the current exception nested within another exception. + * + * @headerfile exception + * @since C++11 + * @see std::throw_with_nested + * @ingroup exceptions + */ class nested_exception { exception_ptr _M_ptr; public: + /// The default constructor stores the current exception (if any). nested_exception() noexcept : _M_ptr(current_exception()) { } nested_exception(const nested_exception&) noexcept = default; @@ -59,6 +70,7 @@ namespace std _GLIBCXX_VISIBILITY(default) virtual ~nested_exception() noexcept; + /// Rethrow the stored exception, or terminate if none was stored. [[noreturn]] void rethrow_nested() const @@ -68,6 +80,7 @@ namespace std _GLIBCXX_VISIBILITY(default) std::terminate(); } + /// Access the stored exception. exception_ptr nested_ptr() const noexcept { return _M_ptr; } @@ -87,6 +100,7 @@ namespace std _GLIBCXX_VISIBILITY(default) { } }; +#if __cplusplus < 201703L || ! defined __cpp_if_constexpr // [except.nested]/8 // Throw an exception of unspecified type that is publicly derived from // both remove_reference_t<_Tp> and nested_exception. @@ -95,8 +109,7 @@ namespace std _GLIBCXX_VISIBILITY(default) inline void __throw_with_nested_impl(_Tp&& __t, true_type) { - using _Up = typename remove_reference<_Tp>::type; - throw _Nested_exception<_Up>{std::forward<_Tp>(__t)}; + throw _Nested_exception<__remove_cvref_t<_Tp>>{std::forward<_Tp>(__t)}; } template<typename _Tp> @@ -104,11 +117,31 @@ namespace std _GLIBCXX_VISIBILITY(default) inline void __throw_with_nested_impl(_Tp&& __t, false_type) { throw std::forward<_Tp>(__t); } +#endif /// @endcond - /// If @p __t is derived from nested_exception, throws @p __t. - /// Else, throws an implementation-defined object derived from both. + /** Throw an exception that also stores the currently active exception. + * + * If `_Tp` is derived from `std::nested_exception` or is not usable + * as a base-class, throws a copy of `__t`. + * Otherwise, throws an object of an implementation-defined type derived + * from both `_Tp` and `std::nested_exception`, containing a copy of `__t` + * and the result of `std::current_exception()`. + * + * In other words, throws the argument as a new exception that contains + * the currently active exception nested within it. This is intended for + * use in a catch handler to replace the caught exception with a different + * type, while still preserving the original exception. When the new + * exception is caught, the nested exception can be rethrown by using + * `std::rethrow_if_nested`. + * + * This can be used at API boundaries, for example to catch a library's + * internal exception type and rethrow it nested with a `std::runtime_error`, + * or vice versa. + * + * @since C++11 + */ template<typename _Tp> [[noreturn]] inline void @@ -119,25 +152,27 @@ namespace std _GLIBCXX_VISIBILITY(default) = __and_<is_copy_constructible<_Up>, is_move_constructible<_Up>>; static_assert(_CopyConstructible::value, "throw_with_nested argument must be CopyConstructible"); + +#if __cplusplus >= 201703L && __cpp_if_constexpr + if constexpr (is_class_v<_Up>) + if constexpr (!is_final_v<_Up>) + if constexpr (!is_base_of_v<nested_exception, _Up>) + throw _Nested_exception<_Up>{std::forward<_Tp>(__t)}; + throw std::forward<_Tp>(__t); +#else using __nest = __and_<is_class<_Up>, __bool_constant<!__is_final(_Up)>, __not_<is_base_of<nested_exception, _Up>>>; std::__throw_with_nested_impl(std::forward<_Tp>(__t), __nest{}); +#endif } +#if __cplusplus < 201703L || ! defined __cpp_if_constexpr /// @cond undocumented - // Determine if dynamic_cast<const nested_exception&> would be well-formed. - template<typename _Tp> - using __rethrow_if_nested_cond = typename enable_if< - __and_<is_polymorphic<_Tp>, - __or_<__not_<is_base_of<nested_exception, _Tp>>, - is_convertible<_Tp*, nested_exception*>>>::value - >::type; - // Attempt dynamic_cast to nested_exception and call rethrow_nested(). template<typename _Ex> - inline __rethrow_if_nested_cond<_Ex> - __rethrow_if_nested_impl(const _Ex* __ptr) + inline void + __rethrow_if_nested_impl(const _Ex* __ptr, true_type) { if (auto __ne_ptr = dynamic_cast<const nested_exception*>(__ptr)) __ne_ptr->rethrow_nested(); @@ -145,16 +180,59 @@ namespace std _GLIBCXX_VISIBILITY(default) // Otherwise, no effects. inline void - __rethrow_if_nested_impl(const void*) + __rethrow_if_nested_impl(const void*, false_type) { } /// @endcond - - /// If @p __ex is derived from nested_exception, @p __ex.rethrow_nested(). +#endif + + /** Rethrow a nested exception + * + * If `__ex` contains a `std::nested_exception` object, call its + * `rethrow_nested()` member to rethrow the stored exception. + * + * After catching an exception thrown by a call to `std::throw_with_nested` + * this function can be used to rethrow the exception that was active when + * `std::throw_with_nested` was called. + * + * @since C++11 + */ + // _GLIBCXX_RESOLVE_LIB_DEFECTS + // 2484. rethrow_if_nested() is doubly unimplementable + // 2784. Resolution to LWG 2484 is missing "otherwise, no effects" and [...] template<typename _Ex> +# if ! __cpp_rtti + [[__gnu__::__always_inline__]] +#endif inline void rethrow_if_nested(const _Ex& __ex) - { std::__rethrow_if_nested_impl(std::__addressof(__ex)); } + { + const _Ex* __ptr = __builtin_addressof(__ex); +#if __cplusplus < 201703L || ! defined __cpp_if_constexpr +# if __cpp_rtti + using __cast = __and_<is_polymorphic<_Ex>, + __or_<__not_<is_base_of<nested_exception, _Ex>>, + is_convertible<_Ex*, nested_exception*>>>; +# else + using __cast = __and_<is_polymorphic<_Ex>, + is_base_of<nested_exception, _Ex>, + is_convertible<_Ex*, nested_exception*>>; +# endif + std::__rethrow_if_nested_impl(__ptr, __cast{}); +#else + if constexpr (!is_polymorphic_v<_Ex>) + return; + else if constexpr (is_base_of_v<nested_exception, _Ex> + && !is_convertible_v<_Ex*, nested_exception*>) + return; // nested_exception base class is inaccessible or ambiguous. +# if ! __cpp_rtti + else if constexpr (!is_base_of_v<nested_exception, _Ex>) + return; // Cannot do polymorphic casts without RTTI. +# endif + else if (auto __ne_ptr = dynamic_cast<const nested_exception*>(__ptr)) + __ne_ptr->rethrow_nested(); +#endif + } /// @} group exceptions } // namespace std diff --git a/libstdc++-v3/libsupc++/typeinfo b/libstdc++-v3/libsupc++/typeinfo index 3018a51..376e82b 100644 --- a/libstdc++-v3/libsupc++/typeinfo +++ b/libstdc++-v3/libsupc++/typeinfo @@ -74,11 +74,11 @@ namespace __cxxabiv1 // By default follow the old inline rules to avoid ABI changes. #ifndef __GXX_TYPEINFO_EQUALITY_INLINE - #if !__GXX_WEAK__ - #define __GXX_TYPEINFO_EQUALITY_INLINE 0 - #else - #define __GXX_TYPEINFO_EQUALITY_INLINE 1 - #endif +# if !__GXX_WEAK__ +# define __GXX_TYPEINFO_EQUALITY_INLINE 0 +# else +# define __GXX_TYPEINFO_EQUALITY_INLINE 1 +# endif #endif namespace std diff --git a/libstdc++-v3/src/c++11/thread.cc b/libstdc++-v3/src/c++11/thread.cc index 669fbb0..707a4ad 100644 --- a/libstdc++-v3/src/c++11/thread.cc +++ b/libstdc++-v3/src/c++11/thread.cc @@ -24,6 +24,7 @@ #define _GLIBCXX_THREAD_ABI_COMPAT 1 +#define _GLIBCXX_THREAD_IMPL 1 #include <memory> // include this first so <thread> can use shared_ptr #include <thread> #include <system_error> diff --git a/libstdc++-v3/testsuite/18_support/nested_exception/rethrow_if_nested-term.cc b/libstdc++-v3/testsuite/18_support/nested_exception/rethrow_if_nested-term.cc new file mode 100644 index 0000000..5913392 --- /dev/null +++ b/libstdc++-v3/testsuite/18_support/nested_exception/rethrow_if_nested-term.cc @@ -0,0 +1,33 @@ +// { dg-do run { target c++11 } } +// { dg-skip-if "" { *-*-* } { "-fno-exceptions" } } + +#include <exception> +#include <cstdlib> + +[[noreturn]] void terminate_cleanly() noexcept { std::exit(0); } + +struct A { virtual ~A() = default; }; + +int main() +{ + try + { + // At this point std::current_exception() == nullptr so the + // std::nested_exception object is empty. + std::throw_with_nested(A{}); + } + catch (const A& a) + { + std::set_terminate(terminate_cleanly); + std::rethrow_if_nested(a); +#if __cpp_rtti + // No nested exception, so trying to rethrow it calls std::terminate() + // which calls std::exit(0). Shoud not reach this point. + std::abort(); +#else + // Without RTTI we can't dynamic_cast<const std::nested_exception*>(&a) + // so std::rethrow_if_nested(a) just returns normally. + return 0; +#endif + } +} |