Merge branch 'master' into devel/sphinx

devel/sphinx
Martin Liska 2022-11-08 12:36:43 +01:00
commit 4b13c73bba
143 changed files with 5248 additions and 1313 deletions

View File

@ -1,3 +1,193 @@
2022-11-07 David Faust <david.faust@oracle.com>
* config/bpf/bpf.cc (handle_attr_preserve): Use maybe_make_core_relo().
2022-11-07 Aldy Hernandez <aldyh@redhat.com>
PR tree-optimization/55157
* range-op.cc (operator_mult::wi_fold): Optimize multiplications
by powers of 2.
2022-11-07 H.J. Lu <hjl.tools@gmail.com>
PR middle-end/102566
* tree-ssa-ccp.cc (optimize_atomic_bit_test_and): Also handle
if (_5 < 0) and if (_5 >= 0).
2022-11-07 Richard Purdie <richard.purdie@linuxfoundation.org>
* file-prefix-map.cc (remap_filename): Handle NULL filenames.
2022-11-07 Alexander Monakov <amonakov@ispras.ru>
PR tree-optimization/107505
* tree-ssa-sink.cc (statement_sink_location): Additionally
reject ECF_RETURNS_TWICE calls.
2022-11-07 Aldy Hernandez <aldyh@redhat.com>
PR tree-optimization/107541
* range-op.cc (operator_div::fold_range): Restrict power of 2
optimization to positive numbers.
2022-11-07 Richard Biener <rguenther@suse.de>
* tree-ssa-loop-unswitch.cc (unswitch_predicate::count): New.
(unswitch_predicate::unswitch_predicate): Initialize count.
(init_loop_unswitch_info): First collect candidates and
determine the outermost loop to unswitch.
(tree_ssa_unswitch_loops): First perform all guard hoisting,
then perform unswitching on innermost loop predicates.
(find_unswitching_predicates_for_bb): Keep track of the
most profitable predicate to unswitch on.
(tree_unswitch_single_loop): Unswitch given predicate if
not NULL.
2022-11-07 Martin Liska <mliska@suse.cz>
Gerald Pfeifer <gerald@pfeifer.com>
* doc/invoke.texi: Improve wording.
2022-11-07 Martin Liska <mliska@suse.cz>
* range-op.cc: Add final override keywords.
2022-11-07 Kewen Lin <linkw@linux.ibm.com>
PR tree-optimization/107412
* gimple-fold.cc (gimple_fold_mask_load_store_mem_ref): Rename to ...
(gimple_fold_partial_load_store_mem_ref): ... this, add one parameter
mask_p indicating it's for mask or length, and add some handlings for
IFN LEN_{LOAD,STORE}.
(gimple_fold_mask_load): Rename to ...
(gimple_fold_partial_load): ... this, add one parameter mask_p.
(gimple_fold_mask_store): Rename to ...
(gimple_fold_partial_store): ... this, add one parameter mask_p.
(gimple_fold_call): Add the handlings for IFN LEN_{LOAD,STORE},
and adjust calls on gimple_fold_mask_load_store_mem_ref to
gimple_fold_partial_load_store_mem_ref.
2022-11-07 Hu, Lin1 <lin1.hu@intel.com>
* common/config/i386/cpuinfo.h
(get_intel_cpu): Handle Grand Ridge.
* common/config/i386/i386-common.cc
(processor_names): Add grandridge.
(processor_alias_table): Ditto.
* common/config/i386/i386-cpuinfo.h:
(enum processor_types): Add INTEL_GRANDRIDGE.
* config.gcc: Add -march=grandridge.
* config/i386/driver-i386.cc (host_detect_local_cpu):
Handle grandridge.
* config/i386/i386-c.cc (ix86_target_macros_internal):
Ditto.
* config/i386/i386-options.cc (m_GRANDRIDGE): New define.
(processor_cost_table): Add grandridge.
* config/i386/i386.h (enum processor_type):
Add PROCESSOR_GRANDRIDGE.
(PTA_GRANDRIDGE): Ditto.
* doc/extend.texi: Add grandridge.
* doc/invoke.texi: Ditto.
2022-11-07 konglin1 <lingling.kong@intel.com>
* config/i386/i386.opt:Add -mprefer-remote-atomic.
* config/i386/sync.md (atomic_<plus_logic><mode>):
New define_expand.
(atomic_add<mode>): Rename to below one.
(atomic_add<mode>_1): To this.
(atomic_<logic><mode>): Ditto.
(atomic_<logic><mode>_1): Ditto.
* doc/invoke.texi: Add -mprefer-remote-atomic.
2022-11-07 konglin1 <lingling.kong@intel.com>
* common/config/i386/cpuinfo.h (get_available_features):
Detect raoint.
* common/config/i386/i386-common.cc (OPTION_MASK_ISA2_RAOINT_SET,
OPTION_MASK_ISA2_RAOINT_UNSET): New.
(ix86_handle_option): Handle -mraoint.
* common/config/i386/i386-cpuinfo.h (enum processor_features):
Add FEATURE_RAOINT.
* common/config/i386/i386-isas.h: Add ISA_NAME_TABLE_ENTRY for
raoint.
* config.gcc: Add raointintrin.h
* config/i386/cpuid.h (bit_RAOINT): New.
* config/i386/i386-builtin.def (BDESC): Add new builtins.
* config/i386/i386-c.cc (ix86_target_macros_internal): Define
__RAOINT__.
* config/i386/i386-isa.def (RAOINT): Add DEF_PTA(RAOINT).
* config/i386/i386-options.cc (ix86_valid_target_attribute_inner_p):
Add -mraoint.
* config/i386/sync.md (rao_a<raointop><mode>): New define insn.
* config/i386/i386.opt: Add option -mraoint.
* config/i386/x86gprintrin.h: Include raointintrin.h.
* doc/extend.texi: Document raoint.
* doc/invoke.texi: Document -mraoint.
* doc/sourcebuild.texi: Document target raoint.
* config/i386/raointintrin.h: New file.
2022-11-07 Haochen Jiang <haochen.jiang@intel.com>
* common/config/i386/cpuinfo.h
(get_intel_cpu): Handle Granite Rapids.
* common/config/i386/i386-common.cc:
(processor_names): Add graniterapids.
(processor_alias_table): Ditto.
* common/config/i386/i386-cpuinfo.h
(enum processor_subtypes): Add INTEL_GRANTIERAPIDS.
* config.gcc: Add -march=graniterapids.
* config/i386/driver-i386.cc (host_detect_local_cpu):
Handle graniterapids.
* config/i386/i386-c.cc (ix86_target_macros_internal):
Ditto.
* config/i386/i386-options.cc (m_GRANITERAPIDS): New.
(processor_cost_table): Add graniterapids.
* config/i386/i386.h (enum processor_type):
Add PROCESSOR_GRANITERAPIDS.
(PTA_GRANITERAPIDS): Ditto.
* doc/extend.texi: Add graniterapids.
* doc/invoke.texi: Ditto.
2022-11-07 Haochen Jiang <haochen.jiang@intel.com>
Hongtao Liu <hongtao.liu@intel.com>
* common/config/i386/cpuinfo.h (get_available_features):
Detect PREFETCHI.
* common/config/i386/i386-common.cc
(OPTION_MASK_ISA2_PREFETCHI_SET,
OPTION_MASK_ISA2_PREFETCHI_UNSET): New.
(ix86_handle_option): Handle -mprefetchi.
* common/config/i386/i386-cpuinfo.h
(enum processor_features): Add FEATURE_PREFETCHI.
* common/config/i386/i386-isas.h: Add ISA_NAME_TABLE_ENTRY
for prefetchi.
* config.gcc: Add prfchiintrin.h.
* config/i386/cpuid.h (bit_PREFETCHI): New.
* config/i386/i386-builtin-types.def:
Add DEF_FUNCTION_TYPE (VOID, PCVOID, INT)
and DEF_FUNCTION_TYPE (VOID, PCVOID, INT, INT, INT).
* config/i386/i386-builtin.def (BDESC): Add new builtins.
* config/i386/i386-c.cc (ix86_target_macros_internal):
Define __PREFETCHI__.
* config/i386/i386-expand.cc: Handle new builtins.
* config/i386/i386-isa.def (PREFETCHI):
Add DEF_PTA(PREFETCHI).
* config/i386/i386-options.cc
(ix86_valid_target_attribute_inner_p): Handle prefetchi.
* config/i386/i386.md (prefetchi): New define_insn.
* config/i386/i386.opt: Add option -mprefetchi.
* config/i386/predicates.md (local_func_symbolic_operand):
New predicates.
* config/i386/x86gprintrin.h: Include prfchiintrin.h.
* config/i386/xmmintrin.h (enum _mm_hint): New enum for
prefetchi.
(_mm_prefetch): Handle the highest bit of enum.
* doc/extend.texi: Document prefetchi.
* doc/invoke.texi: Document -mprefetchi.
* doc/sourcebuild.texi: Document target prefetchi.
* config/i386/prfchiintrin.h: New file.
2022-11-06 Uroš Bizjak <ubizjak@gmail.com>
* optabs.cc (can_vec_set_var_idx_p): Use operand[2]

View File

@ -1 +1 @@
20221107
20221108

View File

@ -1,3 +1,222 @@
2022-11-07 Cedric Landet <landet@adacore.com>
* doc/gnat_ugn/gnat_and_program_execution.rst: Mention the needed
-no-pie for windows to use gprof.
* gnat_ugn.texi: Regenerate.
2022-11-07 Piotr Trojanek <trojanek@adacore.com>
* lib-xref.adb (Hash): Tune hash function.
2022-11-07 Piotr Trojanek <trojanek@adacore.com>
* sem_prag.adb (Non_Significant_Pragma_Reference): Detect
references with aggregates; only assign local variables Id and C
when necessary.
2022-11-07 Bob Duff <duff@adacore.com>
* exp_ch4.adb
(Component_Equality, Expand_Array_Equality)
(Expand_Record_Equality): Use named notation.
2022-11-07 Bob Duff <duff@adacore.com>
* exp_ch4.adb
(Expand_Array_Equality): Do not test Ltyp = Rtyp here, because
that is necessarily true. Move assertion thereof to more general
place.
(Expand_Composite_Equality): Pass in Outer_Type, for use in
warnings. Rename Typ to be Comp_Type, to more clearly distinguish
it from Outer_Type. Print warning when appropriate.
* exp_ch4.ads: Minor comment fix.
* errout.ads: There is no such pragma as Warning_As_Pragma --
Warning_As_Error must have been intended. Improve comment for ?x?.
* exp_ch3.adb
(Build_Untagged_Equality): Update comment to be accurate for more
recent versions of Ada.
* sem_case.adb
(Choice_Analysis): Declare user-defined "=" functions as abstract.
* sem_util.ads
(Is_Bounded_String): Give RM reference in comment.
* warnsw.ads, warnsw.adb
(Warn_On_Ignored_Equality): Implement new warning switch -gnatw_q.
* doc/gnat_ugn/building_executable_programs_with_gnat.rst:
Document new warning switch.
* gnat_ugn.texi: Regenerate.
2022-11-07 Piotr Trojanek <trojanek@adacore.com>
* sem_aux.ads (Is_Body): Annotate with Inline.
* sem_util.ads (Is_Body_Or_Package_Declaration): Likewise.
2022-11-07 Bob Duff <duff@adacore.com>
* freeze.adb
(Build_Inherited_Condition_Pragmas): Do nothing if A_Post is
empty.
2022-11-07 Quentin Ochem <ochem@adacore.com>
Steve Baird <baird@adacore.com>
* bindgen.adb: fixed the way the device init and final symbols are
computed, re-using the normal way these symbols would be computed
with a __device_ prefix. Also fixed the "is null;" procedure on
the host side which are not Ada 95, replaced with a procedure
raising an exception as it should never be called. Remove the
unused function Device_Ada_Final_Link_Name.
2022-11-07 Steve Baird <baird@adacore.com>
* opt.ads: Declare new string pointer variable, CUDA_Device_Library_Name.
Modify comments for existing Boolean variable Enable_CUDA_Device_Expansion.
* switch-b.adb: When "-d_c" switch is encountered, check that the next
character is an "'='; use the remaining characters to initialize
Opt.CUDA_Device_Library_Name.
* bindgen.adb: Remove (for now) most support for host-side invocation of
device-side finalization. Make use of the new CUDA_Device_Library_Name
in determining the string used to refer (on the host side) to the
device-side initialization procedure. Declare the placeholder routine
that is named in the CUDA_Execute pragma (and the CUDA_Register_Function
call) as an exported null procedure, rather than as an imported procedure.
It is not clear whether it is really necessary to specify the link-name
for this should-never-be-called subprogram on the host side, but for now it
shouldn't hurt to do so.
2022-11-07 Piotr Trojanek <trojanek@adacore.com>
* exp_ch6.adb (Expand_Protected_Subprogram_Call): Examine scope
tree and not the scope stack.
2022-11-07 Piotr Trojanek <trojanek@adacore.com>
* mdll.ads (Build_Import_Library): Fix grammar in comment.
* mdll.adb (Build_Import_Library): Directly execute code of a
nested routine; rename No_Lib_Prefix to Strip_Lib_Prefix.
2022-11-07 Bob Duff <duff@adacore.com>
* sem_warn.adb
(Check_For_Warnings): Remove unnecessary exception handler.
(Warn_On_Known_Condition): Suppress warning when we detect a True
or False that has been turned into a more complex expression
because True is represented as "nonzero". (Note that the complex
expression will subsequently be constant-folded to a Boolean True
or False). Also simplify to always print "condition is always ..."
instead of special-casing object names. The special case was
unhelpful, and indeed wrong when the expression is a literal.
2022-11-07 Piotr Trojanek <trojanek@adacore.com>
* checks.adb (Safe_To_Capture_In_Parameter_Value): Remove.
* sem_util.adb (Safe_To_Capture_Value): Stop search at the current
body.
2022-11-07 Piotr Trojanek <trojanek@adacore.com>
* sem_warn.adb (Warn_On_In_Out): Remove No_ prefix; flip return
values between True and False; adapt caller.
2022-11-07 Piotr Trojanek <trojanek@adacore.com>
* sem_ch13.adb (Add_Call): Just look at Instantiation_Depth.
* sem_ch3.adb (Derive_Subprograms): Likewise.
* sem_warn.adb (Check_References): Remove redundant filtering with
Instantiation_Depth that follows filtering with
Instantiation_Location.
* sinput.adb (Instantiation_Depth): Reuse Instantiation_Location.
2022-11-07 Piotr Trojanek <trojanek@adacore.com>
* sem_warn.adb
(No_Warn_On_In_Out): For subprograms we can simply call
Warnings_Off.
(Output_Non_Modified_In_Out_Warnings): Remove repeated
suppression.
2022-11-07 Piotr Trojanek <trojanek@adacore.com>
* sem_aggr.adb (Resolve_Delta_Array_Aggregate): Reject boxes in
delta array aggregates.
2022-11-07 Piotr Trojanek <trojanek@adacore.com>
* sem_res.adb (Enclosing_Declaration_Or_Statement): Moved to
Sem_Util.
* sem_util.ads (Enclosing_Declaration_Or_Statement): Moved from
Sem_Res.
* sem_util.adb (Enclosing_Declaration_Or_Statement): Likewise.
2022-11-07 Piotr Trojanek <trojanek@adacore.com>
* sem_res.adb (Resolve): Only call Comes_From_Predefined_Lib_Unit
when its result might be needed.
2022-11-07 Piotr Trojanek <trojanek@adacore.com>
* sem_ch12.adb (Check_Generic_Actuals): Remove redundant parens;
refactor an excessive if-statement; remove repeated call to Node.
2022-11-07 Piotr Trojanek <trojanek@adacore.com>
* inline.adb (Establish_Actual_Mapping_For_Inlined_Call): Move
comment next to a condition that it describes.
2022-11-07 Steve Baird <baird@adacore.com>
* exp_put_image.adb
(Image_Should_Call_Put_Image): Correctly handle the case of an
inherited Put_Image aspect specification for a scalar type.
2022-11-07 Piotr Trojanek <trojanek@adacore.com>
* libgnarl/s-interr.adb: Tune whitespace.
2022-11-07 Piotr Trojanek <trojanek@adacore.com>
* libgnarl/s-interr.adb: Reorder context items and pragmas.
2022-11-07 Piotr Trojanek <trojanek@adacore.com>
* exp_ch4.adb
(Expand_Modular_Addition): Rewrite using Make_XXX calls.
(Expand_Modular_Op): Likewise.
(Expand_Modular_Subtraction): Likewise.
* exp_imgv.adb
(Expand_User_Defined_Enumeration_Image): Likewise.
2022-11-07 Piotr Trojanek <trojanek@adacore.com>
* checks.adb (Apply_Arithmetic_Overflow_Strict): Rewrite using a
newly created operator node.
* exp_ch4.adb (Expand_Array_Comparison): Likewise.
* exp_ch6.adb (Add_Call_By_Copy_Code): Rewriting actual parameter
using its own location and not the location of the subprogram
call.
* sem_warn.adb (Check_References): Looping with Original_Node is
no longer needed.
2022-11-07 Piotr Trojanek <trojanek@adacore.com>
* sem_prag.adb (Is_In_Context_Clause): Rewrite without negations
and inequalities.
2022-11-07 Piotr Trojanek <trojanek@adacore.com>
* sem_prag.adb (Analyze_Pragma [Pragma_Obsolescent]): Reject
misplaced pragma.
2022-11-07 Piotr Trojanek <trojanek@adacore.com>
* sem_warn.adb (Output_Obsolescent_Entity_Warnings): Tag warnings
about obsolescent functions just like we tag similar warnings for
packages and procedures.
2022-11-07 Piotr Trojanek <trojanek@adacore.com>
* exp_attr.adb (Expand_N_Attribute_Reference): Remove useless
skipping for attribute Input.
2022-11-04 Justin Squirek <squirek@adacore.com>
* exp_attr.adb (Expand_N_Attribute_Reference): Skip operand

View File

@ -42,13 +42,13 @@ with Nmake; use Nmake;
with Opt; use Opt;
with Sem; use Sem;
with Sem_Aux; use Sem_Aux;
with Sem_Ch3; use Sem_Ch3;
with Sem_Ch6; use Sem_Ch6;
with Sem_Ch8; use Sem_Ch8;
with Sem_Ch12; use Sem_Ch12;
with Sem_Ch13; use Sem_Ch13;
with Sem_Disp; use Sem_Disp;
with Sem_Prag; use Sem_Prag;
with Sem_Res; use Sem_Res;
with Sem_Type; use Sem_Type;
with Sem_Util; use Sem_Util;
with Sinfo; use Sinfo;
@ -107,6 +107,11 @@ package body Contracts is
-- well as Contract_Cases, Subprogram_Variant, invariants and predicates.
-- Body_Id denotes the entity of the subprogram body.
procedure Preanalyze_Condition
(Subp : Entity_Id;
Expr : Node_Id);
-- Preanalyze the class-wide condition Expr of Subp
procedure Set_Class_Condition
(Kind : Condition_Kind;
Subp : Entity_Id;
@ -4548,242 +4553,10 @@ package body Contracts is
procedure Merge_Class_Conditions (Spec_Id : Entity_Id) is
procedure Preanalyze_Condition
(Subp : Entity_Id;
Expr : Node_Id);
-- Preanalyze the class-wide condition Expr of Subp
procedure Process_Inherited_Conditions (Kind : Condition_Kind);
-- Collect all inherited class-wide conditions of Spec_Id and merge
-- them into one big condition.
--------------------------
-- Preanalyze_Condition --
--------------------------
procedure Preanalyze_Condition
(Subp : Entity_Id;
Expr : Node_Id)
is
procedure Clear_Unset_References;
-- Clear unset references on formals of Subp since preanalysis
-- occurs in a place unrelated to the actual code.
procedure Remove_Controlling_Arguments;
-- Traverse Expr and clear the Controlling_Argument of calls to
-- nonabstract functions.
procedure Remove_Formals (Id : Entity_Id);
-- Remove formals from homonym chains and make them not visible
procedure Restore_Original_Selected_Component;
-- Traverse Expr searching for dispatching calls to functions whose
-- original node was a selected component, and replace them with
-- their original node.
----------------------------
-- Clear_Unset_References --
----------------------------
procedure Clear_Unset_References is
F : Entity_Id := First_Formal (Subp);
begin
while Present (F) loop
Set_Unset_Reference (F, Empty);
Next_Formal (F);
end loop;
end Clear_Unset_References;
----------------------------------
-- Remove_Controlling_Arguments --
----------------------------------
procedure Remove_Controlling_Arguments is
function Remove_Ctrl_Arg (N : Node_Id) return Traverse_Result;
-- Reset the Controlling_Argument of calls to nonabstract
-- function calls.
---------------------
-- Remove_Ctrl_Arg --
---------------------
function Remove_Ctrl_Arg (N : Node_Id) return Traverse_Result is
begin
if Nkind (N) = N_Function_Call
and then Present (Controlling_Argument (N))
and then not Is_Abstract_Subprogram (Entity (Name (N)))
then
Set_Controlling_Argument (N, Empty);
end if;
return OK;
end Remove_Ctrl_Arg;
procedure Remove_Ctrl_Args is new Traverse_Proc (Remove_Ctrl_Arg);
begin
Remove_Ctrl_Args (Expr);
end Remove_Controlling_Arguments;
--------------------
-- Remove_Formals --
--------------------
procedure Remove_Formals (Id : Entity_Id) is
F : Entity_Id := First_Formal (Id);
begin
while Present (F) loop
Set_Is_Immediately_Visible (F, False);
Remove_Homonym (F);
Next_Formal (F);
end loop;
end Remove_Formals;
-----------------------------------------
-- Restore_Original_Selected_Component --
-----------------------------------------
procedure Restore_Original_Selected_Component is
Restored_Nodes_List : Elist_Id := No_Elist;
procedure Fix_Parents (N : Node_Id);
-- Traverse the subtree of N fixing the Parent field of all the
-- nodes.
function Restore_Node (N : Node_Id) return Traverse_Result;
-- Process dispatching calls to functions whose original node was
-- a selected component, and replace them with their original
-- node. Restored nodes are stored in the Restored_Nodes_List
-- to fix the parent fields of their subtrees in a separate
-- tree traversal.
-----------------
-- Fix_Parents --
-----------------
procedure Fix_Parents (N : Node_Id) is
function Fix_Parent
(Parent_Node : Node_Id;
Node : Node_Id) return Traverse_Result;
-- Process a single node
----------------
-- Fix_Parent --
----------------
function Fix_Parent
(Parent_Node : Node_Id;
Node : Node_Id) return Traverse_Result
is
Par : constant Node_Id := Parent (Node);
begin
if Par /= Parent_Node then
pragma Assert (not Is_List_Member (Node));
Set_Parent (Node, Parent_Node);
end if;
return OK;
end Fix_Parent;
procedure Fix_Parents is
new Traverse_Proc_With_Parent (Fix_Parent);
begin
Fix_Parents (N);
end Fix_Parents;
------------------
-- Restore_Node --
------------------
function Restore_Node (N : Node_Id) return Traverse_Result is
begin
if Nkind (N) = N_Function_Call
and then Nkind (Original_Node (N)) = N_Selected_Component
and then Is_Dispatching_Operation (Entity (Name (N)))
then
Rewrite (N, Original_Node (N));
Set_Original_Node (N, N);
-- Save the restored node in the Restored_Nodes_List to fix
-- the parent fields of their subtrees in a separate tree
-- traversal.
Append_New_Elmt (N, Restored_Nodes_List);
end if;
return OK;
end Restore_Node;
procedure Restore_Nodes is new Traverse_Proc (Restore_Node);
-- Start of processing for Restore_Original_Selected_Component
begin
Restore_Nodes (Expr);
-- After restoring the original node we must fix the decoration
-- of the Parent attribute to ensure tree consistency; required
-- because when the class-wide condition is inherited, calls to
-- New_Copy_Tree will perform copies of this subtree, and formal
-- occurrences with wrong Parent field cannot be mapped to the
-- new formals.
if Present (Restored_Nodes_List) then
declare
Elmt : Elmt_Id := First_Elmt (Restored_Nodes_List);
begin
while Present (Elmt) loop
Fix_Parents (Node (Elmt));
Next_Elmt (Elmt);
end loop;
end;
end if;
end Restore_Original_Selected_Component;
-- Start of processing for Preanalyze_Condition
begin
pragma Assert (Present (Expr));
pragma Assert (Inside_Class_Condition_Preanalysis = False);
Push_Scope (Subp);
Install_Formals (Subp);
Inside_Class_Condition_Preanalysis := True;
Preanalyze_And_Resolve (Expr, Standard_Boolean);
Inside_Class_Condition_Preanalysis := False;
Remove_Formals (Subp);
Pop_Scope;
-- If this preanalyzed condition has occurrences of dispatching calls
-- using the Object.Operation notation, during preanalysis such calls
-- are rewritten as dispatching function calls; if at later stages
-- this condition is inherited we must have restored the original
-- selected-component node to ensure that the preanalysis of the
-- inherited condition rewrites these dispatching calls in the
-- correct context to avoid reporting spurious errors.
Restore_Original_Selected_Component;
-- Traverse Expr and clear the Controlling_Argument of calls to
-- nonabstract functions. Required since the preanalyzed condition
-- is not yet installed on its definite context and will be cloned
-- and extended in derivations with additional conditions.
Remove_Controlling_Arguments;
-- Clear also attribute Unset_Reference; again because preanalysis
-- occurs in a place unrelated to the actual code.
Clear_Unset_References;
end Preanalyze_Condition;
----------------------------------
-- Process_Inherited_Conditions --
----------------------------------
@ -5116,6 +4889,250 @@ package body Contracts is
end loop;
end Merge_Class_Conditions;
---------------------------------
-- Preanalyze_Class_Conditions --
---------------------------------
procedure Preanalyze_Class_Conditions (Spec_Id : Entity_Id) is
Cond : Node_Id;
begin
for Kind in Condition_Kind loop
Cond := Class_Condition (Kind, Spec_Id);
if Present (Cond) then
Preanalyze_Condition (Spec_Id, Cond);
end if;
end loop;
end Preanalyze_Class_Conditions;
--------------------------
-- Preanalyze_Condition --
--------------------------
procedure Preanalyze_Condition
(Subp : Entity_Id;
Expr : Node_Id)
is
procedure Clear_Unset_References;
-- Clear unset references on formals of Subp since preanalysis
-- occurs in a place unrelated to the actual code.
procedure Remove_Controlling_Arguments;
-- Traverse Expr and clear the Controlling_Argument of calls to
-- nonabstract functions.
procedure Remove_Formals (Id : Entity_Id);
-- Remove formals from homonym chains and make them not visible
procedure Restore_Original_Selected_Component;
-- Traverse Expr searching for dispatching calls to functions whose
-- original node was a selected component, and replace them with
-- their original node.
----------------------------
-- Clear_Unset_References --
----------------------------
procedure Clear_Unset_References is
F : Entity_Id := First_Formal (Subp);
begin
while Present (F) loop
Set_Unset_Reference (F, Empty);
Next_Formal (F);
end loop;
end Clear_Unset_References;
----------------------------------
-- Remove_Controlling_Arguments --
----------------------------------
procedure Remove_Controlling_Arguments is
function Remove_Ctrl_Arg (N : Node_Id) return Traverse_Result;
-- Reset the Controlling_Argument of calls to nonabstract
-- function calls.
---------------------
-- Remove_Ctrl_Arg --
---------------------
function Remove_Ctrl_Arg (N : Node_Id) return Traverse_Result is
begin
if Nkind (N) = N_Function_Call
and then Present (Controlling_Argument (N))
and then not Is_Abstract_Subprogram (Entity (Name (N)))
then
Set_Controlling_Argument (N, Empty);
end if;
return OK;
end Remove_Ctrl_Arg;
procedure Remove_Ctrl_Args is new Traverse_Proc (Remove_Ctrl_Arg);
begin
Remove_Ctrl_Args (Expr);
end Remove_Controlling_Arguments;
--------------------
-- Remove_Formals --
--------------------
procedure Remove_Formals (Id : Entity_Id) is
F : Entity_Id := First_Formal (Id);
begin
while Present (F) loop
Set_Is_Immediately_Visible (F, False);
Remove_Homonym (F);
Next_Formal (F);
end loop;
end Remove_Formals;
-----------------------------------------
-- Restore_Original_Selected_Component --
-----------------------------------------
procedure Restore_Original_Selected_Component is
Restored_Nodes_List : Elist_Id := No_Elist;
procedure Fix_Parents (N : Node_Id);
-- Traverse the subtree of N fixing the Parent field of all the
-- nodes.
function Restore_Node (N : Node_Id) return Traverse_Result;
-- Process dispatching calls to functions whose original node was
-- a selected component, and replace them with their original
-- node. Restored nodes are stored in the Restored_Nodes_List
-- to fix the parent fields of their subtrees in a separate
-- tree traversal.
-----------------
-- Fix_Parents --
-----------------
procedure Fix_Parents (N : Node_Id) is
function Fix_Parent
(Parent_Node : Node_Id;
Node : Node_Id) return Traverse_Result;
-- Process a single node
----------------
-- Fix_Parent --
----------------
function Fix_Parent
(Parent_Node : Node_Id;
Node : Node_Id) return Traverse_Result
is
Par : constant Node_Id := Parent (Node);
begin
if Par /= Parent_Node then
pragma Assert (not Is_List_Member (Node));
Set_Parent (Node, Parent_Node);
end if;
return OK;
end Fix_Parent;
procedure Fix_Parents is
new Traverse_Proc_With_Parent (Fix_Parent);
begin
Fix_Parents (N);
end Fix_Parents;
------------------
-- Restore_Node --
------------------
function Restore_Node (N : Node_Id) return Traverse_Result is
begin
if Nkind (N) = N_Function_Call
and then Nkind (Original_Node (N)) = N_Selected_Component
and then Is_Dispatching_Operation (Entity (Name (N)))
then
Rewrite (N, Original_Node (N));
Set_Original_Node (N, N);
-- Save the restored node in the Restored_Nodes_List to fix
-- the parent fields of their subtrees in a separate tree
-- traversal.
Append_New_Elmt (N, Restored_Nodes_List);
end if;
return OK;
end Restore_Node;
procedure Restore_Nodes is new Traverse_Proc (Restore_Node);
-- Start of processing for Restore_Original_Selected_Component
begin
Restore_Nodes (Expr);
-- After restoring the original node we must fix the decoration
-- of the Parent attribute to ensure tree consistency; required
-- because when the class-wide condition is inherited, calls to
-- New_Copy_Tree will perform copies of this subtree, and formal
-- occurrences with wrong Parent field cannot be mapped to the
-- new formals.
if Present (Restored_Nodes_List) then
declare
Elmt : Elmt_Id := First_Elmt (Restored_Nodes_List);
begin
while Present (Elmt) loop
Fix_Parents (Node (Elmt));
Next_Elmt (Elmt);
end loop;
end;
end if;
end Restore_Original_Selected_Component;
-- Start of processing for Preanalyze_Condition
begin
pragma Assert (Present (Expr));
pragma Assert (Inside_Class_Condition_Preanalysis = False);
Push_Scope (Subp);
Install_Formals (Subp);
Inside_Class_Condition_Preanalysis := True;
Preanalyze_Spec_Expression (Expr, Standard_Boolean);
Inside_Class_Condition_Preanalysis := False;
Remove_Formals (Subp);
Pop_Scope;
-- If this preanalyzed condition has occurrences of dispatching calls
-- using the Object.Operation notation, during preanalysis such calls
-- are rewritten as dispatching function calls; if at later stages
-- this condition is inherited we must have restored the original
-- selected-component node to ensure that the preanalysis of the
-- inherited condition rewrites these dispatching calls in the
-- correct context to avoid reporting spurious errors.
Restore_Original_Selected_Component;
-- Traverse Expr and clear the Controlling_Argument of calls to
-- nonabstract functions. Required since the preanalyzed condition
-- is not yet installed on its definite context and will be cloned
-- and extended in derivations with additional conditions.
Remove_Controlling_Arguments;
-- Clear also attribute Unset_Reference; again because preanalysis
-- occurs in a place unrelated to the actual code.
Clear_Unset_References;
end Preanalyze_Condition;
----------------------------------------
-- Save_Global_References_In_Contract --
----------------------------------------

View File

@ -276,6 +276,10 @@ package Contracts is
-- which are invoked from the caller side; they are also used to build
-- the dispatch-table wrapper (DTW), if required.
procedure Preanalyze_Class_Conditions (Spec_Id : Entity_Id);
-- Preanalyze class-wide pre-/postconditions of the given subprogram
-- specification.
procedure Process_Class_Conditions_At_Freeze_Point (Typ : Entity_Id);
-- Merge, preanalyze, and check class-wide pre/postconditions of Typ
-- primitives.

View File

@ -189,7 +189,7 @@ package body Debug is
-- d_U Disable prepending messages with "error:".
-- d_V Enable verifications on the expanded tree
-- d_W
-- d_X
-- d_X Disable assertions to check matching of extra formals
-- d_Y
-- d_Z
@ -1044,6 +1044,10 @@ package body Debug is
-- d_V Enable verification of the expanded code before calling the backend
-- and generate error messages on each inconsistency found.
-- d_X Disable assertions to check matching of extra formals; switch added
-- temporarily to disable these checks until this work is complete if
-- they cause unexpected assertion failures.
-- d1 Error messages have node numbers where possible. Normally error
-- messages have only source locations. This option is useful when
-- debugging errors caused by expanded code, where the source location

View File

@ -2938,7 +2938,7 @@ of the pragma in the :title:`GNAT_Reference_manual`).
tests that are known to be True or False at compile time. The default
is that such warnings are not generated.
Note that this warning does
not get issued for the use of boolean variables or constants whose
not get issued for the use of boolean constants whose
values are known at compile time, since this is a standard technique
for conditional compilation in Ada, and this would generate too many
false positive warnings.

View File

@ -81,12 +81,6 @@ package Err_Vars is
-- Source_Reference line, then this is initialized to No_Source_File,
-- to force an initial reference to the real source file name.
Warning_Doc_Switch : Boolean := True;
-- If this is set True, then the ??/?x?/?x? sequences in error messages
-- are active (see errout.ads for details). If this switch is False, then
-- these sequences are ignored (i.e. simply equivalent to a single ?). The
-- -gnatw.d switch sets this flag True, -gnatw.D sets this flag False.
----------------------------------------
-- Error Message Insertion Parameters --
----------------------------------------

View File

@ -53,6 +53,8 @@ with Stand; use Stand;
with Stylesw; use Stylesw;
with System.OS_Lib;
with Uname; use Uname;
with Warnsw; pragma Unreferenced (Warnsw);
-- Will be referenced when various flags are moved to Warnsw.
package body Errout is

View File

@ -59,15 +59,6 @@ package Errout is
Error_Msg_Exception : exception renames Err_Vars.Error_Msg_Exception;
-- Exception raised if Raise_Exception_On_Error is true
Warning_Doc_Switch : Boolean renames Err_Vars.Warning_Doc_Switch;
-- If this is set True, then the ??/?*?/?$?/?x?/?.x?/?_x? insertion
-- sequences in error messages generate appropriate tags for the output
-- error messages. If this switch is False, then these sequences are still
-- recognized (for the purposes of implementing the pattern matching in
-- pragmas Warnings (Off,..) and Warning_As_Error(...) but do not result
-- in adding the error message tag. The -gnatw.d switch sets this flag
-- True, -gnatw.D sets this flag False.
Current_Node : Node_Id := Empty;
-- Used by Error_Msg as a default Node_Id.
-- Relevant only when Opt.Include_Subprogram_In_Messages is set.

View File

@ -44,6 +44,7 @@ with Stringt; use Stringt;
with Targparm;
with Uintp; use Uintp;
with Widechar; use Widechar;
with Warnsw; use Warnsw;
package body Erroutc is

View File

@ -2316,19 +2316,40 @@ package body Exp_Attr is
if Is_Access_Protected_Subprogram_Type (Btyp) then
Expand_Access_To_Protected_Op (N, Pref, Typ);
-- If prefix is a subprogram that has class-wide preconditions and
-- an indirect-call wrapper (ICW) of such subprogram is available
-- then replace the prefix by the ICW.
elsif Is_Access_Subprogram_Type (Btyp)
and then Is_Entity_Name (Pref)
and then Present (Class_Preconditions (Entity (Pref)))
and then Present (Indirect_Call_Wrapper (Entity (Pref)))
then
Rewrite (Pref,
New_Occurrence_Of
(Indirect_Call_Wrapper (Entity (Pref)), Loc));
Analyze_And_Resolve (N, Typ);
-- If prefix is a subprogram that has class-wide preconditions
-- and an indirect-call wrapper (ICW) of the subprogram is
-- available then replace the prefix by the ICW.
if Present (Class_Preconditions (Entity (Pref)))
and then Present (Indirect_Call_Wrapper (Entity (Pref)))
then
Rewrite (Pref,
New_Occurrence_Of
(Indirect_Call_Wrapper (Entity (Pref)), Loc));
Analyze_And_Resolve (N, Typ);
end if;
-- Ensure the availability of the extra formals to check that
-- they match.
if not Is_Frozen (Entity (Pref))
or else From_Limited_With (Etype (Entity (Pref)))
then
Create_Extra_Formals (Entity (Pref));
end if;
if not Is_Frozen (Btyp_DDT)
or else From_Limited_With (Etype (Btyp_DDT))
then
Create_Extra_Formals (Btyp_DDT);
end if;
pragma Assert
(Extra_Formals_Match_OK
(E => Entity (Pref), Ref_E => Btyp_DDT));
-- If prefix is a type name, this is a reference to the current
-- instance of the type, within its initialization procedure.

View File

@ -44,7 +44,6 @@ with Exp_Dist; use Exp_Dist;
with Exp_Put_Image;
with Exp_Smem; use Exp_Smem;
with Exp_Strm; use Exp_Strm;
with Exp_Tss; use Exp_Tss;
with Exp_Util; use Exp_Util;
with Freeze; use Freeze;
with Ghost; use Ghost;
@ -408,15 +407,6 @@ package body Exp_Ch3 is
-- Freeze entities of all predefined primitive operations. This is needed
-- because the bodies of these operations do not normally do any freezing.
function Stream_Operation_OK
(Typ : Entity_Id;
Operation : TSS_Name_Type) return Boolean;
-- Check whether the named stream operation must be emitted for a given
-- type. The rules for inheritance of stream attributes by type extensions
-- are enforced by this function. Furthermore, various restrictions prevent
-- the generation of these operations, as a useful optimization or for
-- certification purposes and to save unnecessary generated code.
--------------------------
-- Adjust_Discriminants --
--------------------------
@ -5380,6 +5370,10 @@ package body Exp_Ch3 is
procedure Register_Dispatch_Table_Wrappers (Typ : Entity_Id);
-- Register dispatch-table wrappers in the dispatch table of Typ
procedure Validate_Tagged_Type_Extra_Formals (Typ : Entity_Id);
-- Check extra formals of dispatching primitives of tagged type Typ.
-- Used in pragma Debug.
---------------------------------------
-- Build_Class_Condition_Subprograms --
---------------------------------------
@ -5509,6 +5503,78 @@ package body Exp_Ch3 is
end loop;
end Register_Dispatch_Table_Wrappers;
----------------------------------------
-- Validate_Tagged_Type_Extra_Formals --
----------------------------------------
procedure Validate_Tagged_Type_Extra_Formals (Typ : Entity_Id) is
Ovr_Subp : Entity_Id;
Elmt : Elmt_Id;
Subp : Entity_Id;
begin
pragma Assert (not Is_Class_Wide_Type (Typ));
-- No check required if expansion is not active since we never
-- generate extra formals in such case.
if not Expander_Active then
return;
end if;
Elmt := First_Elmt (Primitive_Operations (Typ));
while Present (Elmt) loop
Subp := Node (Elmt);
-- Extra formals of a dispatching primitive must match:
-- 1) The extra formals of its covered interface primitive
if Present (Interface_Alias (Subp)) then
pragma Assert
(Extra_Formals_Match_OK
(E => Interface_Alias (Subp),
Ref_E => Alias (Subp)));
end if;
-- 2) The extra formals of its renamed primitive
if Present (Alias (Subp)) then
pragma Assert
(Extra_Formals_Match_OK
(E => Subp,
Ref_E => Ultimate_Alias (Subp)));
end if;
-- 3) The extra formals of its overridden primitive
if Present (Overridden_Operation (Subp)) then
Ovr_Subp := Overridden_Operation (Subp);
-- Handle controlling function wrapper
if Is_Wrapper (Subp)
and then Ultimate_Alias (Ovr_Subp) = Subp
then
if Present (Overridden_Operation (Ovr_Subp)) then
pragma Assert
(Extra_Formals_Match_OK
(E => Subp,
Ref_E => Overridden_Operation (Ovr_Subp)));
end if;
else
pragma Assert
(Extra_Formals_Match_OK
(E => Subp,
Ref_E => Ovr_Subp));
end if;
end if;
Next_Elmt (Elmt);
end loop;
end Validate_Tagged_Type_Extra_Formals;
-- Local variables
Typ : constant Node_Id := Entity (N);
@ -5897,28 +5963,58 @@ package body Exp_Ch3 is
-- inherited functions, then add their bodies to the freeze actions.
Append_Freeze_Actions (Typ, Wrapper_Body_List);
end if;
-- Create extra formals for the primitive operations of the type.
-- This must be done before analyzing the body of the initialization
-- procedure, because a self-referential type might call one of these
-- primitives in the body of the init_proc itself.
-- Create extra formals for the primitive operations of the type.
-- This must be done before analyzing the body of the initialization
-- procedure, because a self-referential type might call one of these
-- primitives in the body of the init_proc itself.
--
-- This is not needed:
-- 1) If expansion is disabled, because extra formals are only added
-- when we are generating code.
--
-- 2) For types with foreign convention since primitives with foreign
-- convention don't have extra formals and AI95-117 requires that
-- all primitives of a tagged type inherit the convention.
if Expander_Active
and then Is_Tagged_Type (Typ)
and then not Has_Foreign_Convention (Typ)
then
declare
Elmt : Elmt_Id;
Subp : Entity_Id;
E : Entity_Id;
begin
-- Add extra formals to primitive operations
Elmt := First_Elmt (Primitive_Operations (Typ));
while Present (Elmt) loop
Subp := Node (Elmt);
if not Has_Foreign_Convention (Subp)
and then not Is_Predefined_Dispatching_Operation (Subp)
then
Create_Extra_Formals (Subp);
end if;
Create_Extra_Formals (Node (Elmt));
Next_Elmt (Elmt);
end loop;
-- Add extra formals to renamings of primitive operations. The
-- addition of extra formals is done in two steps to minimize
-- the compile time required for this action; the evaluation of
-- Find_Dispatching_Type() and Contains() is only done here for
-- renamings that are not primitive operations.
E := First_Entity (Scope (Typ));
while Present (E) loop
if Is_Dispatching_Operation (E)
and then Present (Alias (E))
and then Find_Dispatching_Type (E) = Typ
and then not Contains (Primitive_Operations (Typ), E)
then
Create_Extra_Formals (E);
end if;
Next_Entity (E);
end loop;
pragma Debug (Validate_Tagged_Type_Extra_Formals (Typ));
end;
end if;

View File

@ -25,9 +25,10 @@
-- Expand routines for chapter 3 constructs
with Types; use Types;
with Elists; use Elists;
with Uintp; use Uintp;
with Types; use Types;
with Elists; use Elists;
with Exp_Tss; use Exp_Tss;
with Uintp; use Uintp;
package Exp_Ch3 is
@ -207,4 +208,13 @@ package Exp_Ch3 is
-- Make_Predefined_Primitive_Eq_Spec; see there for description of
-- the Renamed_Eq parameter.
function Stream_Operation_OK
(Typ : Entity_Id;
Operation : TSS_Name_Type) return Boolean;
-- Check whether the named stream operation must be emitted for a given
-- type. The rules for inheritance of stream attributes by type extensions
-- are enforced by this function. Furthermore, various restrictions prevent
-- the generation of these operations, as a useful optimization or for
-- certification purposes and to save unnecessary generated code.
end Exp_Ch3;

View File

@ -214,7 +214,8 @@ package body Exp_Ch6 is
(Subp_Call : Node_Id;
Subp_Id : Entity_Id) return Boolean;
-- Given a subprogram call to the given subprogram return True if the
-- names of BIP extra actual and formal parameters match.
-- names of BIP extra actual and formal parameters match, and the number
-- of actuals (including extra actuals) matches the number of formals.
function Check_Number_Of_Actuals
(Subp_Call : Node_Id;
@ -314,15 +315,6 @@ package body Exp_Ch6 is
-- Expand simple return from function. In the case where we are returning
-- from a function body this is called by Expand_N_Simple_Return_Statement.
function Has_BIP_Extra_Formal
(E : Entity_Id;
Kind : BIP_Formal_Kind) return Boolean;
-- Given a frozen subprogram, subprogram type, entry or entry family,
-- return True if E has the BIP extra formal associated with Kind. It must
-- be invoked with a frozen entity or a subprogram type of a dispatching
-- call since we can only rely on the availability of the extra formals
-- on these entities.
procedure Insert_Post_Call_Actions (N : Node_Id; Post_Call : List_Id);
-- Insert the Post_Call list previously produced by routine Expand_Actuals
-- or Expand_Call_Helper into the tree.
@ -3313,8 +3305,8 @@ package body Exp_Ch6 is
or else No (Aspect)
-- Do not fold if multiple applicable predicate aspects
or else Present (Find_Aspect (Subt, Aspect_Static_Predicate))
or else Present (Find_Aspect (Subt, Aspect_Predicate))
or else Has_Aspect (Subt, Aspect_Static_Predicate)
or else Has_Aspect (Subt, Aspect_Predicate)
or else Augments_Other_Dynamic_Predicate (Aspect)
or else CodePeer_Mode
then
@ -3342,9 +3334,53 @@ package body Exp_Ch6 is
------------------------------
procedure Check_Subprogram_Variant is
function Duplicate_Params_Without_Extra_Actuals
(Call_Node : Node_Id) return List_Id;
-- Duplicate actual parameters of Call_Node into New_Call without
-- extra actuals.
--------------------------------------------
-- Duplicate_Params_Without_Extra_Actuals --
--------------------------------------------
function Duplicate_Params_Without_Extra_Actuals
(Call_Node : Node_Id) return List_Id
is
Proc_Id : constant Entity_Id := Entity (Name (Call_Node));
Actuals : constant List_Id := Parameter_Associations (Call_Node);
NL : List_Id;
Actual : Node_Or_Entity_Id;
Formal : Entity_Id;
begin
if Actuals = No_List then
return No_List;
else
NL := New_List;
Actual := First (Actuals);
Formal := First_Formal (Proc_Id);
while Present (Formal)
and then Formal /= Extra_Formals (Proc_Id)
loop
Append (New_Copy (Actual), NL);
Next (Actual);
Next_Formal (Formal);
end loop;
return NL;
end if;
end Duplicate_Params_Without_Extra_Actuals;
-- Local variables
Variant_Prag : constant Node_Id :=
Get_Pragma (Current_Scope, Pragma_Subprogram_Variant);
New_Call : Node_Id;
Pragma_Arg1 : Node_Id;
Variant_Proc : Entity_Id;
@ -3373,12 +3409,17 @@ package body Exp_Ch6 is
Variant_Proc := Entity (Pragma_Arg1);
Insert_Action (Call_Node,
New_Call :=
Make_Procedure_Call_Statement (Loc,
Name =>
New_Occurrence_Of (Variant_Proc, Loc),
Parameter_Associations =>
New_Copy_List (Parameter_Associations (Call_Node))));
Duplicate_Params_Without_Extra_Actuals (Call_Node));
Insert_Action (Call_Node, New_Call);
pragma Assert (Etype (New_Call) /= Any_Type
or else Serious_Errors_Detected > 0);
end if;
end Check_Subprogram_Variant;
@ -3679,6 +3720,12 @@ package body Exp_Ch6 is
end if;
end if;
-- Ensure that the called subprogram has all its formals
if not Is_Frozen (Subp) then
Create_Extra_Formals (Subp);
end if;
-- Ada 2005 (AI-345): We have a procedure call as a triggering
-- alternative in an asynchronous select or as an entry call in
-- a conditional or timed select. Check whether the procedure call
@ -3817,7 +3864,7 @@ package body Exp_Ch6 is
and then Thunk_Entity (Current_Scope) = Subp
and then Present (Extra_Formals (Subp))
then
pragma Assert (Present (Extra_Formals (Current_Scope)));
pragma Assert (Extra_Formals_Match_OK (Current_Scope, Subp));
declare
Target_Formal : Entity_Id;
@ -3839,6 +3886,13 @@ package body Exp_Ch6 is
Add_Actual_Parameter (Remove_Head (Extra_Actuals));
end loop;
-- Mark the call as processed build-in-place call; required
-- to avoid adding the extra formals twice.
if Nkind (Call_Node) = N_Function_Call then
Set_Is_Expanded_Build_In_Place_Call (Call_Node);
end if;
Expand_Actuals (Call_Node, Subp, Post_Call);
pragma Assert (Is_Empty_List (Post_Call));
pragma Assert (Check_Number_Of_Actuals (Call_Node, Subp));
@ -6401,8 +6455,13 @@ package body Exp_Ch6 is
if Nkind (Exp) = N_Function_Call then
pragma Assert (Ekind (Scope_Id) = E_Function);
-- This assertion works fine because Is_Build_In_Place_Function_Call
-- returns True for BIP function calls but also for function calls
-- that have BIP formals.
pragma Assert
(Is_Build_In_Place_Function (Scope_Id) =
(Has_BIP_Formals (Scope_Id) =
Is_Build_In_Place_Function_Call (Exp));
null;
end if;
@ -6440,7 +6499,7 @@ package body Exp_Ch6 is
pragma Assert
(Comes_From_Extended_Return_Statement (N)
or else not Is_Build_In_Place_Function_Call (Exp)
or else Is_Build_In_Place_Function (Scope_Id));
or else Has_BIP_Formals (Scope_Id));
if not Comes_From_Extended_Return_Statement (N)
and then Is_Build_In_Place_Function (Scope_Id)
@ -7044,8 +7103,9 @@ package body Exp_Ch6 is
--------------------------
function Has_BIP_Extra_Formal
(E : Entity_Id;
Kind : BIP_Formal_Kind) return Boolean
(E : Entity_Id;
Kind : BIP_Formal_Kind;
Must_Be_Frozen : Boolean := True) return Boolean
is
Extra_Formal : Entity_Id := Extra_Formals (E);
@ -7055,7 +7115,7 @@ package body Exp_Ch6 is
-- extra formals are added when the target subprogram is frozen; see
-- Expand_Dispatching_Call).
pragma Assert (Is_Frozen (E)
pragma Assert ((Is_Frozen (E) or else not Must_Be_Frozen)
or else (Ekind (E) = E_Subprogram_Type
and then Is_Dispatch_Table_Entity (E))
or else (Is_Dispatching_Operation (E)
@ -7684,7 +7744,7 @@ package body Exp_Ch6 is
or else
(Kind = E_Subprogram_Type and then Typ /= Standard_Void_Type))
and then Is_Build_In_Place_Result_Type (Typ)
and then not (Is_Imported (E) and then Has_Foreign_Convention (E));
and then not Has_Foreign_Convention (E);
end Is_Build_In_Place_Function;
-------------------------------------
@ -7739,12 +7799,29 @@ package body Exp_Ch6 is
raise Program_Error;
end if;
declare
Result : constant Boolean := Is_Build_In_Place_Function (Function_Id);
-- So we can stop here in the debugger
begin
return Result;
end;
if Is_Build_In_Place_Function (Function_Id) then
return True;
-- True also if the function has BIP Formals
else
declare
Kind : constant Entity_Kind := Ekind (Function_Id);
begin
if (Kind in E_Function | E_Generic_Function
or else (Kind = E_Subprogram_Type
and then
Etype (Function_Id) /= Standard_Void_Type))
and then Has_BIP_Formals (Function_Id)
then
-- So we can stop here in the debugger
return True;
else
return False;
end if;
end;
end if;
end Is_Build_In_Place_Function_Call;
-----------------------------------
@ -8413,6 +8490,11 @@ package body Exp_Ch6 is
-- initialization expression of the object to Empty, which would be
-- illegal Ada, and would cause gigi to misallocate X.
Is_OK_Return_Object : constant Boolean :=
Is_Return_Object (Obj_Def_Id)
and then
not Has_Foreign_Convention (Return_Applies_To (Scope (Obj_Def_Id)));
-- Start of processing for Make_Build_In_Place_Call_In_Object_Declaration
begin
@ -8465,7 +8547,7 @@ package body Exp_Ch6 is
-- the result object is in a different (transient) scope, so won't cause
-- freezing.
if Definite and then not Is_Return_Object (Obj_Def_Id) then
if Definite and then not Is_OK_Return_Object then
-- The presence of an address clause complicates the build-in-place
-- expansion because the indicated address must be processed before
@ -8548,7 +8630,7 @@ package body Exp_Ch6 is
-- really be directly built in place in the aggregate and not in a
-- temporary. ???)
if Is_Return_Object (Obj_Def_Id) then
if Is_OK_Return_Object then
Pass_Caller_Acc := True;
-- When the enclosing function has a BIP_Alloc_Form formal then we
@ -8733,7 +8815,7 @@ package body Exp_Ch6 is
-- itself the return expression of an enclosing BIP function, then mark
-- the object as having no initialization.
if Definite and then not Is_Return_Object (Obj_Def_Id) then
if Definite and then not Is_OK_Return_Object then
-- The related object declaration is encased in a transient block
-- because the build-in-place function call contains at least one
@ -9090,7 +9172,7 @@ package body Exp_Ch6 is
and then not No_Run_Time_Mode
and then (Has_Task (Typ)
or else (Is_Class_Wide_Type (Typ)
and then Is_Limited_Record (Typ)
and then Is_Limited_Record (Etype (Typ))
and then not Has_Aspect
(Etype (Typ), Aspect_No_Task_Parts)));
end Might_Have_Tasks;
@ -9100,7 +9182,6 @@ package body Exp_Ch6 is
----------------------------
function Needs_BIP_Task_Actuals (Func_Id : Entity_Id) return Boolean is
pragma Assert (Is_Build_In_Place_Function (Func_Id));
Subp_Id : Entity_Id;
Func_Typ : Entity_Id;
@ -9125,6 +9206,12 @@ package body Exp_Ch6 is
Func_Typ := Underlying_Type (Etype (Subp_Id));
-- Functions returning types with foreign convention don't have extra
-- formals.
if Has_Foreign_Convention (Func_Typ) then
return False;
-- At first sight, for all the following cases, we could add assertions
-- to ensure that if Func_Id is frozen then the computed result matches
-- with the availability of the task master extra formal; unfortunately
@ -9132,7 +9219,7 @@ package body Exp_Ch6 is
-- (that is, Is_Frozen has been set by Freeze_Entity but it has not
-- completed its work).
if Has_Task (Func_Typ) then
elsif Has_Task (Func_Typ) then
return True;
elsif Ekind (Func_Id) = E_Function then
@ -9164,8 +9251,6 @@ package body Exp_Ch6 is
Typ : constant Entity_Id := Underlying_Type (Etype (Func_Id));
begin
pragma Assert (Is_Build_In_Place_Function (Func_Id));
-- A formal giving the finalization master is needed for build-in-place
-- functions whose result type needs finalization or is a tagged type.
-- Tagged primitive build-in-place functions need such a formal because
@ -9177,7 +9262,8 @@ package body Exp_Ch6 is
-- such build-in-place functions, primitive or not.
return not Restriction_Active (No_Finalization)
and then (Needs_Finalization (Typ) or else Is_Tagged_Type (Typ));
and then (Needs_Finalization (Typ) or else Is_Tagged_Type (Typ))
and then not Has_Foreign_Convention (Typ);
end Needs_BIP_Finalization_Master;
--------------------------
@ -9188,8 +9274,6 @@ package body Exp_Ch6 is
Typ : constant Entity_Id := Underlying_Type (Etype (Func_Id));
begin
pragma Assert (Is_Build_In_Place_Function (Func_Id));
-- A formal giving the allocation method is needed for build-in-place
-- functions whose result type is returned on the secondary stack or
-- is a tagged type. Tagged primitive build-in-place functions need
@ -9201,7 +9285,8 @@ package body Exp_Ch6 is
-- to be passed to all such build-in-place functions, primitive or not.
return not Restriction_Active (No_Secondary_Stack)
and then (Needs_Secondary_Stack (Typ) or else Is_Tagged_Type (Typ));
and then (Needs_Secondary_Stack (Typ) or else Is_Tagged_Type (Typ))
and then not Has_Foreign_Convention (Typ);
end Needs_BIP_Alloc_Form;
-------------------------------------
@ -9496,6 +9581,161 @@ package body Exp_Ch6 is
return Unqual_BIP_Function_Call (Expr);
end Unqual_BIP_Iface_Function_Call;
-------------------------------
-- Validate_Subprogram_Calls --
-------------------------------
procedure Validate_Subprogram_Calls (N : Node_Id) is
function Process_Node (Nod : Node_Id) return Traverse_Result;
-- Function to traverse the subtree of N using Traverse_Proc.
------------------
-- Process_Node --
------------------
function Process_Node (Nod : Node_Id) return Traverse_Result is
begin
case Nkind (Nod) is
when N_Entry_Call_Statement
| N_Procedure_Call_Statement
| N_Function_Call
=>
declare
Call_Node : Node_Id renames Nod;
Subp : Entity_Id;
begin
-- Call using access to subprogram with explicit dereference
if Nkind (Name (Call_Node)) = N_Explicit_Dereference then
Subp := Etype (Name (Call_Node));
-- Prefix notation calls
elsif Nkind (Name (Call_Node)) = N_Selected_Component then
Subp := Entity (Selector_Name (Name (Call_Node)));
-- Call to member of entry family, where Name is an indexed
-- component, with the prefix being a selected component
-- giving the task and entry family name, and the index
-- being the entry index.
elsif Nkind (Name (Call_Node)) = N_Indexed_Component then
Subp :=
Entity (Selector_Name (Prefix (Name (Call_Node))));
-- Normal case
else
Subp := Entity (Name (Call_Node));
end if;
pragma Assert (Check_BIP_Actuals (Call_Node, Subp));
end;
-- Skip generic bodies
when N_Package_Body =>
if Ekind (Unique_Defining_Entity (Nod)) = E_Generic_Package then
return Skip;
end if;
when N_Subprogram_Body =>
if Ekind (Unique_Defining_Entity (Nod)) in E_Generic_Function
| E_Generic_Procedure
then
return Skip;
end if;
-- Nodes we want to ignore
-- Skip calls placed in the full declaration of record types since
-- the call will be performed by their Init Proc; for example,
-- calls initializing default values of discriminants or calls
-- providing the initial value of record type components. Other
-- full type declarations are processed because they may have
-- calls that must be checked. For example:
-- type T is array (1 .. Some_Function_Call (...)) of Some_Type;
-- ??? More work needed here to handle the following case:
-- type Rec is record
-- F : String (1 .. <some complicated expression>);
-- end record;
when N_Full_Type_Declaration =>
if Is_Record_Type (Defining_Entity (Nod)) then
return Skip;
end if;
-- Skip calls placed in subprogram specifications since function
-- calls initializing default parameter values will be processed
-- when the call to the subprogram is found (if the default actual
-- parameter is required), and calls found in aspects will be
-- processed when their corresponding pragma is found, or in the
-- specific case of class-wide pre-/postconditions, when their
-- helpers are found.
when N_Procedure_Specification
| N_Function_Specification
=>
return Skip;
when N_Abstract_Subprogram_Declaration
| N_At_Clause
| N_Call_Marker
| N_Empty
| N_Enumeration_Representation_Clause
| N_Enumeration_Type_Definition
| N_Function_Instantiation
| N_Freeze_Generic_Entity
| N_Generic_Function_Renaming_Declaration
| N_Generic_Package_Renaming_Declaration
| N_Generic_Procedure_Renaming_Declaration
| N_Generic_Package_Declaration
| N_Generic_Subprogram_Declaration
| N_Itype_Reference
| N_Number_Declaration
| N_Package_Instantiation
| N_Package_Renaming_Declaration
| N_Pragma
| N_Procedure_Instantiation
| N_Protected_Type_Declaration
| N_Record_Representation_Clause
| N_Validate_Unchecked_Conversion
| N_Variable_Reference_Marker
| N_Use_Package_Clause
| N_Use_Type_Clause
| N_With_Clause
=>
return Skip;
when others =>
null;
end case;
return OK;
end Process_Node;
procedure Check_Calls is new Traverse_Proc (Process_Node);
-- Start of processing for Validate_Subprogram_Calls
begin
-- No action required if we are not generating code or compiling sources
-- that have errors.
if Serious_Errors_Detected > 0
or else Operating_Mode /= Generate_Code
then
return;
end if;
Check_Calls (N);
end Validate_Subprogram_Calls;
--------------
-- Warn_BIP --
--------------

View File

@ -121,6 +121,18 @@ package Exp_Ch6 is
-- The returned node is the root of the procedure body which will replace
-- the original function body, which is not needed for the C program.
function Has_BIP_Extra_Formal
(E : Entity_Id;
Kind : BIP_Formal_Kind;
Must_Be_Frozen : Boolean := True) return Boolean;
-- Given a subprogram, subprogram type, entry or entry family, return True
-- if E has the BIP extra formal associated with Kind. In general this
-- subprogram must be invoked with a frozen entity or a subprogram type of
-- a dispatching call since we can only rely on the availability of extra
-- formals on these entities; this requirement can be relaxed using the
-- formal Must_Be_Frozen in scenarios where we know that the entity has
-- the extra formals.
procedure Install_Class_Preconditions_Check (Call_Node : Node_Id);
-- Install check of class-wide preconditions on the caller.
@ -137,7 +149,8 @@ package Exp_Ch6 is
function Is_Build_In_Place_Function_Call (N : Node_Id) return Boolean;
-- Ada 2005 (AI-318-02): Returns True if N denotes a call to a function
-- that requires handling as a build-in-place call (possibly qualified or
-- converted).
-- converted); that is, BIP function calls, and calls to functions with
-- inherited BIP formals.
function Is_Build_In_Place_Result_Type (Typ : Entity_Id) return Boolean;
-- Ada 2005 (AI-318-02): Returns True if functions returning the type use
@ -265,6 +278,11 @@ package Exp_Ch6 is
-- to reference the secondary dispatch table of an interface; otherwise
-- return Empty.
procedure Validate_Subprogram_Calls (N : Node_Id);
-- Check that the number of actuals (including extra actuals) of calls in
-- the subtree N match their corresponding formals; check also that the
-- names of BIP extra actuals and formals match.
private
pragma Inline (Is_Build_In_Place_Return_Object);

View File

@ -3207,10 +3207,45 @@ package body Exp_Ch9 is
Find_Enclosing_Context (Par, Context, Context_Id, Decls);
end if;
-- When the enclosing context is a BIP function whose result type has
-- tasks, the function has an extra formal that is the master of the
-- tasks to be created by its returned object (that is, when its
-- enclosing context is a return statement). However, if the body of
-- the function creates tasks before its return statements, such tasks
-- need their own master.
if Has_Master_Entity (Context_Id)
and then Ekind (Context_Id) = E_Function
and then Is_Build_In_Place_Function (Context_Id)
and then Needs_BIP_Task_Actuals (Context_Id)
then
-- No need to add it again if previously added
declare
Master_Present : Boolean;
begin
-- Handle transient scopes
if Context_Id /= Current_Scope then
Push_Scope (Context_Id);
Master_Present :=
Present (Current_Entity_In_Scope (Name_uMaster));
Pop_Scope;
else
Master_Present :=
Present (Current_Entity_In_Scope (Name_uMaster));
end if;
if Master_Present then
return;
end if;
end;
-- Nothing to do if the context already has a master; internally built
-- finalizers don't need a master.
if Has_Master_Entity (Context_Id)
elsif Has_Master_Entity (Context_Id)
or else Is_Finalizer (Context_Id)
then
return;

View File

@ -1842,6 +1842,15 @@ package body Exp_Imgv is
return;
end if;
-- If Image should be transformed using Put_Image, then do so. See
-- Exp_Put_Image for details.
if Exp_Put_Image.Image_Should_Call_Put_Image (N) then
Rewrite (N, Exp_Put_Image.Build_Image_Call (N));
Analyze_And_Resolve (N, Standard_Wide_String, Suppress => All_Checks);
return;
end if;
Rtyp := Root_Type (Entity (Pref));
Insert_Actions (N, New_List (
@ -1942,6 +1951,16 @@ package body Exp_Imgv is
return;
end if;
-- If Image should be transformed using Put_Image, then do so. See
-- Exp_Put_Image for details.
if Exp_Put_Image.Image_Should_Call_Put_Image (N) then
Rewrite (N, Exp_Put_Image.Build_Image_Call (N));
Analyze_And_Resolve
(N, Standard_Wide_Wide_String, Suppress => All_Checks);
return;
end if;
Rtyp := Root_Type (Entity (Pref));
Insert_Actions (N, New_List (

View File

@ -1045,7 +1045,7 @@ package body Exp_Put_Image is
declare
U_Type : constant Entity_Id := Underlying_Type (Entity (Prefix (N)));
begin
if Present (Find_Aspect (U_Type, Aspect_Put_Image)) then
if Has_Aspect (U_Type, Aspect_Put_Image) then
return True;
end if;
@ -1058,12 +1058,14 @@ package body Exp_Put_Image is
----------------------
function Build_Image_Call (N : Node_Id) return Node_Id is
-- For T'Image (X) Generate an Expression_With_Actions node:
-- For T'[[Wide_]Wide_]Image (X) Generate an Expression_With_Actions
-- node:
--
-- do
-- S : Buffer;
-- U_Type'Put_Image (S, X);
-- Result : constant String := Get (S);
-- Result : constant [[Wide_]Wide_]String :=
-- [[Wide_[Wide_]]Get (S);
-- Destroy (S);
-- in Result end
--
@ -1091,14 +1093,33 @@ package body Exp_Put_Image is
Image_Prefix));
Result_Entity : constant Entity_Id :=
Make_Temporary (Loc, 'R');
subtype Image_Name_Id is Name_Id with Static_Predicate =>
Image_Name_Id in Name_Image | Name_Wide_Image | Name_Wide_Wide_Image;
-- Attribute names that will be mapped to the corresponding result types
-- and functions.
Attribute_Name_Id : constant Name_Id := Attribute_Name (N);
Result_Typ : constant Entity_Id :=
(case Image_Name_Id'(Attribute_Name_Id) is
when Name_Image => Stand.Standard_String,
when Name_Wide_Image => Stand.Standard_Wide_String,
when Name_Wide_Wide_Image => Stand.Standard_Wide_Wide_String);
Get_Func_Id : constant RE_Id :=
(case Image_Name_Id'(Attribute_Name_Id) is
when Name_Image => RE_Get,
when Name_Wide_Image => RE_Wide_Get,
when Name_Wide_Wide_Image => RE_Wide_Wide_Get);
Result_Decl : constant Node_Id :=
Make_Object_Declaration (Loc,
Defining_Identifier => Result_Entity,
Object_Definition =>
New_Occurrence_Of (Stand.Standard_String, Loc),
New_Occurrence_Of (Result_Typ, Loc),
Expression =>
Make_Function_Call (Loc,
Name => New_Occurrence_Of (RTE (RE_Get), Loc),
Name => New_Occurrence_Of (RTE (Get_Func_Id), Loc),
Parameter_Associations => New_List (
New_Occurrence_Of (Sink_Entity, Loc))));
Actions : List_Id;

View File

@ -91,9 +91,9 @@ package Exp_Put_Image is
-- T'Image.
function Build_Image_Call (N : Node_Id) return Node_Id;
-- N is a call to T'Image, and this translates it into the appropriate code
-- to call T'Put_Image into a buffer and then extract the string from the
-- buffer.
-- N is a call to T'[[Wide_]Wide_]Image, and this translates it into the
-- appropriate code to call T'Put_Image into a buffer and then extract the
-- [[wide] wide] string from the buffer.
procedure Preload_Root_Buffer_Type (Compilation_Unit : Node_Id);
-- Call RTE (RE_Root_Buffer_Type) if necessary, to load the packages

View File

@ -895,7 +895,7 @@ package body Exp_SPARK is
procedure SPARK_Freeze_Type (N : Entity_Id) is
Typ : constant Entity_Id := Entity (N);
Renamed_Eq : Node_Id;
Renamed_Eq : Entity_Id;
-- Defining unit name for the predefined equality function in the case
-- where the type has a primitive operation that is a renaming of
-- predefined equality (but only if there is also an overriding

View File

@ -366,9 +366,9 @@ extern Boolean Stack_Check_Probes_On_Target;
/* warnsw: */
#define Warn_On_Questionable_Layout warnsw__warn_on_questionable_layout
#define Get_Warn_On_Questionable_Layout warnsw__get_warn_on_questionable_layout
extern Boolean Warn_On_Questionable_Layout;
extern Boolean Get_Warn_On_Questionable_Layout (void);
// The following corresponds to Ada code in Einfo.Utils.

View File

@ -4984,6 +4984,7 @@ package body Freeze is
and then Convention (Desig) /= Convention_Protected
then
Set_Is_Frozen (Desig);
Create_Extra_Formals (Desig);
end if;
end Check_Itype;
@ -7131,11 +7132,11 @@ package body Freeze is
Check_Debug_Info_Needed (E);
-- AI-117 requires that the convention of a partial view be the
-- same as the convention of the full view. Note that this is a
-- recognized breach of privacy, but it's essential for logical
-- consistency of representation, and the lack of a rule in
-- RM95 was an oversight.
-- AI95-117 requires that the convention of a partial view be
-- the same as the convention of the full view. Note that this
-- is a recognized breach of privacy, but it's essential for
-- logical consistency of representation, and the lack of a
-- rule in RM95 was an oversight.
Set_Convention (E, Convention (Full_View (E)));
@ -7360,7 +7361,7 @@ package body Freeze is
if Is_Composite_Type (E) then
-- AI-117 requires that all new primitives of a tagged type must
-- AI95-117 requires that all new primitives of a tagged type must
-- inherit the convention of the full view of the type. Inherited
-- and overriding operations are defined to inherit the convention
-- of their parent or overridden subprogram (also specified in
@ -8268,7 +8269,7 @@ package body Freeze is
if Present (Nam)
and then Ekind (Nam) = E_Function
and then Nkind (Parent (N)) = N_Function_Call
and then Convention (Nam) = Convention_Ada
and then not Has_Foreign_Convention (Nam)
then
Create_Extra_Formals (Nam);
end if;
@ -9875,77 +9876,11 @@ package body Freeze is
-----------------------
procedure Freeze_Subprogram (E : Entity_Id) is
function Check_Extra_Formals (E : Entity_Id) return Boolean;
-- Return True if the decoration of the attributes associated with extra
-- formals are properly set.
procedure Set_Profile_Convention (Subp_Id : Entity_Id);
-- Set the conventions of all anonymous access-to-subprogram formals and
-- result subtype of subprogram Subp_Id to the convention of Subp_Id.
-------------------------
-- Check_Extra_Formals --
-------------------------
function Check_Extra_Formals (E : Entity_Id) return Boolean is
Last_Formal : Entity_Id := Empty;
Formal : Entity_Id;
Has_Extra_Formals : Boolean := False;
begin
-- No check required if expansion is disabled because extra
-- formals are only generated when we are generating code.
-- See Create_Extra_Formals.
if not Expander_Active then
return True;
end if;
-- Check attribute Extra_Formal: If available, it must be set only
-- on the last formal of E.
Formal := First_Formal (E);
while Present (Formal) loop
if Present (Extra_Formal (Formal)) then
if Has_Extra_Formals then
return False;
end if;
Has_Extra_Formals := True;
end if;
Last_Formal := Formal;
Next_Formal (Formal);
end loop;
-- Check attribute Extra_Accessibility_Of_Result
if Ekind (E) in E_Function | E_Subprogram_Type
and then Needs_Result_Accessibility_Level (E)
and then No (Extra_Accessibility_Of_Result (E))
then
return False;
end if;
-- Check attribute Extra_Formals: If E has extra formals, then this
-- attribute must point to the first extra formal of E.
if Has_Extra_Formals then
return Present (Extra_Formals (E))
and then Present (Extra_Formal (Last_Formal))
and then Extra_Formal (Last_Formal) = Extra_Formals (E);
-- When E has no formals, the first extra formal is available through
-- the Extra_Formals attribute.
elsif Present (Extra_Formals (E)) then
return No (First_Formal (E));
else
return True;
end if;
end Check_Extra_Formals;
----------------------------
-- Set_Profile_Convention --
----------------------------
@ -10084,30 +10019,26 @@ package body Freeze is
-- that we know the convention.
if not Has_Foreign_Convention (E) then
if No (Extra_Formals (E)) then
-- Extra formals are shared by derived subprograms; therefore, if
-- the ultimate alias of E has been frozen before E then the extra
-- formals have been added, but the attribute Extra_Formals is
-- still unset (and must be set now).
-- Extra formals of dispatching operations are added later by
-- Expand_Freeze_Record_Type, which also adds extra formals to
-- internal entities built to handle interface types.
if Present (Alias (E))
and then Is_Frozen (Ultimate_Alias (E))
and then Present (Extra_Formals (Ultimate_Alias (E)))
and then Last_Formal (Ultimate_Alias (E)) = Last_Formal (E)
then
Set_Extra_Formals (E, Extra_Formals (Ultimate_Alias (E)));
if not Is_Dispatching_Operation (E) then
Create_Extra_Formals (E);
if Ekind (E) = E_Function then
Set_Extra_Accessibility_Of_Result (E,
Extra_Accessibility_Of_Result (Ultimate_Alias (E)));
end if;
else
Create_Extra_Formals (E);
end if;
pragma Assert
((Ekind (E) = E_Subprogram_Type
and then Extra_Formals_OK (E))
or else
(Is_Subprogram (E)
and then Extra_Formals_OK (E)
and then
(No (Overridden_Operation (E))
or else Extra_Formals_Match_OK (E,
Ultimate_Alias (Overridden_Operation (E))))));
end if;
pragma Assert (Check_Extra_Formals (E));
Set_Mechanisms (E);
-- If this is convention Ada and a Valued_Procedure, that's odd

View File

@ -30,6 +30,7 @@ with Checks;
with CStand;
with Debug; use Debug;
with Elists;
with Exp_Ch6;
with Exp_Dbug;
with Exp_Unst;
with Fmap;
@ -523,6 +524,16 @@ begin
VAST.Check_Tree (Cunit (Main_Unit));
end if;
-- Validate all the subprogram calls; this work will be done by VAST; in
-- the meantime it is done to check extra formals and it can be disabled
-- using -gnatd_X (which also disables all the other assertions on extra
-- formals). It is invoked using pragma Debug to avoid adding any cost
-- when the compiler is built with assertions disabled.
if not Debug_Flag_Underscore_XX then
pragma Debug (Exp_Ch6.Validate_Subprogram_Calls (Cunit (Main_Unit)));
end if;
-- Dump the source now. Note that we do this as soon as the analysis
-- of the tree is complete, because it is not just a dump in the case
-- of -gnatD, where it rewrites all source locations in the tree.

View File

@ -601,7 +601,6 @@ GNATBIND_OBJS = \
ada/osint-b.o \
ada/osint.o \
ada/output.o \
ada/restrict.o \
ada/rident.o \
ada/scans.o \
ada/scil_ll.o \
@ -629,6 +628,7 @@ GNATBIND_OBJS = \
ada/uintp.o \
ada/uname.o \
ada/urealp.o \
ada/warnsw.o \
ada/widechar.o \
ada/gnat.o \
ada/g-dynhta.o \

View File

@ -333,7 +333,7 @@ GNATMAKE_OBJS = a-except.o ali.o ali-util.o aspects.o s-casuti.o alloc.o \
s-purexc.o s-htable.o scil_ll.o sem_aux.o sinfo.o sinput.o sinput-c.o \
snames.o stand.o stringt.o styleg.o stylesw.o system.o validsw.o \
switch.o switch-m.o table.o targparm.o tempdir.o types.o uintp.o \
uname.o urealp.o usage.o widechar.o \
uname.o urealp.o usage.o widechar.o warnsw.o \
seinfo.o einfo-entities.o einfo-utils.o sinfo-nodes.o sinfo-utils.o \
$(EXTRA_GNATMAKE_OBJS)

View File

@ -8363,7 +8363,7 @@ components_to_record (Node_Id gnat_component_list, Entity_Id gnat_record_type,
&& !Debug_Flag_Dot_R);
const bool w_reorder
= (Convention (gnat_record_type) == Convention_Ada
&& Warn_On_Questionable_Layout
&& Get_Warn_On_Questionable_Layout ()
&& !(No_Reordering (gnat_record_type) && GNAT_Mode));
tree gnu_zero_list = NULL_TREE;
tree gnu_self_list = NULL_TREE;

View File

@ -2439,8 +2439,8 @@ build_allocator (tree type, tree init, tree result_type, Entity_Id gnat_proc,
tree storage_ptr_type = build_pointer_type (storage_type);
tree lhs, rhs;
size = SUBSTITUTE_PLACEHOLDER_IN_EXPR (TYPE_SIZE_UNIT (storage_type),
init);
size = TYPE_SIZE_UNIT (storage_type);
size = SUBSTITUTE_PLACEHOLDER_IN_EXPR (size, init);
/* If the size overflows, pass -1 so Storage_Error will be raised. */
if (TREE_CODE (size) == INTEGER_CST && !valid_constant_size_p (size))
@ -2454,8 +2454,10 @@ build_allocator (tree type, tree init, tree result_type, Entity_Id gnat_proc,
/* If there is an initializing expression, then make a constructor for
the entire object including the bounds and copy it into the object.
If there is no initializing expression, just set the bounds. */
if (init)
If there is no initializing expression, just set the bounds. Note
that, if we have a storage model, we need to copy the initializing
expression separately from the bounds. */
if (init && !pool_is_storage_model)
{
vec<constructor_elt, va_gc> *v;
vec_alloc (v, 2);
@ -2472,11 +2474,28 @@ build_allocator (tree type, tree init, tree result_type, Entity_Id gnat_proc,
{
lhs = build_component_ref (storage_deref, TYPE_FIELDS (storage_type),
false);
rhs = build_template (template_type, type, NULL_TREE);
rhs = build_template (template_type, type, init);
}
if (pool_is_storage_model)
storage_init = build_storage_model_store (gnat_pool, lhs, rhs);
{
storage_init = build_storage_model_store (gnat_pool, lhs, rhs);
if (init)
{
start_stmt_group ();
add_stmt (storage_init);
lhs
= build_component_ref (storage_deref,
DECL_CHAIN (TYPE_FIELDS (storage_type)),
false);
rhs = init;
size = TYPE_SIZE_UNIT (TREE_TYPE (lhs));
size = SUBSTITUTE_PLACEHOLDER_IN_EXPR (size, init);
tree t = build_storage_model_store (gnat_pool, lhs, rhs, size);
add_stmt (t);
storage_init = end_stmt_group ();
}
}
else
storage_init = build_binary_op (INIT_EXPR, NULL_TREE, lhs, rhs);
@ -2520,7 +2539,7 @@ build_allocator (tree type, tree init, tree result_type, Entity_Id gnat_proc,
TREE_THIS_NOTRAP (storage_deref) = 1;
if (pool_is_storage_model)
storage_init
= build_storage_model_store (gnat_pool, storage_deref, init);
= build_storage_model_store (gnat_pool, storage_deref, init, size);
else
storage_init
= build_binary_op (INIT_EXPR, NULL_TREE, storage_deref, init);

View File

@ -10925,7 +10925,7 @@ This switch activates warnings for conditional expressions used in
tests that are known to be True or False at compile time. The default
is that such warnings are not generated.
Note that this warning does
not get issued for the use of boolean variables or constants whose
not get issued for the use of boolean constants whose
values are known at compile time, since this is a standard technique
for conditional compilation in Ada, and this would generate too many
false positive warnings.

View File

@ -902,7 +902,7 @@ package body Ada.Numerics.Generic_Complex_Arrays is
function "-"
(Left : Real_Vector;
Right : Complex_Vector) return Complex_Vector
renames Instantiations."-";
renames Instantiations."-";
function "-"
(Left : Complex_Vector;
@ -956,7 +956,7 @@ package body Ada.Numerics.Generic_Complex_Arrays is
-----------
function "abs" (Right : Complex_Vector) return Real'Base
renames Instantiations."abs";
renames Instantiations."abs";
--------------
-- Argument --

View File

@ -135,7 +135,7 @@ package Ada.Numerics.Generic_Complex_Arrays is
function Compose_From_Cartesian (Re : Real_Matrix) return Complex_Matrix;
function Compose_From_Cartesian
(Re, Im : Real_Matrix) return Complex_Matrix;
(Re, Im : Real_Matrix) return Complex_Matrix;
function Modulus (X : Complex_Matrix) return Real_Matrix;
function "abs" (Right : Complex_Matrix) return Real_Matrix renames Modulus;
@ -229,7 +229,7 @@ package Ada.Numerics.Generic_Complex_Arrays is
function "*"
(Left : Complex;
Right : Complex_Matrix) return Complex_Matrix;
Right : Complex_Matrix) return Complex_Matrix;
function "*"
(Left : Complex_Matrix;

View File

@ -554,13 +554,18 @@ package body Ada.Tags is
-----------------------------
function Interface_Ancestor_Tags (T : Tag) return Tag_Array is
TSD_Ptr : constant Addr_Ptr :=
To_Addr_Ptr (To_Address (T) - DT_Typeinfo_Ptr_Size);
TSD : constant Type_Specific_Data_Ptr :=
To_Type_Specific_Data_Ptr (TSD_Ptr.all);
Iface_Table : constant Interface_Data_Ptr := TSD.Interfaces_Table;
TSD_Ptr : Addr_Ptr;
TSD : Type_Specific_Data_Ptr;
Iface_Table : Interface_Data_Ptr;
begin
if T = No_Tag then
raise Tag_Error;
end if;
TSD_Ptr := To_Addr_Ptr (To_Address (T) - DT_Typeinfo_Ptr_Size);
TSD := To_Type_Specific_Data_Ptr (TSD_Ptr.all);
Iface_Table := TSD.Interfaces_Table;
if Iface_Table = null then
declare
Table : Tag_Array (1 .. 0);
@ -731,7 +736,10 @@ package body Ada.Tags is
Ancestor : Tag) return Boolean
is
begin
if Descendant = Ancestor then
if Descendant = No_Tag or else Ancestor = No_Tag then
raise Tag_Error;
elsif Descendant = Ancestor then
return True;
else

View File

@ -151,7 +151,7 @@ private
Stack_Check_Probes : constant Boolean := True;
Stack_Check_Limits : constant Boolean := False;
Support_Aggregates : constant Boolean := True;
Support_Atomic_Primitives : constant Boolean := False;
Support_Atomic_Primitives : constant Boolean := True;
Support_Composite_Assign : constant Boolean := True;
Support_Composite_Compare : constant Boolean := True;
Support_Long_Shifts : constant Boolean := True;

View File

@ -148,7 +148,7 @@ private
Stack_Check_Probes : constant Boolean := True;
Stack_Check_Limits : constant Boolean := False;
Support_Aggregates : constant Boolean := True;
Support_Atomic_Primitives : constant Boolean := False;
Support_Atomic_Primitives : constant Boolean := True;
Support_Composite_Assign : constant Boolean := True;
Support_Composite_Compare : constant Boolean := True;
Support_Long_Shifts : constant Boolean := True;

View File

@ -148,7 +148,7 @@ private
Stack_Check_Probes : constant Boolean := True;
Stack_Check_Limits : constant Boolean := False;
Support_Aggregates : constant Boolean := True;
Support_Atomic_Primitives : constant Boolean := False;
Support_Atomic_Primitives : constant Boolean := True;
Support_Composite_Assign : constant Boolean := True;
Support_Composite_Compare : constant Boolean := True;
Support_Long_Shifts : constant Boolean := True;

View File

@ -146,7 +146,7 @@ private
Stack_Check_Probes : constant Boolean := True;
Stack_Check_Limits : constant Boolean := False;
Support_Aggregates : constant Boolean := True;
Support_Atomic_Primitives : constant Boolean := False;
Support_Atomic_Primitives : constant Boolean := True;
Support_Composite_Assign : constant Boolean := True;
Support_Composite_Compare : constant Boolean := True;
Support_Long_Shifts : constant Boolean := True;

View File

@ -146,6 +146,7 @@ private
Stack_Check_Probes : constant Boolean := True;
Stack_Check_Limits : constant Boolean := False;
Support_Aggregates : constant Boolean := True;
Support_Atomic_Primitives : constant Boolean := False;
Support_Composite_Assign : constant Boolean := True;
Support_Composite_Compare : constant Boolean := True;
Support_Long_Shifts : constant Boolean := True;

View File

@ -151,6 +151,7 @@ private
Stack_Check_Probes : constant Boolean := True;
Stack_Check_Limits : constant Boolean := False;
Support_Aggregates : constant Boolean := True;
Support_Atomic_Primitives : constant Boolean := False;
Support_Composite_Assign : constant Boolean := True;
Support_Composite_Compare : constant Boolean := True;
Support_Long_Shifts : constant Boolean := True;

View File

@ -148,6 +148,7 @@ private
Stack_Check_Probes : constant Boolean := True;
Stack_Check_Limits : constant Boolean := False;
Support_Aggregates : constant Boolean := True;
Support_Atomic_Primitives : constant Boolean := True;
Support_Composite_Assign : constant Boolean := True;
Support_Composite_Compare : constant Boolean := True;
Support_Long_Shifts : constant Boolean := True;

View File

@ -151,6 +151,7 @@ private
Stack_Check_Probes : constant Boolean := True;
Stack_Check_Limits : constant Boolean := False;
Support_Aggregates : constant Boolean := True;
Support_Atomic_Primitives : constant Boolean := True;
Support_Composite_Assign : constant Boolean := True;
Support_Composite_Compare : constant Boolean := True;
Support_Long_Shifts : constant Boolean := True;

View File

@ -146,7 +146,7 @@ private
Stack_Check_Probes : constant Boolean := True;
Stack_Check_Limits : constant Boolean := False;
Support_Aggregates : constant Boolean := True;
Support_Atomic_Primitives : constant Boolean := False;
Support_Atomic_Primitives : constant Boolean := True;
Support_Composite_Assign : constant Boolean := True;
Support_Composite_Compare : constant Boolean := True;
Support_Long_Shifts : constant Boolean := True;

View File

@ -149,7 +149,7 @@ private
Stack_Check_Probes : constant Boolean := True;
Stack_Check_Limits : constant Boolean := False;
Support_Aggregates : constant Boolean := True;
Support_Atomic_Primitives : constant Boolean := False;
Support_Atomic_Primitives : constant Boolean := True;
Support_Composite_Assign : constant Boolean := True;
Support_Composite_Compare : constant Boolean := True;
Support_Long_Shifts : constant Boolean := True;

View File

@ -146,7 +146,7 @@ private
Stack_Check_Probes : constant Boolean := True;
Stack_Check_Limits : constant Boolean := False;
Support_Aggregates : constant Boolean := True;
Support_Atomic_Primitives : constant Boolean := False;
Support_Atomic_Primitives : constant Boolean := True;
Support_Composite_Assign : constant Boolean := True;
Support_Composite_Compare : constant Boolean := True;
Support_Long_Shifts : constant Boolean := True;

View File

@ -149,7 +149,7 @@ private
Stack_Check_Probes : constant Boolean := True;
Stack_Check_Limits : constant Boolean := False;
Support_Aggregates : constant Boolean := True;
Support_Atomic_Primitives : constant Boolean := False;
Support_Atomic_Primitives : constant Boolean := True;
Support_Composite_Assign : constant Boolean := True;
Support_Composite_Compare : constant Boolean := True;
Support_Long_Shifts : constant Boolean := True;

View File

@ -609,6 +609,8 @@ package Rtsfind is
RE_Buffer_Type, -- Ada.Strings.Text_Buffers.Unbounded
RE_Get, -- Ada.Strings.Text_Buffers.Unbounded
RE_Wide_Get, -- Ada.Strings.Text_Buffers.Unbounded
RE_Wide_Wide_Get, -- Ada.Strings.Text_Buffers.Unbounded
RE_Wait_For_Release, -- Ada.Synchronous_Barriers
@ -2245,6 +2247,8 @@ package Rtsfind is
RE_Buffer_Type => Ada_Strings_Text_Buffers_Unbounded,
RE_Get => Ada_Strings_Text_Buffers_Unbounded,
RE_Wide_Get => Ada_Strings_Text_Buffers_Unbounded,
RE_Wide_Wide_Get => Ada_Strings_Text_Buffers_Unbounded,
RE_Wait_For_Release => Ada_Synchronous_Barriers,

View File

@ -1052,7 +1052,7 @@ package body Sem_Aggr is
elsif Is_Array_Type (Typ) and then Null_Record_Present (N) then
Error_Msg_N ("null record forbidden in array aggregate", N);
elsif Present (Find_Aspect (Typ, Aspect_Aggregate))
elsif Has_Aspect (Typ, Aspect_Aggregate)
and then Ekind (Typ) /= E_Record_Type
and then Ada_Version >= Ada_2022
then
@ -3421,6 +3421,18 @@ package body Sem_Aggr is
Analyze_And_Resolve (Base, Typ);
if Is_Array_Type (Typ) then
-- For an array_delta_aggregate, the base_expression and each
-- expression in every array_component_association shall be of a
-- nonlimited type; RM 4.3.4(13/5). However, to prevent repeated
-- errors we only check the base expression and not array component
-- associations.
if Is_Limited_Type (Etype (Base)) then
Error_Msg_N
("array delta aggregate shall be of a nonlimited type", Base);
Explain_Limited_Type (Etype (Base), Base);
end if;
Resolve_Delta_Array_Aggregate (N, Typ);
else
@ -3432,6 +3444,11 @@ package body Sem_Aggr is
("delta aggregates for record types must use (), not '[']", N);
end if;
-- The base_expression of a record_delta_aggregate can be of a
-- limited type only if it is newly constructed; RM 7.5(2.1/5).
Check_Expr_OK_In_Limited_Aggregate (Base);
Resolve_Delta_Record_Aggregate (N, Typ);
end if;
@ -3746,7 +3763,17 @@ package body Sem_Aggr is
("'<'> in record delta aggregate is not allowed", Assoc);
else
Analyze_And_Resolve (Expression (Assoc), Comp_Type);
-- The expression must not be of a limited type; RM 4.3.1(17.4/5)
if Is_Limited_Type (Etype (Expression (Assoc))) then
Error_Msg_N
("expression of a limited type in record delta aggregate " &
"is not allowed",
Expression (Assoc));
end if;
end if;
Next (Assoc);
end loop;
end Resolve_Delta_Record_Aggregate;

View File

@ -5996,8 +5996,8 @@ package body Sem_Attr is
-- Verify that prefix can be iterated upon.
if Is_Array_Type (Typ)
or else Present (Find_Aspect (Typ, Aspect_Default_Iterator))
or else Present (Find_Aspect (Typ, Aspect_Iterable))
or else Has_Aspect (Typ, Aspect_Default_Iterator)
or else Has_Aspect (Typ, Aspect_Iterable)
then
null;
else
@ -9203,13 +9203,15 @@ package body Sem_Attr is
-- Image is a scalar attribute, but is never static, because it is
-- not a static function (having a non-scalar argument (RM 4.9(22))
-- However, we can constant-fold the image of an enumeration literal
-- if names are available.
-- if names are available and default Image implementation has not
-- been overridden.
when Attribute_Image =>
if Is_Entity_Name (E1)
and then Ekind (Entity (E1)) = E_Enumeration_Literal
and then not Discard_Names (First_Subtype (Etype (E1)))
and then not Global_Discard_Names
and then not Has_Aspect (Etype (E1), Aspect_Put_Image)
then
declare
Lit : constant Entity_Id := Entity (E1);

View File

@ -11088,6 +11088,8 @@ package body Sem_Ch12 is
Set_Convention (Defining_Unit_Name (New_Spec), Convention_Intrinsic);
Copy_Ghost_Aspect (Formal, To => Decl_Node);
-- Eliminate the calls to it when optimization is enabled
Set_Is_Inlined (Defining_Unit_Name (New_Spec));
@ -17303,13 +17305,11 @@ package body Sem_Ch12 is
else
declare
Act_Iface_List : Elist_Id;
Iface : Node_Id;
Iface_Ent : Entity_Id;
Iface : Node_Id;
Iface_Ent : Entity_Id;
begin
Iface := First (Abstract_Interface_List (Formal));
Collect_Interfaces (Def_Sub, Act_Iface_List);
while Present (Iface) loop
Iface_Ent := Entity (Iface);

View File

@ -1318,7 +1318,8 @@ package body Sem_Ch3 is
Check_Restriction (No_Access_Subprograms, T_Def);
Create_Extra_Formals (Desig_Type);
-- Addition of extra formals must be delayed till the freeze point so
-- that we know the convention.
end Access_Subprogram_Declaration;
----------------------------
@ -4721,6 +4722,26 @@ package body Sem_Ch3 is
Expand_Sliding_Conversion (E, T);
end if;
if In_Spec_Expression and then In_Declare_Expr > 0 then
-- It is too early to be doing expansion-ish things,
-- so exit early. But we have to set Ekind (Id) now so
-- that subsequent uses of this entity are not rejected
-- via the same mechanism that (correctly) rejects
-- "X : Integer := X;".
if Constant_Present (N) then
Mutate_Ekind (Id, E_Constant);
Set_Is_True_Constant (Id);
else
Mutate_Ekind (Id, E_Variable);
if Present (E) then
Set_Has_Initial_Value (Id);
end if;
end if;
goto Leave;
end if;
Expand_Subtype_From_Expr
(N => N,
Unc_Type => T,
@ -11768,11 +11789,9 @@ package body Sem_Ch3 is
Insert_Before (Typ_Decl, Decl);
Analyze (Decl);
-- If an access to subprogram, create the extra formals
if Present (Acc_Def) then
Create_Extra_Formals (Designated_Type (Anon_Access));
end if;
-- At first sight we could add here the extra formals of an access to
-- subprogram; however, it must delayed till the freeze point so that
-- we know the convention.
if Nkind (Comp_Def) = N_Component_Definition then
Rewrite (Comp_Def,
@ -16033,12 +16052,12 @@ package body Sem_Ch3 is
Next_Formal (Formal);
end loop;
-- Extra formals are shared between the parent subprogram and the
-- derived subprogram (implicit in the above copy of formals), unless
-- the parent type is a limited interface type; hence we must inherit
-- also the reference to the first extra formal. When the parent type is
-- an interface the extra formals will be added when the subprogram is
-- frozen (see Freeze.Freeze_Subprogram).
-- Extra formals are shared between the parent subprogram and this
-- internal entity built by Derive_Subprogram (implicit in the above
-- copy of formals), unless the parent type is a limited interface type;
-- hence we must inherit also the reference to the first extra formal.
-- When the parent type is an interface, the extra formals will be added
-- when the tagged type is frozen (see Expand_Freeze_Record_Type).
if not Is_Limited_Interface (Parent_Type) then
Set_Extra_Formals (New_Subp, Extra_Formals (Parent_Subp));
@ -16079,7 +16098,7 @@ package body Sem_Ch3 is
Copy_Strub_Mode (New_Subp, Alias (New_Subp));
-- Derived subprograms of a tagged type must inherit the convention
-- of the parent subprogram (a requirement of AI-117). Derived
-- of the parent subprogram (a requirement of AI95-117). Derived
-- subprograms of untagged types simply get convention Ada by default.
-- If the derived type is a tagged generic formal type with unknown
@ -16497,15 +16516,15 @@ package body Sem_Ch3 is
-- Local variables
Alias_Subp : Entity_Id;
Act_List : Elist_Id;
Act_Elmt : Elmt_Id;
Act_Subp : Entity_Id := Empty;
Elmt : Elmt_Id;
Need_Search : Boolean := False;
New_Subp : Entity_Id := Empty;
Parent_Base : Entity_Id;
Subp : Entity_Id;
Alias_Subp : Entity_Id;
Act_List : Elist_Id;
Act_Elmt : Elmt_Id;
Act_Subp : Entity_Id := Empty;
Elmt : Elmt_Id;
Need_Search : Boolean := False;
New_Subp : Entity_Id;
Parent_Base : Entity_Id;
Subp : Entity_Id;
-- Start of processing for Derive_Subprograms
@ -20145,6 +20164,7 @@ package body Sem_Ch3 is
case Nkind (Original_Node (Exp)) is
when N_Aggregate
| N_Delta_Aggregate
| N_Extension_Aggregate
| N_Function_Call
| N_Op

View File

@ -1740,6 +1740,70 @@ package body Sem_Ch4 is
return;
end if;
-- 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.
-- Moreover, the type this expression must not be a character literal
-- (which is always ambiguous).
-- If error already reported by Resolve, nothing more to do
if Exp_Btype = Any_Discrete or else Exp_Btype = Any_Type then
return;
-- Special case message for character literal
elsif Exp_Btype = Any_Character then
Error_Msg_N
("character literal as case expression is ambiguous", Expr);
return;
end if;
-- If the case expression is a formal object of mode in out, then
-- treat it as having a nonstatic subtype by forcing use of the base
-- type (which has to get passed to Check_Case_Choices below). Also
-- use base type when the case expression is parenthesized.
if Paren_Count (Expr) > 0
or else (Is_Entity_Name (Expr)
and then Ekind (Entity (Expr)) = E_Generic_In_Out_Parameter)
then
Exp_Type := Exp_Btype;
end if;
-- The case expression alternatives cover the range of a static subtype
-- subject to aspect Static_Predicate. Do not check the choices when the
-- case expression has not been fully analyzed yet because this may lead
-- to bogus errors.
if Is_OK_Static_Subtype (Exp_Type)
and then Has_Static_Predicate_Aspect (Exp_Type)
and then In_Spec_Expression
then
null;
-- Call Analyze_Choices and Check_Choices to do the rest of the work
else
Analyze_Choices (Alternatives (N), Exp_Type);
Check_Choices (N, Alternatives (N), Exp_Type, Others_Present);
if Exp_Type = Universal_Integer and then not Others_Present then
Error_Msg_N
("case on universal integer requires OTHERS choice", Expr);
return;
end if;
end if;
-- RM 4.5.7(10/3): If the case_expression is the operand of a type
-- conversion, the type of the case_expression is the target type
-- of the conversion.
if Nkind (Parent (N)) = N_Type_Conversion then
Set_Etype (N, Etype (Parent (N)));
return;
end if;
-- Loop through the interpretations of the first expression and check
-- the other expressions if present.
@ -1763,25 +1827,6 @@ package body Sem_Ch4 is
end loop;
end if;
-- 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.
-- Moreover, the type this expression must not be a character literal
-- (which is always ambiguous).
-- If error already reported by Resolve, nothing more to do
if Exp_Btype = Any_Discrete or else Exp_Btype = Any_Type then
return;
-- Special casee message for character literal
elsif Exp_Btype = Any_Character then
Error_Msg_N
("character literal as case expression is ambiguous", Expr);
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.
@ -1829,43 +1874,6 @@ package body Sem_Ch4 is
Etype (Second_Expr));
end if;
end if;
return;
end if;
-- If the case expression is a formal object of mode in out, then
-- treat it as having a nonstatic subtype by forcing use of the base
-- type (which has to get passed to Check_Case_Choices below). Also
-- use base type when the case expression is parenthesized.
if Paren_Count (Expr) > 0
or else (Is_Entity_Name (Expr)
and then Ekind (Entity (Expr)) = E_Generic_In_Out_Parameter)
then
Exp_Type := Exp_Btype;
end if;
-- The case expression alternatives cover the range of a static subtype
-- subject to aspect Static_Predicate. Do not check the choices when the
-- case expression has not been fully analyzed yet because this may lead
-- to bogus errors.
if Is_OK_Static_Subtype (Exp_Type)
and then Has_Static_Predicate_Aspect (Exp_Type)
and then In_Spec_Expression
then
null;
-- Call Analyze_Choices and Check_Choices to do the rest of the work
else
Analyze_Choices (Alternatives (N), Exp_Type);
Check_Choices (N, Alternatives (N), Exp_Type, Others_Present);
if Exp_Type = Universal_Integer and then not Others_Present then
Error_Msg_N
("case on universal integer requires OTHERS choice", Expr);
end if;
end if;
end Analyze_Case_Expression;
@ -2555,6 +2563,15 @@ package body Sem_Ch4 is
Analyze_Expression (Else_Expr);
end if;
-- RM 4.5.7(10/3): If the if_expression is the operand of a type
-- conversion, the type of the if_expression is the target type
-- of the conversion.
if Nkind (Parent (N)) = N_Type_Conversion then
Set_Etype (N, Etype (Parent (N)));
return;
end if;
-- Loop through the interpretations of the THEN expression and check the
-- ELSE expression if present.
@ -4323,16 +4340,14 @@ package body Sem_Ch4 is
----------------------------------
procedure Analyze_Qualified_Expression (N : Node_Id) is
Mark : constant Entity_Id := Subtype_Mark (N);
Expr : constant Node_Id := Expression (N);
Mark : constant Entity_Id := Subtype_Mark (N);
I : Interp_Index;
It : Interp;
T : Entity_Id;
begin
Analyze_Expression (Expr);
Set_Etype (N, Any_Type);
Find_Type (Mark);
T := Entity (Mark);
@ -4353,6 +4368,8 @@ package body Sem_Ch4 is
Set_Etype (N, T);
Analyze_Expression (Expr);
if T = Any_Type then
return;
end if;
@ -4389,8 +4406,6 @@ package body Sem_Ch4 is
end loop;
end if;
end if;
Set_Etype (N, T);
end Analyze_Qualified_Expression;
-----------------------------------
@ -5950,9 +5965,9 @@ package body Sem_Ch4 is
It : Interp;
begin
Set_Etype (N, Any_Type);
Analyze_Expression (L);
Analyze_Expression (R);
Set_Etype (N, Any_Type);
if not Is_Overloaded (L) then
if Root_Type (Etype (L)) = Standard_Boolean
@ -6085,7 +6100,9 @@ package body Sem_Ch4 is
-----------------------------
procedure Analyze_Type_Conversion (N : Node_Id) is
Expr : constant Node_Id := Expression (N);
Expr : constant Node_Id := Expression (N);
Mark : constant Entity_Id := Subtype_Mark (N);
Typ : Entity_Id;
begin
@ -6102,11 +6119,13 @@ package body Sem_Ch4 is
-- Otherwise full type analysis is required, as well as some semantic
-- checks to make sure the argument of the conversion is appropriate.
Find_Type (Subtype_Mark (N));
Typ := Entity (Subtype_Mark (N));
Find_Type (Mark);
Typ := Entity (Mark);
Set_Etype (N, Typ);
Check_Fully_Declared (Typ, N);
Analyze_Expression (Expr);
Check_Fully_Declared (Typ, N);
Validate_Remote_Type_Type_Conversion (N);
-- Only remaining step is validity checks on the argument. These
@ -6229,10 +6248,12 @@ package body Sem_Ch4 is
----------------------------------
procedure Analyze_Unchecked_Expression (N : Node_Id) is
Expr : constant Node_Id := Expression (N);
begin
Analyze (Expression (N), Suppress => All_Checks);
Set_Etype (N, Etype (Expression (N)));
Save_Interps (Expression (N), N);
Analyze (Expr, Suppress => All_Checks);
Set_Etype (N, Etype (Expr));
Save_Interps (Expr, N);
end Analyze_Unchecked_Expression;
---------------------------------------
@ -6240,10 +6261,13 @@ package body Sem_Ch4 is
---------------------------------------
procedure Analyze_Unchecked_Type_Conversion (N : Node_Id) is
Expr : constant Node_Id := Expression (N);
Mark : constant Entity_Id := Subtype_Mark (N);
begin
Find_Type (Subtype_Mark (N));
Analyze_Expression (Expression (N));
Set_Etype (N, Entity (Subtype_Mark (N)));
Find_Type (Mark);
Set_Etype (N, Entity (Mark));
Analyze_Expression (Expr);
end Analyze_Unchecked_Type_Conversion;
------------------------------------

View File

@ -2191,7 +2191,7 @@ package body Sem_Ch5 is
if Is_Array_Type (Typ)
or else Is_Reversible_Iterator (Typ)
or else
(Present (Find_Aspect (Typ, Aspect_Iterable))
(Has_Aspect (Typ, Aspect_Iterable)
and then
Present
(Get_Iterable_Type_Primitive (Typ, Name_Previous)))

File diff suppressed because it is too large Load Diff

View File

@ -174,6 +174,22 @@ package Sem_Ch6 is
-- the end of Subp's parameter list (with each subsequent extra formal
-- being attached to the preceding extra formal).
function Extra_Formals_Match_OK
(E : Entity_Id;
Ref_E : Entity_Id) return Boolean;
-- Return True if the extra formals of the given entities match. E is a
-- subprogram, and Ref_E is the reference entity that will be used to check
-- the extra formals of E: a subprogram type or another subprogram. For
-- example, if E is a dispatching primitive of a tagged type then Ref_E
-- may be the overridden primitive of its parent type or its ultimate
-- renamed entity; however, if E is a subprogram to which 'Access is
-- applied then Ref_E is its corresponding subprogram type. Used in
-- assertions.
function Extra_Formals_OK (E : Entity_Id) return Boolean;
-- Return True if the decoration of the attributes associated with extra
-- formals are properly set. Used in assertions.
function Find_Corresponding_Spec
(N : Node_Id;
Post_Error : Boolean := True) return Entity_Id;
@ -197,6 +213,9 @@ package Sem_Ch6 is
-- Determines if two subtype definitions are fully conformant. Used
-- for entry family conformance checks (RM 6.3.1 (24)).
function Has_BIP_Formals (E : Entity_Id) return Boolean;
-- Determines if a given entity has build-in-place formals
procedure Install_Entity (E : Entity_Id);
-- Place a single entity on the visibility chain

View File

@ -1823,6 +1823,7 @@ package body Sem_Eval is
return False;
elsif Op = Error
or else Nkind (Op) not in N_Has_Etype
or else Etype (Op) = Any_Type
or else Raises_Constraint_Error (Op)
then

View File

@ -26201,6 +26201,20 @@ package body Sem_Prag is
Check_Postcondition_Use_In_Inlined_Subprogram (N, Spec_Id);
Set_Is_Analyzed_Pragma (N);
-- If the subprogram is frozen then its class-wide pre- and post-
-- conditions have been preanalyzed (see Merge_Class_Conditions);
-- otherwise they must be preanalyzed now to ensure the correct
-- visibility of their referenced entities. This scenario occurs
-- when the subprogram is defined in a nested package (since the
-- end of the package does not cause freezing).
if Class_Present (N)
and then Is_Dispatching_Operation (Spec_Id)
and then not Is_Frozen (Spec_Id)
then
Preanalyze_Class_Conditions (Spec_Id);
end if;
Restore_Ghost_Region (Saved_GM, Saved_IGR);
end Analyze_Pre_Post_Condition_In_Decl_Part;

View File

@ -171,6 +171,13 @@ package body Sem_Res is
-- of the task, it must be replaced with a reference to the discriminant
-- of the task being called.
procedure Resolve_Dependent_Expression
(N : Node_Id;
Expr : Node_Id;
Typ : Entity_Id);
-- Internal procedure to resolve the dependent expression Expr of the
-- conditional expression N with type Typ.
procedure Resolve_Op_Concat_Arg
(N : Node_Id;
Arg : Node_Id;
@ -291,12 +298,6 @@ package body Sem_Res is
-- Called after N has been resolved and evaluated, but before range checks
-- have been applied. This rewrites the conversion into a simpler form.
function Unique_Fixed_Point_Type (N : Node_Id) return Entity_Id;
-- A universal_fixed expression in an universal context is unambiguous if
-- there is only one applicable fixed point type. Determining whether there
-- is only one requires a search over all visible entities, and happens
-- only in very pathological cases (see 6115-006).
function Try_User_Defined_Literal
(N : Node_Id;
Typ : Entity_Id) return Boolean;
@ -306,6 +307,12 @@ package body Sem_Res is
-- If such aspect exists, replace literal with a call to the
-- corresponding function and return True, return false otherwise.
function Unique_Fixed_Point_Type (N : Node_Id) return Entity_Id;
-- A universal_fixed expression in an universal context is unambiguous if
-- there is only one applicable fixed point type. Determining whether there
-- is only one requires a search over all visible entities, and happens
-- only in very pathological cases (see 6115-006).
-------------------------
-- Ambiguous_Character --
-------------------------
@ -2461,6 +2468,15 @@ package body Sem_Res is
Found := True;
Expr_Type := Etype (Expression (N));
-- The resolution of a conditional expression that is the operand of a
-- type conversion is determined by the conversion (RM 4.5.7(10/3)).
elsif Nkind (N) in N_Case_Expression | N_If_Expression
and then Nkind (Parent (N)) = N_Type_Conversion
then
Found := True;
Expr_Type := Etype (Parent (N));
-- If not overloaded, then we know the type, and all that needs doing
-- is to check that this type is compatible with the context.
@ -7390,7 +7406,8 @@ package body Sem_Res is
return;
end if;
Resolve (Alt_Expr, Typ);
Resolve_Dependent_Expression (N, Alt_Expr, Typ);
Check_Unset_Reference (Alt_Expr);
Alt_Typ := Etype (Alt_Expr);
@ -7671,6 +7688,34 @@ package body Sem_Res is
Check_Unset_Reference (Expr);
end Resolve_Declare_Expression;
-----------------------------------
-- Resolve_Dependent_Expression --
-----------------------------------
procedure Resolve_Dependent_Expression
(N : Node_Id;
Expr : Node_Id;
Typ : Entity_Id)
is
begin
-- RM 4.5.7(8/3) says that the expected type of dependent expressions is
-- that of the conditional expression but RM 4.5.7(10/3) forces the type
-- of the conditional expression without changing the expected type (the
-- expected type of the operand of a type conversion is any type), so we
-- may have a gap between these two types that is bridged by the dynamic
-- semantics specified by RM 4.5.7(20/3) with the associated legality
-- rule RM 4.5.7(16/3) that will be automatically enforced.
if Nkind (Parent (N)) = N_Type_Conversion
and then Nkind (Expr) /= N_Raise_Expression
then
Convert_To_And_Rewrite (Typ, Expr);
Analyze_And_Resolve (Expr);
else
Resolve (Expr, Typ);
end if;
end Resolve_Dependent_Expression;
-----------------------------------------
-- Resolve_Discrete_Subtype_Indication --
-----------------------------------------
@ -9307,7 +9352,9 @@ package body Sem_Res is
---------------------------
procedure Resolve_If_Expression (N : Node_Id; Typ : Entity_Id) is
procedure Apply_Check (Expr : Node_Id);
Condition : constant Node_Id := First (Expressions (N));
procedure Apply_Check (Expr : Node_Id; Result_Type : Entity_Id);
-- When a dependent expression is of a subtype different from
-- the context subtype, then insert a qualification to ensure
-- the generation of a constraint check. This was previously
@ -9315,21 +9362,11 @@ package body Sem_Res is
-- that the context in general allows sliding, while a qualified
-- expression forces equality of bounds.
Result_Type : Entity_Id := Typ;
-- So in most cases the type of the If_Expression and of its
-- dependent expressions is that of the context. However, if
-- the expression is the index of an Indexed_Component, we must
-- ensure that a proper index check is applied, rather than a
-- range check on the index type (which might be discriminant
-- dependent). In this case we resolve with the base type of the
-- index type, and the index check is generated in the resolution
-- of the indexed_component above.
-----------------
-- Apply_Check --
-----------------
procedure Apply_Check (Expr : Node_Id) is
procedure Apply_Check (Expr : Node_Id; Result_Type : Entity_Id) is
Expr_Typ : constant Entity_Id := Etype (Expr);
Loc : constant Source_Ptr := Sloc (Expr);
@ -9357,10 +9394,19 @@ package body Sem_Res is
-- Local variables
Condition : constant Node_Id := First (Expressions (N));
Else_Expr : Node_Id;
Then_Expr : Node_Id;
Result_Type : Entity_Id;
-- So in most cases the type of the if_expression and of its
-- dependent expressions is that of the context. However, if
-- the expression is the index of an Indexed_Component, we must
-- ensure that a proper index check is applied, rather than a
-- range check on the index type (which might be discriminant
-- dependent). In this case we resolve with the base type of the
-- index type, and the index check is generated in the resolution
-- of the indexed_component above.
-- Start of processing for Resolve_If_Expression
begin
@ -9375,6 +9421,9 @@ package body Sem_Res is
or else Nkind (Parent (Parent (N))) = N_Indexed_Component)
then
Result_Type := Base_Type (Typ);
else
Result_Type := Typ;
end if;
Then_Expr := Next (Condition);
@ -9383,32 +9432,23 @@ package body Sem_Res is
return;
end if;
Resolve (Condition, Any_Boolean);
Check_Unset_Reference (Condition);
Resolve_Dependent_Expression (N, Then_Expr, Result_Type);
Check_Unset_Reference (Then_Expr);
Apply_Check (Then_Expr, Result_Type);
Else_Expr := Next (Then_Expr);
Resolve (Condition, Any_Boolean);
Resolve (Then_Expr, Result_Type);
Check_Unset_Reference (Condition);
Check_Unset_Reference (Then_Expr);
Apply_Check (Then_Expr);
-- If ELSE expression present, just resolve using the determined type
-- If type is universal, resolve to any member of the class.
if Present (Else_Expr) then
if Typ = Universal_Integer then
Resolve (Else_Expr, Any_Integer);
elsif Typ = Universal_Real then
Resolve (Else_Expr, Any_Real);
else
Resolve (Else_Expr, Result_Type);
end if;
Resolve_Dependent_Expression (N, Else_Expr, Result_Type);
Check_Unset_Reference (Else_Expr);
Apply_Check (Else_Expr);
Apply_Check (Else_Expr, Result_Type);
-- Apply RM 4.5.7 (17/3): whether the expression is statically or
-- dynamically tagged must be known statically.
@ -12169,6 +12209,12 @@ package body Sem_Res is
then
null;
-- Never give a warning if the operand is a conditional expression
-- because RM 4.5.7(10/3) forces its type to be the target type.
elsif Nkind (Orig_N) in N_Case_Expression | N_If_Expression then
null;
-- Finally, if this type conversion occurs in a context requiring
-- a prefix, and the expression is a qualified expression then the
-- type conversion is not redundant, since a qualified expression

View File

@ -1007,7 +1007,7 @@ package body Sem_Type is
elsif Ada_Version >= Ada_2022
and then T2 = Any_Composite
and then Present (Find_Aspect (T1, Aspect_Aggregate))
and then Has_Aspect (T1, Aspect_Aggregate)
then
return True;

View File

@ -13309,7 +13309,7 @@ package body Sem_Util is
begin
return Nkind (Exp) = N_Aggregate
and then Present (Find_Aspect (Etype (Exp), Aspect_Aggregate))
and then Has_Aspect (Etype (Exp), Aspect_Aggregate)
and then not Is_Record_Aggregate;
end Is_Container_Aggregate;
@ -21718,18 +21718,16 @@ package body Sem_Util is
-- type has the appropriate user-defined literal aspect.
return (Nkind (N) in N_Numeric_Or_String_Literal
and then Present (Find_Aspect (Typ, Literal_Aspect_Map (Nkind (N)))))
and then Has_Aspect (Typ, Literal_Aspect_Map (Nkind (N))))
or else
(Is_Entity_Name (N)
and then Present (Entity (N))
and then
((Ekind (Entity (N)) = E_Named_Integer
and then
Present (Find_Aspect (Typ, Aspect_Integer_Literal)))
and then Has_Aspect (Typ, Aspect_Integer_Literal))
or else
(Ekind (Entity (N)) = E_Named_Real
and then
Present (Find_Aspect (Typ, Aspect_Real_Literal)))));
and then Has_Aspect (Typ, Aspect_Real_Literal))));
end Is_User_Defined_Literal;
--------------------------------------
@ -23312,9 +23310,12 @@ package body Sem_Util is
return Present (Extra_Accessibility_Of_Result (Alias (Func_Id)));
-- Remaining cases require Ada 2012 mode
-- Remaining cases require Ada 2012 mode, unless they are dispatching
-- operations, since they may be overridden by Ada_2012 primitives.
elsif Ada_Version < Ada_2012 then
elsif Ada_Version < Ada_2012
and then not Is_Dispatching_Operation (Func_Id)
then
return False;
-- Handle the situation where a result is an anonymous access type
@ -32560,7 +32561,7 @@ package body Sem_Util is
(Typ : Entity_Id) return Boolean
is
begin
return Present (Find_Aspect (Typ, Aspect_Designated_Storage_Model));
return Has_Aspect (Typ, Aspect_Designated_Storage_Model);
end Has_Designated_Storage_Model_Aspect;
-----------------------------------
@ -32570,7 +32571,7 @@ package body Sem_Util is
function Has_Storage_Model_Type_Aspect (Typ : Entity_Id) return Boolean
is
begin
return Present (Find_Aspect (Typ, Aspect_Storage_Model_Type));
return Has_Aspect (Typ, Aspect_Storage_Model_Type);
end Has_Storage_Model_Type_Aspect;
--------------------------

View File

@ -28,7 +28,6 @@
-- circularities, especially for back ends using Adabkend.
with Debug; use Debug;
with Errout; use Errout;
with Lib; use Lib;
with Osint; use Osint;
with Opt; use Opt;

View File

@ -567,6 +567,10 @@ begin
"record types");
Write_Line (" .Q* turn off warnings for questionable layout of " &
"record types");
Write_Line (" _q turn on warnings for ignored " &
"equality operators");
Write_Line (" _Q* turn off warnings for ignored " &
"equality operators");
Write_Line (" r+ turn on warnings for redundant construct");
Write_Line (" R* turn off warnings for redundant construct");
Write_Line (" .r+ turn on warnings for object renaming function");

View File

@ -23,7 +23,6 @@
-- --
------------------------------------------------------------------------------
with Err_Vars; use Err_Vars;
with Opt; use Opt;
with Output; use Output;

View File

@ -38,6 +38,15 @@ package Warnsw is
-- here as time goes by. And in fact a really nice idea would be to put
-- them all in a Warn_Record so that they would be easy to save/restore.
Warning_Doc_Switch : Boolean := True;
-- If this is set True, then the ??/?*?/?$?/?x?/?.x?/?_x? insertion
-- sequences in error messages generate appropriate tags for the output
-- error messages. If this switch is False, then these sequences are still
-- recognized (for the purposes of implementing the pattern matching in
-- pragmas Warnings (Off,..) and Warning_As_Error(...) but do not result
-- in adding the error message tag. The -gnatw.d switch sets this flag
-- True, -gnatw.D sets this flag False.
Warn_On_Anonymous_Allocators : Boolean := False;
-- Warn when allocators for anonymous access types are present, which,
-- although not illegal in Ada, may be confusing to users due to how
@ -71,7 +80,9 @@ package Warnsw is
-- efficiency reasons and would be improved by reordering the components.
-- Off by default, modified by use of -gnatw.q/.Q (but not -gnatwa).
-- WARNING: There is a matching C declaration of this variable in fe.h
function Get_Warn_On_Questionable_Layout return Boolean is
(Warn_On_Questionable_Layout);
-- WARNING: There is a matching C declaration of this function in fe.h
Warn_On_Record_Holes : Boolean := False;
-- Warn when explicit record component clauses leave uncovered holes (gaps)

View File

@ -141,24 +141,15 @@ call_info::call_info (const call_details &cd)
gcc_assert (m_fndecl);
}
/* class success_call_info : public call_info. */
/* Implementation of call_info::get_desc vfunc for success_call_info. */
/* class succeed_or_fail_call_info : public call_info. */
label_text
success_call_info::get_desc (bool can_colorize) const
succeed_or_fail_call_info::get_desc (bool can_colorize) const
{
return make_label_text (can_colorize, "when %qE succeeds", get_fndecl ());
}
/* class failed_call_info : public call_info. */
/* Implementation of call_info::get_desc vfunc for failed_call_info. */
label_text
failed_call_info::get_desc (bool can_colorize) const
{
return make_label_text (can_colorize, "when %qE fails", get_fndecl ());
if (m_success)
return make_label_text (can_colorize, "when %qE succeeds", get_fndecl ());
else
return make_label_text (can_colorize, "when %qE fails", get_fndecl ());
}
} // namespace ana

View File

@ -51,17 +51,36 @@ private:
};
/* Subclass of call_info for a "success" outcome of a call,
adding a "when `FNDECL' succeeds" message.
adding either a
"when `FNDECL' succeeds" message (when 'success' is true)
or a
"when `FNDECL' fails" message (when 'success' is false).
This is still abstract: the custom_edge_info::update_model vfunc
must be implemented. */
class success_call_info : public call_info
class succeed_or_fail_call_info : public call_info
{
public:
label_text get_desc (bool can_colorize) const final override;
protected:
success_call_info (const call_details &cd) : call_info (cd) {}
succeed_or_fail_call_info (const call_details &cd, bool success)
: call_info (cd), m_success (success) {}
bool m_success;
};
/* Subclass of call_info for a "success" outcome of a call,
adding a "when `FNDECL' succeeds" message.
This is still abstract: the custom_edge_info::update_model vfunc
must be implemented. */
class success_call_info : public succeed_or_fail_call_info
{
protected:
success_call_info (const call_details &cd)
: succeed_or_fail_call_info (cd, true)
{}
};
/* Subclass of call_info for a "failure" outcome of a call,
@ -69,13 +88,12 @@ protected:
This is still abstract: the custom_edge_info::update_model vfunc
must be implemented. */
class failed_call_info : public call_info
class failed_call_info : public succeed_or_fail_call_info
{
public:
label_text get_desc (bool can_colorize) const final override;
protected:
failed_call_info (const call_details &cd) : call_info (cd) {}
failed_call_info (const call_details &cd)
: succeed_or_fail_call_info (cd, false)
{}
};
} // namespace ana

View File

@ -413,6 +413,20 @@ region_model::impl_call_calloc (const call_details &cd)
}
}
/* Handle the on_call_pre part of "__errno_location". */
void
region_model::impl_call_errno_location (const call_details &cd)
{
if (cd.get_lhs_region ())
{
const region *errno_reg = m_mgr->get_errno_region ();
const svalue *errno_ptr = m_mgr->get_ptr_svalue (cd.get_lhs_type (),
errno_reg);
cd.maybe_set_lhs (errno_ptr);
}
}
/* Handle the on_call_pre part of "error" and "error_at_line" from
GNU's non-standard <error.h>.
MIN_ARGS identifies the minimum number of expected arguments
@ -1013,7 +1027,7 @@ region_model::impl_call_realloc (const call_details &cd)
}
}
/* Handle the on_call_pre part of "strchr" and "__builtin_strchr". */
/* Handle the on_call_post part of "strchr" and "__builtin_strchr". */
void
region_model::impl_call_strchr (const call_details &cd)
@ -1075,13 +1089,13 @@ region_model::impl_call_strchr (const call_details &cd)
bool m_found;
};
/* Bifurcate state, creating a "not found" out-edge. */
/* Body of region_model::impl_call_strchr. */
if (cd.get_ctxt ())
cd.get_ctxt ()->bifurcate (make_unique<strchr_call_info> (cd, false));
/* The "unbifurcated" state is the "found" case. */
strchr_call_info found (cd, true);
found.update_model (this, NULL, cd.get_ctxt ());
{
cd.get_ctxt ()->bifurcate (make_unique<strchr_call_info> (cd, false));
cd.get_ctxt ()->bifurcate (make_unique<strchr_call_info> (cd, true));
cd.get_ctxt ()->terminate_path ();
}
}
/* Handle the on_call_pre part of "strcpy" and "__builtin_strcpy_chk". */

View File

@ -74,6 +74,8 @@ region_model_manager::region_model_manager (logger *logger)
m_fndecls_map (), m_labels_map (),
m_globals_region (alloc_region_id (), &m_root_region),
m_globals_map (),
m_thread_local_region (alloc_region_id (), &m_root_region),
m_errno_region (alloc_region_id (), &m_thread_local_region),
m_store_mgr (this),
m_range_mgr (new bounded_ranges_manager ()),
m_known_fn_mgr (logger)

View File

@ -107,6 +107,7 @@ public:
{
return &m_globals_region;
}
const errno_region *get_errno_region () const { return &m_errno_region; }
const function_region *get_region_for_fndecl (tree fndecl);
const label_region *get_region_for_label (tree label);
const decl_region *get_region_for_global (tree expr);
@ -287,6 +288,9 @@ private:
typedef globals_map_t::iterator globals_iterator_t;
globals_map_t m_globals_map;
thread_local_region m_thread_local_region;
errno_region m_errno_region;
consolidation_map<field_region> m_field_regions;
consolidation_map<element_region> m_element_regions;
consolidation_map<offset_region> m_offset_regions;

View File

@ -2223,7 +2223,7 @@ region_model::on_call_pre (const gcall *call, region_model_context *ctxt,
case BUILT_IN_REALLOC:
return false;
case BUILT_IN_STRCHR:
impl_call_strchr (cd);
/* Handle in "on_call_post". */
return false;
case BUILT_IN_STRCPY:
case BUILT_IN_STRCPY_CHK:
@ -2288,6 +2288,11 @@ region_model::on_call_pre (const gcall *call, region_model_context *ctxt,
impl_call_realloc (cd);
return false;
}
else if (is_named_call_p (callee_fndecl, "__errno_location", call, 0))
{
impl_call_errno_location (cd);
return false;
}
else if (is_named_call_p (callee_fndecl, "error"))
{
if (impl_call_error (cd, 3, out_terminate_path))
@ -2341,7 +2346,7 @@ region_model::on_call_pre (const gcall *call, region_model_context *ctxt,
else if (is_named_call_p (callee_fndecl, "strchr", call, 2)
&& POINTER_TYPE_P (cd.get_arg_type (0)))
{
impl_call_strchr (cd);
/* Handle in "on_call_post". */
return false;
}
else if (is_named_call_p (callee_fndecl, "strlen", call, 1)
@ -2418,6 +2423,12 @@ region_model::on_call_post (const gcall *call,
impl_call_pipe (cd);
return;
}
else if (is_named_call_p (callee_fndecl, "strchr", call, 2)
&& POINTER_TYPE_P (cd.get_arg_type (0)))
{
impl_call_strchr (cd);
return;
}
/* Was this fndecl referenced by
__attribute__((malloc(FOO)))? */
if (lookup_attribute ("*dealloc", DECL_ATTRIBUTES (callee_fndecl)))
@ -2435,6 +2446,10 @@ region_model::on_call_post (const gcall *call,
impl_call_realloc (cd);
return;
case BUILT_IN_STRCHR:
impl_call_strchr (cd);
return;
case BUILT_IN_VA_END:
impl_call_va_end (cd);
return;
@ -6408,6 +6423,23 @@ region_model::maybe_complain_about_infoleak (const region *dst_reg,
copied_sval));
}
/* Set errno to a positive symbolic int, as if some error has occurred. */
void
region_model::set_errno (const call_details &cd)
{
const region *errno_reg = m_mgr->get_errno_region ();
conjured_purge p (this, cd.get_ctxt ());
const svalue *new_errno_sval
= m_mgr->get_or_create_conjured_svalue (integer_type_node,
cd.get_call_stmt (),
errno_reg, p);
const svalue *zero
= m_mgr->get_or_create_int_cst (integer_type_node, 0);
add_constraint (new_errno_sval, GT_EXPR, zero, cd.get_ctxt ());
set_value (errno_reg, new_errno_sval, cd.get_ctxt ());
}
/* class noop_region_model_context : public region_model_context. */
void

View File

@ -349,6 +349,7 @@ class region_model
void impl_call_analyzer_get_unknown_ptr (const call_details &cd);
void impl_call_builtin_expect (const call_details &cd);
void impl_call_calloc (const call_details &cd);
void impl_call_errno_location (const call_details &cd);
bool impl_call_error (const call_details &cd, unsigned min_args,
bool *out_terminate_path);
void impl_call_fgets (const call_details &cd);
@ -544,6 +545,8 @@ class region_model
const region *src_reg,
region_model_context *ctxt);
void set_errno (const call_details &cd);
/* Implemented in sm-fd.cc */
void mark_as_valid_fd (const svalue *sval, region_model_context *ctxt);

View File

@ -1050,6 +1050,17 @@ root_region::dump_to_pp (pretty_printer *pp, bool simple) const
pp_string (pp, "root_region()");
}
/* class thread_local_region : public space_region. */
void
thread_local_region::dump_to_pp (pretty_printer *pp, bool simple) const
{
if (simple)
pp_string (pp, "thread_local_region");
else
pp_string (pp, "thread_local_region()");
}
/* class symbolic_region : public map_region. */
/* symbolic_region's ctor. */
@ -1811,6 +1822,17 @@ var_arg_region::get_frame_region () const
return as_a <const frame_region *> (get_parent_region ());
}
/* class errno_region : public region. */
void
errno_region::dump_to_pp (pretty_printer *pp, bool simple) const
{
if (simple)
pp_string (pp, "errno_region");
else
pp_string (pp, "errno_region()");
}
/* class unknown_region : public region. */
/* Implementation of region::dump_to_pp vfunc for unknown_region. */

View File

@ -34,7 +34,8 @@ enum memory_space
MEMSPACE_GLOBALS,
MEMSPACE_STACK,
MEMSPACE_HEAP,
MEMSPACE_READONLY_DATA
MEMSPACE_READONLY_DATA,
MEMSPACE_THREAD_LOCAL
};
/* An enum for discriminating between the different concrete subclasses
@ -49,6 +50,7 @@ enum region_kind
RK_LABEL,
RK_STACK,
RK_HEAP,
RK_THREAD_LOCAL,
RK_ROOT,
RK_SYMBOLIC,
RK_DECL,
@ -62,6 +64,7 @@ enum region_kind
RK_STRING,
RK_BIT_RANGE,
RK_VAR_ARG,
RK_ERRNO,
RK_UNKNOWN,
};
@ -77,6 +80,8 @@ enum region_kind
code_region (RK_CODE): represents the code segment, containing functions
stack_region (RK_STACK): a stack, containing all stack frames
heap_region (RK_HEAP): the heap, containing heap_allocated_regions
thread_local_region (RK_THREAD_LOCAL): thread-local data for the thread
being analyzed
root_region (RK_ROOT): the top-level region
function_region (RK_FUNCTION): the code for a particular function
label_region (RK_LABEL): a particular label within a function
@ -102,6 +107,7 @@ enum region_kind
within another region
var_arg_region (RK_VAR_ARG): a region for the N-th vararg within a
frame_region for a variadic call
errno_region (RK_ERRNO): a region for holding "errno"
unknown_region (RK_UNKNOWN): for handling unimplemented tree codes. */
/* Abstract base class for representing ways of accessing chunks of memory.
@ -555,6 +561,32 @@ is_a_helper <const heap_region *>::test (const region *reg)
namespace ana {
/* Concrete space_region subclass: thread-local data for the thread
being analyzed. */
class thread_local_region : public space_region
{
public:
thread_local_region (unsigned id, region *parent)
: space_region (id, parent)
{}
enum region_kind get_kind () const final override { return RK_THREAD_LOCAL; }
void dump_to_pp (pretty_printer *pp, bool simple) const final override;
};
} // namespace ana
template <>
template <>
inline bool
is_a_helper <const thread_local_region *>::test (const region *reg)
{
return reg->get_kind () == RK_THREAD_LOCAL;
}
namespace ana {
/* Concrete region subclass. The root region, containing all regions
(either directly, or as descendents).
Unique within a region_model_manager. */
@ -1362,6 +1394,32 @@ template <> struct default_hash_traits<var_arg_region::key_t>
namespace ana {
/* A region for errno for the current thread. */
class errno_region : public region
{
public:
errno_region (unsigned id, const thread_local_region *parent)
: region (complexity (parent), id, parent, integer_type_node)
{}
enum region_kind get_kind () const final override { return RK_ERRNO; }
void dump_to_pp (pretty_printer *pp, bool simple) const final override;
};
} // namespace ana
template <>
template <>
inline bool
is_a_helper <const errno_region *>::test (const region *reg)
{
return reg->get_kind () == RK_ERRNO;
}
namespace ana {
/* An unknown region, for handling unimplemented tree codes. */
class unknown_region : public region

View File

@ -2036,6 +2036,17 @@ binding_cluster::on_asm (const gasm *stmt,
m_touched = true;
}
/* Return true if this cluster has escaped. */
bool
binding_cluster::escaped_p () const
{
/* Consider the "errno" region to always have escaped. */
if (m_base_region->get_kind () == RK_ERRNO)
return true;
return m_escaped;
}
/* Return true if this binding_cluster has no information
i.e. if there are no bindings, and it hasn't been marked as having
escaped, or touched symbolically. */
@ -2946,6 +2957,10 @@ store::escaped_p (const region *base_reg) const
gcc_assert (base_reg);
gcc_assert (base_reg->get_base_region () == base_reg);
/* "errno" can always be modified by external code. */
if (base_reg->get_kind () == RK_ERRNO)
return true;
if (binding_cluster **cluster_slot
= const_cast <cluster_map_t &>(m_cluster_map).get (base_reg))
return (*cluster_slot)->escaped_p ();
@ -3192,6 +3207,7 @@ store::replay_call_summary_cluster (call_summary_replay &r,
case RK_CODE:
case RK_STACK:
case RK_HEAP:
case RK_THREAD_LOCAL:
case RK_ROOT:
/* Child regions. */
case RK_FIELD:
@ -3242,6 +3258,7 @@ store::replay_call_summary_cluster (call_summary_replay &r,
case RK_HEAP_ALLOCATED:
case RK_DECL:
case RK_ERRNO:
{
const region *caller_dest_reg
= r.convert_region_from_summary (summary_base_reg);

View File

@ -644,7 +644,7 @@ public:
void on_asm (const gasm *stmt, store_manager *mgr,
const conjured_purge &p);
bool escaped_p () const { return m_escaped; }
bool escaped_p () const;
bool touched_p () const { return m_touched; }
bool redundant_p () const;

View File

@ -1731,7 +1731,6 @@ handle_attr_preserve (function *fn)
{
basic_block bb;
rtx_insn *insn;
rtx_code_label *label;
FOR_EACH_BB_FN (bb, fn)
{
FOR_BB_INSNS (bb, insn)
@ -1762,28 +1761,7 @@ handle_attr_preserve (function *fn)
}
if (is_attr_preserve_access (expr))
{
auto_vec<unsigned int, 16> accessors;
tree container = bpf_core_compute (expr, &accessors);
if (accessors.length () < 1)
continue;
accessors.reverse ();
container = TREE_TYPE (container);
const char * section_name;
if (DECL_SECTION_NAME (fn->decl))
section_name = DECL_SECTION_NAME (fn->decl);
else
section_name = ".text";
label = gen_label_rtx ();
LABEL_PRESERVE_P (label) = 1;
emit_label (label);
/* Add the CO-RE relocation information to the BTF container. */
bpf_core_reloc_add (container, section_name, &accessors, label,
BPF_RELO_FIELD_BYTE_OFFSET);
}
maybe_make_core_relo (expr, BPF_RELO_FIELD_BYTE_OFFSET);
}
}
rtx_insn *seq = get_insns ();

View File

@ -4510,15 +4510,86 @@ ix86_expand_int_sse_cmp (rtx dest, enum rtx_code code, rtx cop0, rtx cop1,
case GTU:
break;
case NE:
case LE:
case LEU:
/* x <= cst can be handled as x < cst + 1 unless there is
wrap around in cst + 1. */
if (GET_CODE (cop1) == CONST_VECTOR
&& GET_MODE_INNER (mode) != TImode)
{
unsigned int n_elts = GET_MODE_NUNITS (mode), i;
machine_mode eltmode = GET_MODE_INNER (mode);
for (i = 0; i < n_elts; ++i)
{
rtx elt = CONST_VECTOR_ELT (cop1, i);
if (!CONST_INT_P (elt))
break;
if (code == GE)
{
/* For LE punt if some element is signed maximum. */
if ((INTVAL (elt) & (GET_MODE_MASK (eltmode) >> 1))
== (GET_MODE_MASK (eltmode) >> 1))
break;
}
/* For LEU punt if some element is unsigned maximum. */
else if (elt == constm1_rtx)
break;
}
if (i == n_elts)
{
rtvec v = rtvec_alloc (n_elts);
for (i = 0; i < n_elts; ++i)
RTVEC_ELT (v, i)
= GEN_INT (INTVAL (CONST_VECTOR_ELT (cop1, i)) + 1);
cop1 = gen_rtx_CONST_VECTOR (mode, v);
std::swap (cop0, cop1);
code = code == LE ? GT : GTU;
break;
}
}
/* FALLTHRU */
case NE:
code = reverse_condition (code);
*negate = true;
break;
case GE:
case GEU:
/* x >= cst can be handled as x > cst - 1 unless there is
wrap around in cst - 1. */
if (GET_CODE (cop1) == CONST_VECTOR
&& GET_MODE_INNER (mode) != TImode)
{
unsigned int n_elts = GET_MODE_NUNITS (mode), i;
machine_mode eltmode = GET_MODE_INNER (mode);
for (i = 0; i < n_elts; ++i)
{
rtx elt = CONST_VECTOR_ELT (cop1, i);
if (!CONST_INT_P (elt))
break;
if (code == GE)
{
/* For GE punt if some element is signed minimum. */
if (INTVAL (elt) < 0
&& ((INTVAL (elt) & (GET_MODE_MASK (eltmode) >> 1))
== 0))
break;
}
/* For GEU punt if some element is zero. */
else if (elt == const0_rtx)
break;
}
if (i == n_elts)
{
rtvec v = rtvec_alloc (n_elts);
for (i = 0; i < n_elts; ++i)
RTVEC_ELT (v, i)
= GEN_INT (INTVAL (CONST_VECTOR_ELT (cop1, i)) - 1);
cop1 = gen_rtx_CONST_VECTOR (mode, v);
code = code == GE ? GT : GTU;
break;
}
}
code = reverse_condition (code);
*negate = true;
/* FALLTHRU */
@ -4556,6 +4627,11 @@ ix86_expand_int_sse_cmp (rtx dest, enum rtx_code code, rtx cop0, rtx cop1,
}
}
if (GET_CODE (cop0) == CONST_VECTOR)
cop0 = force_reg (mode, cop0);
else if (GET_CODE (cop1) == CONST_VECTOR)
cop1 = force_reg (mode, cop1);
rtx optrue = op_true ? op_true : CONSTM1_RTX (data_mode);
rtx opfalse = op_false ? op_false : CONST0_RTX (data_mode);
if (*negate)
@ -4752,13 +4828,13 @@ ix86_expand_int_sse_cmp (rtx dest, enum rtx_code code, rtx cop0, rtx cop1,
if (*negate)
std::swap (op_true, op_false);
if (GET_CODE (cop1) == CONST_VECTOR)
cop1 = force_reg (mode, cop1);
/* Allow the comparison to be done in one mode, but the movcc to
happen in another mode. */
if (data_mode == mode)
{
x = ix86_expand_sse_cmp (dest, code, cop0, cop1,
op_true, op_false);
}
x = ix86_expand_sse_cmp (dest, code, cop0, cop1, op_true, op_false);
else
{
gcc_assert (GET_MODE_SIZE (data_mode) == GET_MODE_SIZE (mode));

View File

@ -139,6 +139,7 @@ along with GCC; see the file COPYING3. If not see
#define m_TREMONT (HOST_WIDE_INT_1U<<PROCESSOR_TREMONT)
#define m_SIERRAFOREST (HOST_WIDE_INT_1U<<PROCESSOR_SIERRAFOREST)
#define m_GRANDRIDGE (HOST_WIDE_INT_1U<<PROCESSOR_GRANDRIDGE)
#define m_CORE_ATOM (m_SIERRAFOREST | m_GRANDRIDGE)
#define m_INTEL (HOST_WIDE_INT_1U<<PROCESSOR_INTEL)
#define m_LUJIAZUI (HOST_WIDE_INT_1U<<PROCESSOR_LUJIAZUI)

View File

@ -1246,7 +1246,3 @@ Support PREFETCHI built-in functions and code generation.
mraoint
Target Mask(ISA2_RAOINT) Var(ix86_isa_flags2) Save
Support RAOINT built-in functions and code generation.
mprefer-remote-atomic
Target Var(flag_prefer_remote_atomic) Init(0)
Prefer use remote atomic insn for atomic operations.

View File

@ -1235,6 +1235,13 @@
(ior (match_operand 0 "register_operand")
(match_operand 0 "vector_memory_operand")))
; Return true when OP is register_operand, vector_memory_operand
; or const_vector.
(define_predicate "vector_or_const_vector_operand"
(ior (match_operand 0 "register_operand")
(match_operand 0 "vector_memory_operand")
(match_code "const_vector")))
(define_predicate "bcst_mem_operand"
(and (match_code "vec_duplicate")
(and (match_test "TARGET_AVX512F")

View File

@ -4311,7 +4311,7 @@
[(set (match_operand:<sseintvecmode> 0 "register_operand")
(match_operator:<sseintvecmode> 1 ""
[(match_operand:VI_256 2 "register_operand")
(match_operand:VI_256 3 "nonimmediate_operand")]))]
(match_operand:VI_256 3 "nonimmediate_or_const_vector_operand")]))]
"TARGET_AVX2"
{
bool ok = ix86_expand_int_vec_cmp (operands);
@ -4323,7 +4323,7 @@
[(set (match_operand:<sseintvecmode> 0 "register_operand")
(match_operator:<sseintvecmode> 1 ""
[(match_operand:VI124_128 2 "register_operand")
(match_operand:VI124_128 3 "vector_operand")]))]
(match_operand:VI124_128 3 "vector_or_const_vector_operand")]))]
"TARGET_SSE2"
{
bool ok = ix86_expand_int_vec_cmp (operands);
@ -4335,7 +4335,7 @@
[(set (match_operand:V2DI 0 "register_operand")
(match_operator:V2DI 1 ""
[(match_operand:V2DI 2 "register_operand")
(match_operand:V2DI 3 "vector_operand")]))]
(match_operand:V2DI 3 "vector_or_const_vector_operand")]))]
"TARGET_SSE4_2"
{
bool ok = ix86_expand_int_vec_cmp (operands);
@ -4397,7 +4397,7 @@
[(set (match_operand:<sseintvecmode> 0 "register_operand")
(match_operator:<sseintvecmode> 1 ""
[(match_operand:VI_256 2 "register_operand")
(match_operand:VI_256 3 "nonimmediate_operand")]))]
(match_operand:VI_256 3 "nonimmediate_or_const_vector_operand")]))]
"TARGET_AVX2"
{
bool ok = ix86_expand_int_vec_cmp (operands);
@ -4409,7 +4409,7 @@
[(set (match_operand:<sseintvecmode> 0 "register_operand")
(match_operator:<sseintvecmode> 1 ""
[(match_operand:VI124_128 2 "register_operand")
(match_operand:VI124_128 3 "vector_operand")]))]
(match_operand:VI124_128 3 "vector_or_const_vector_operand")]))]
"TARGET_SSE2"
{
bool ok = ix86_expand_int_vec_cmp (operands);
@ -4421,7 +4421,7 @@
[(set (match_operand:V2DI 0 "register_operand")
(match_operator:V2DI 1 ""
[(match_operand:V2DI 2 "register_operand")
(match_operand:V2DI 3 "vector_operand")]))]
(match_operand:V2DI 3 "vector_or_const_vector_operand")]))]
"TARGET_SSE4_2"
{
bool ok = ix86_expand_int_vec_cmp (operands);

View File

@ -791,28 +791,7 @@
(define_code_iterator any_plus_logic [and ior xor plus])
(define_code_attr plus_logic [(and "and") (ior "or") (xor "xor") (plus "add")])
(define_expand "atomic_<plus_logic><mode>"
[(match_operand:SWI 0 "memory_operand")
(any_plus_logic:SWI (match_dup 0)
(match_operand:SWI 1 "nonmemory_operand"))
(match_operand:SI 2 "const_int_operand")]
""
{
if (flag_prefer_remote_atomic
&& TARGET_RAOINT && operands[2] == const0_rtx
&& (<MODE>mode == SImode || <MODE>mode == DImode))
{
if (CONST_INT_P (operands[1]))
operands[1] = force_reg (<MODE>mode, operands[1]);
emit_insn (maybe_gen_rao_a (<CODE>, <MODE>mode, operands[0], operands[1]));
}
else
emit_insn (gen_atomic_<plus_logic><mode>_1 (operands[0], operands[1],
operands[2]));
DONE;
})
(define_insn "@rao_a<plus_logic><mode>"
(define_insn "rao_a<plus_logic><mode>"
[(set (match_operand:SWI48 0 "memory_operand" "+m")
(unspec_volatile:SWI48
[(any_plus_logic:SWI48 (match_dup 0)
@ -822,7 +801,7 @@
"TARGET_RAOINT"
"a<plus_logic>\t{%1, %0|%0, %1}")
(define_insn "atomic_add<mode>_1"
(define_insn "atomic_add<mode>"
[(set (match_operand:SWI 0 "memory_operand" "+m")
(unspec_volatile:SWI
[(plus:SWI (match_dup 0)
@ -876,7 +855,7 @@
return "lock{%;} %K2sub{<imodesuffix>}\t{%1, %0|%0, %1}";
})
(define_insn "atomic_<logic><mode>_1"
(define_insn "atomic_<logic><mode>"
[(set (match_operand:SWI 0 "memory_operand" "+m")
(unspec_volatile:SWI
[(any_logic:SWI (match_dup 0)

View File

@ -42,7 +42,8 @@ see the files COPYING3 and COPYING.RUNTIME respectively. If not, see
DEF_TUNE (X86_TUNE_SCHEDULE, "schedule",
m_PENT | m_LAKEMONT | m_PPRO | m_CORE_ALL | m_BONNELL | m_SILVERMONT
| m_INTEL | m_KNL | m_KNM | m_K6_GEODE | m_AMD_MULTIPLE | m_LUJIAZUI
| m_GOLDMONT | m_GOLDMONT_PLUS | m_TREMONT | m_ALDERLAKE | m_GENERIC)
| m_GOLDMONT | m_GOLDMONT_PLUS | m_TREMONT | m_ALDERLAKE | m_CORE_ATOM
| m_GENERIC)
/* X86_TUNE_PARTIAL_REG_DEPENDENCY: Enable more register renaming
on modern chips. Prefer stores affecting whole integer register
@ -52,7 +53,7 @@ DEF_TUNE (X86_TUNE_PARTIAL_REG_DEPENDENCY, "partial_reg_dependency",
m_P4_NOCONA | m_CORE2 | m_NEHALEM | m_SANDYBRIDGE | m_CORE_AVX2
| m_BONNELL | m_SILVERMONT | m_GOLDMONT | m_GOLDMONT_PLUS | m_INTEL
| m_KNL | m_KNM | m_AMD_MULTIPLE | m_LUJIAZUI | m_TREMONT
| m_ALDERLAKE | m_GENERIC)
| m_ALDERLAKE | m_CORE_ATOM | m_GENERIC)
/* X86_TUNE_SSE_PARTIAL_REG_DEPENDENCY: This knob promotes all store
destinations to be 128bit to allow register renaming on 128bit SSE units,
@ -63,7 +64,7 @@ DEF_TUNE (X86_TUNE_PARTIAL_REG_DEPENDENCY, "partial_reg_dependency",
DEF_TUNE (X86_TUNE_SSE_PARTIAL_REG_DEPENDENCY, "sse_partial_reg_dependency",
m_PPRO | m_P4_NOCONA | m_CORE_ALL | m_BONNELL | m_AMDFAM10
| m_BDVER | m_ZNVER | m_LUJIAZUI | m_TREMONT | m_ALDERLAKE
| m_GENERIC)
| m_CORE_ATOM | m_GENERIC)
/* X86_TUNE_SSE_PARTIAL_REG_FP_CONVERTS_DEPENDENCY: This knob avoids
partial write to the destination in scalar SSE conversion from FP
@ -71,20 +72,23 @@ DEF_TUNE (X86_TUNE_SSE_PARTIAL_REG_DEPENDENCY, "sse_partial_reg_dependency",
DEF_TUNE (X86_TUNE_SSE_PARTIAL_REG_FP_CONVERTS_DEPENDENCY,
"sse_partial_reg_fp_converts_dependency",
m_PPRO | m_P4_NOCONA | m_CORE_ALL | m_BONNELL | m_AMDFAM10
| m_BDVER | m_ZNVER | m_LUJIAZUI | m_ALDERLAKE | m_GENERIC)
| m_BDVER | m_ZNVER | m_LUJIAZUI | m_ALDERLAKE | m_CORE_ATOM
| m_GENERIC)
/* X86_TUNE_SSE_PARTIAL_REG_CONVERTS_DEPENDENCY: This knob avoids partial
write to the destination in scalar SSE conversion from integer to FP. */
DEF_TUNE (X86_TUNE_SSE_PARTIAL_REG_CONVERTS_DEPENDENCY,
"sse_partial_reg_converts_dependency",
m_PPRO | m_P4_NOCONA | m_CORE_ALL | m_BONNELL | m_AMDFAM10
| m_BDVER | m_ZNVER | m_LUJIAZUI | m_ALDERLAKE | m_GENERIC)
| m_BDVER | m_ZNVER | m_LUJIAZUI | m_ALDERLAKE | m_CORE_ATOM
| m_GENERIC)
/* X86_TUNE_DEST_FALSE_DEP_FOR_GLC: This knob inserts zero-idiom before
several insns to break false dependency on the dest register for GLC
micro-architecture. */
DEF_TUNE (X86_TUNE_DEST_FALSE_DEP_FOR_GLC,
"dest_false_dep_for_glc", m_SAPPHIRERAPIDS | m_ALDERLAKE)
"dest_false_dep_for_glc", m_SAPPHIRERAPIDS | m_ALDERLAKE
| m_CORE_ATOM)
/* X86_TUNE_SSE_SPLIT_REGS: Set for machines where the type and dependencies
are resolved on SSE register parts instead of whole registers, so we may
@ -110,14 +114,14 @@ DEF_TUNE (X86_TUNE_MOVX, "movx",
m_PPRO | m_P4_NOCONA | m_CORE2 | m_NEHALEM | m_SANDYBRIDGE
| m_BONNELL | m_SILVERMONT | m_GOLDMONT | m_KNL | m_KNM | m_INTEL
| m_GOLDMONT_PLUS | m_GEODE | m_AMD_MULTIPLE | m_LUJIAZUI
| m_CORE_AVX2 | m_TREMONT | m_ALDERLAKE | m_GENERIC)
| m_CORE_AVX2 | m_TREMONT | m_ALDERLAKE | m_CORE_ATOM | m_GENERIC)
/* X86_TUNE_MEMORY_MISMATCH_STALL: Avoid partial stores that are followed by
full sized loads. */
DEF_TUNE (X86_TUNE_MEMORY_MISMATCH_STALL, "memory_mismatch_stall",
m_P4_NOCONA | m_CORE_ALL | m_BONNELL | m_SILVERMONT | m_INTEL
| m_KNL | m_KNM | m_GOLDMONT | m_GOLDMONT_PLUS | m_AMD_MULTIPLE
| m_LUJIAZUI | m_TREMONT | m_ALDERLAKE | m_GENERIC)
| m_LUJIAZUI | m_TREMONT | m_ALDERLAKE | m_CORE_ATOM | m_GENERIC)
/* X86_TUNE_FUSE_CMP_AND_BRANCH_32: Fuse compare with a subsequent
conditional jump instruction for 32 bit TARGET. */
@ -173,14 +177,14 @@ DEF_TUNE (X86_TUNE_EPILOGUE_USING_MOVE, "epilogue_using_move",
/* X86_TUNE_USE_LEAVE: Use "leave" instruction in epilogues where it fits. */
DEF_TUNE (X86_TUNE_USE_LEAVE, "use_leave",
m_386 | m_CORE_ALL | m_K6_GEODE | m_AMD_MULTIPLE | m_LUJIAZUI
| m_TREMONT | m_ALDERLAKE | m_GENERIC)
| m_TREMONT | m_ALDERLAKE | m_CORE_ATOM | m_GENERIC)
/* X86_TUNE_PUSH_MEMORY: Enable generation of "push mem" instructions.
Some chips, like 486 and Pentium works faster with separate load
and push instructions. */
DEF_TUNE (X86_TUNE_PUSH_MEMORY, "push_memory",
m_386 | m_P4_NOCONA | m_CORE_ALL | m_K6_GEODE | m_AMD_MULTIPLE
| m_LUJIAZUI | m_TREMONT | m_ALDERLAKE | m_GENERIC)
| m_LUJIAZUI | m_TREMONT | m_ALDERLAKE | m_CORE_ATOM | m_GENERIC)
/* X86_TUNE_SINGLE_PUSH: Enable if single push insn is preferred
over esp subtraction. */
@ -250,15 +254,16 @@ DEF_TUNE (X86_TUNE_READ_MODIFY, "read_modify", ~(m_PENT | m_LAKEMONT | m_PPRO))
DEF_TUNE (X86_TUNE_USE_INCDEC, "use_incdec",
~(m_P4_NOCONA | m_CORE2 | m_NEHALEM | m_SANDYBRIDGE
| m_BONNELL | m_SILVERMONT | m_INTEL | m_KNL | m_KNM | m_GOLDMONT
| m_GOLDMONT_PLUS | m_TREMONT | m_ALDERLAKE | m_LUJIAZUI
| m_GENERIC))
| m_GOLDMONT_PLUS | m_TREMONT | m_ALDERLAKE | m_CORE_ATOM
| m_LUJIAZUI | m_GENERIC))
/* X86_TUNE_INTEGER_DFMODE_MOVES: Enable if integer moves are preferred
for DFmode copies */
DEF_TUNE (X86_TUNE_INTEGER_DFMODE_MOVES, "integer_dfmode_moves",
~(m_PPRO | m_P4_NOCONA | m_CORE_ALL | m_BONNELL | m_SILVERMONT
| m_KNL | m_KNM | m_INTEL | m_GEODE | m_AMD_MULTIPLE | m_LUJIAZUI
| m_GOLDMONT | m_GOLDMONT_PLUS | m_TREMONT | m_ALDERLAKE | m_GENERIC))
| m_GOLDMONT | m_GOLDMONT_PLUS | m_TREMONT | m_ALDERLAKE
| m_CORE_ATOM | m_GENERIC))
/* X86_TUNE_OPT_AGU: Optimize for Address Generation Unit. This flag
will impact LEA instruction selection. */
@ -296,7 +301,8 @@ DEF_TUNE (X86_TUNE_SINGLE_STRINGOP, "single_stringop", m_386 | m_P4_NOCONA)
move/set sequences of bytes with known size. */
DEF_TUNE (X86_TUNE_PREFER_KNOWN_REP_MOVSB_STOSB,
"prefer_known_rep_movsb_stosb",
m_SKYLAKE | m_ALDERLAKE | m_TREMONT | m_CORE_AVX512 | m_LUJIAZUI)
m_SKYLAKE | m_ALDERLAKE | m_CORE_ATOM | m_TREMONT | m_CORE_AVX512
| m_LUJIAZUI)
/* X86_TUNE_MISALIGNED_MOVE_STRING_PRO_EPILOGUES: Enable generation of
compact prologues and epilogues by issuing a misaligned moves. This
@ -306,14 +312,14 @@ DEF_TUNE (X86_TUNE_PREFER_KNOWN_REP_MOVSB_STOSB,
DEF_TUNE (X86_TUNE_MISALIGNED_MOVE_STRING_PRO_EPILOGUES,
"misaligned_move_string_pro_epilogues",
m_386 | m_486 | m_CORE_ALL | m_AMD_MULTIPLE | m_LUJIAZUI | m_TREMONT
| m_ALDERLAKE | m_GENERIC)
| m_ALDERLAKE | m_CORE_ATOM | m_GENERIC)
/* X86_TUNE_USE_SAHF: Controls use of SAHF. */
DEF_TUNE (X86_TUNE_USE_SAHF, "use_sahf",
m_PPRO | m_P4_NOCONA | m_CORE_ALL | m_BONNELL | m_SILVERMONT
| m_KNL | m_KNM | m_INTEL | m_K6_GEODE | m_K8 | m_AMDFAM10 | m_BDVER
| m_BTVER | m_ZNVER | m_LUJIAZUI | m_GOLDMONT | m_GOLDMONT_PLUS
| m_TREMONT | m_ALDERLAKE | m_GENERIC)
| m_TREMONT | m_ALDERLAKE | m_CORE_ATOM | m_GENERIC)
/* X86_TUNE_USE_CLTD: Controls use of CLTD and CTQO instructions. */
DEF_TUNE (X86_TUNE_USE_CLTD, "use_cltd",
@ -324,13 +330,13 @@ DEF_TUNE (X86_TUNE_USE_CLTD, "use_cltd",
DEF_TUNE (X86_TUNE_USE_BT, "use_bt",
m_CORE_ALL | m_BONNELL | m_SILVERMONT | m_KNL | m_KNM | m_INTEL
| m_LAKEMONT | m_AMD_MULTIPLE | m_LUJIAZUI | m_GOLDMONT
| m_GOLDMONT_PLUS | m_TREMONT | m_ALDERLAKE | m_GENERIC)
| m_GOLDMONT_PLUS | m_TREMONT | m_ALDERLAKE | m_CORE_ATOM | m_GENERIC)
/* X86_TUNE_AVOID_FALSE_DEP_FOR_BMI: Avoid false dependency
for bit-manipulation instructions. */
DEF_TUNE (X86_TUNE_AVOID_FALSE_DEP_FOR_BMI, "avoid_false_dep_for_bmi",
m_SANDYBRIDGE | m_CORE_AVX2 | m_TREMONT | m_ALDERLAKE | m_LUJIAZUI
| m_GENERIC)
m_SANDYBRIDGE | m_CORE_AVX2 | m_TREMONT | m_ALDERLAKE | m_CORE_ATOM
| m_LUJIAZUI | m_GENERIC)
/* X86_TUNE_ADJUST_UNROLL: This enables adjusting the unroll factor based
on hardware capabilities. Bdver3 hardware has a loop buffer which makes
@ -342,12 +348,13 @@ DEF_TUNE (X86_TUNE_ADJUST_UNROLL, "adjust_unroll_factor", m_BDVER3 | m_BDVER4)
if-converted sequence to one. */
DEF_TUNE (X86_TUNE_ONE_IF_CONV_INSN, "one_if_conv_insn",
m_SILVERMONT | m_KNL | m_KNM | m_INTEL | m_CORE_ALL | m_GOLDMONT
| m_GOLDMONT_PLUS | m_TREMONT | m_ALDERLAKE | m_LUJIAZUI | m_GENERIC)
| m_GOLDMONT_PLUS | m_TREMONT | m_ALDERLAKE | m_CORE_ATOM | m_LUJIAZUI
| m_GENERIC)
/* X86_TUNE_AVOID_MFENCE: Use lock prefixed instructions instead of mfence. */
DEF_TUNE (X86_TUNE_AVOID_MFENCE, "avoid_mfence",
m_CORE_ALL | m_BDVER | m_ZNVER | m_LUJIAZUI | m_TREMONT | m_ALDERLAKE
| m_GENERIC)
| m_CORE_ATOM | m_GENERIC)
/* X86_TUNE_EXPAND_ABS: This enables a new abs pattern by
generating instructions for abs (x) = (((signed) x >> (W-1) ^ x) -
@ -372,7 +379,7 @@ DEF_TUNE (X86_TUNE_USE_SIMODE_FIOP, "use_simode_fiop",
~(m_PENT | m_LAKEMONT | m_PPRO | m_CORE_ALL | m_BONNELL
| m_SILVERMONT | m_KNL | m_KNM | m_INTEL | m_AMD_MULTIPLE
| m_LUJIAZUI | m_GOLDMONT | m_GOLDMONT_PLUS | m_TREMONT
| m_ALDERLAKE | m_GENERIC))
| m_ALDERLAKE | m_CORE_ATOM | m_GENERIC))
/* X86_TUNE_USE_FFREEP: Use freep instruction instead of fstp. */
DEF_TUNE (X86_TUNE_USE_FFREEP, "use_ffreep", m_AMD_MULTIPLE | m_LUJIAZUI)
@ -381,7 +388,8 @@ DEF_TUNE (X86_TUNE_USE_FFREEP, "use_ffreep", m_AMD_MULTIPLE | m_LUJIAZUI)
DEF_TUNE (X86_TUNE_EXT_80387_CONSTANTS, "ext_80387_constants",
m_PPRO | m_P4_NOCONA | m_CORE_ALL | m_BONNELL | m_SILVERMONT
| m_KNL | m_KNM | m_INTEL | m_K6_GEODE | m_ATHLON_K8 | m_LUJIAZUI
| m_GOLDMONT | m_GOLDMONT_PLUS | m_TREMONT | m_ALDERLAKE | m_GENERIC)
| m_GOLDMONT | m_GOLDMONT_PLUS | m_TREMONT | m_ALDERLAKE | m_CORE_ATOM
| m_GENERIC)
/*****************************************************************************/
/* SSE instruction selection tuning */
@ -397,14 +405,15 @@ DEF_TUNE (X86_TUNE_GENERAL_REGS_SSE_SPILL, "general_regs_sse_spill",
DEF_TUNE (X86_TUNE_SSE_UNALIGNED_LOAD_OPTIMAL, "sse_unaligned_load_optimal",
m_NEHALEM | m_SANDYBRIDGE | m_CORE_AVX2 | m_SILVERMONT | m_KNL | m_KNM
| m_INTEL | m_GOLDMONT | m_GOLDMONT_PLUS | m_TREMONT | m_ALDERLAKE
| m_AMDFAM10 | m_BDVER | m_BTVER | m_ZNVER | m_LUJIAZUI | m_GENERIC)
| m_CORE_ATOM | m_AMDFAM10 | m_BDVER | m_BTVER | m_ZNVER | m_LUJIAZUI
| m_GENERIC)
/* X86_TUNE_SSE_UNALIGNED_STORE_OPTIMAL: Use movups for misaligned stores
instead of a sequence loading registers by parts. */
DEF_TUNE (X86_TUNE_SSE_UNALIGNED_STORE_OPTIMAL, "sse_unaligned_store_optimal",
m_NEHALEM | m_SANDYBRIDGE | m_CORE_AVX2 | m_SILVERMONT | m_KNL | m_KNM
| m_INTEL | m_GOLDMONT | m_GOLDMONT_PLUS | m_TREMONT | m_ALDERLAKE
| m_BDVER | m_ZNVER | m_LUJIAZUI | m_GENERIC)
| m_CORE_ATOM | m_BDVER | m_ZNVER | m_LUJIAZUI | m_GENERIC)
/* X86_TUNE_SSE_PACKED_SINGLE_INSN_OPTIMAL: Use packed single
precision 128bit instructions instead of double where possible. */
@ -414,13 +423,13 @@ DEF_TUNE (X86_TUNE_SSE_PACKED_SINGLE_INSN_OPTIMAL, "sse_packed_single_insn_optim
/* X86_TUNE_SSE_TYPELESS_STORES: Always movaps/movups for 128bit stores. */
DEF_TUNE (X86_TUNE_SSE_TYPELESS_STORES, "sse_typeless_stores",
m_AMD_MULTIPLE | m_LUJIAZUI | m_CORE_ALL | m_TREMONT | m_ALDERLAKE
| m_GENERIC)
| m_CORE_ATOM | m_GENERIC)
/* X86_TUNE_SSE_LOAD0_BY_PXOR: Always use pxor to load0 as opposed to
xorps/xorpd and other variants. */
DEF_TUNE (X86_TUNE_SSE_LOAD0_BY_PXOR, "sse_load0_by_pxor",
m_PPRO | m_P4_NOCONA | m_CORE_ALL | m_BDVER | m_BTVER | m_ZNVER
| m_LUJIAZUI | m_TREMONT | m_ALDERLAKE | m_GENERIC)
| m_LUJIAZUI | m_TREMONT | m_ALDERLAKE | m_CORE_ATOM | m_GENERIC)
/* X86_TUNE_INTER_UNIT_MOVES_TO_VEC: Enable moves in from integer
to SSE registers. If disabled, the moves will be done by storing
@ -467,22 +476,22 @@ DEF_TUNE (X86_TUNE_SLOW_PSHUFB, "slow_pshufb",
/* X86_TUNE_AVOID_4BYTE_PREFIXES: Avoid instructions requiring 4+ bytes of prefixes. */
DEF_TUNE (X86_TUNE_AVOID_4BYTE_PREFIXES, "avoid_4byte_prefixes",
m_SILVERMONT | m_GOLDMONT | m_GOLDMONT_PLUS | m_TREMONT | m_ALDERLAKE
| m_INTEL)
| m_CORE_ATOM | m_INTEL)
/* X86_TUNE_USE_GATHER_2PARTS: Use gather instructions for vectors with 2
elements. */
DEF_TUNE (X86_TUNE_USE_GATHER_2PARTS, "use_gather_2parts",
~(m_ZNVER1 | m_ZNVER2 | m_ZNVER3 | m_ALDERLAKE | m_GENERIC))
~(m_ZNVER1 | m_ZNVER2 | m_ZNVER3 | m_ALDERLAKE | m_CORE_ATOM | m_GENERIC))
/* X86_TUNE_USE_GATHER_4PARTS: Use gather instructions for vectors with 4
elements. */
DEF_TUNE (X86_TUNE_USE_GATHER_4PARTS, "use_gather_4parts",
~(m_ZNVER1 | m_ZNVER2 | m_ZNVER3 | m_ALDERLAKE | m_GENERIC))
~(m_ZNVER1 | m_ZNVER2 | m_ZNVER3 | m_ALDERLAKE | m_CORE_ATOM | m_GENERIC))
/* X86_TUNE_USE_GATHER: Use gather instructions for vectors with 8 or more
elements. */
DEF_TUNE (X86_TUNE_USE_GATHER, "use_gather",
~(m_ZNVER1 | m_ZNVER2 | m_ALDERLAKE | m_GENERIC))
~(m_ZNVER1 | m_ZNVER2 | m_ALDERLAKE | m_CORE_ATOM | m_GENERIC))
/* X86_TUNE_AVOID_128FMA_CHAINS: Avoid creating loops with tight 128bit or
smaller FMA chain. */

View File

@ -6232,6 +6232,7 @@ add_candidates (tree fns, tree first_arg, const vec<tree, va_gc> *args,
bool check_list_ctor = false;
bool check_converting = false;
unification_kind_t strict;
tree ne_fns = NULL_TREE;
if (!fns)
return;
@ -6269,6 +6270,32 @@ add_candidates (tree fns, tree first_arg, const vec<tree, va_gc> *args,
ctype = conversion_path ? BINFO_TYPE (conversion_path) : NULL_TREE;
}
/* P2468: Check if operator== is a rewrite target with first operand
(*args)[0]; for now just do the lookups. */
if ((flags & (LOOKUP_REWRITTEN | LOOKUP_REVERSED))
&& DECL_OVERLOADED_OPERATOR_IS (fn, EQ_EXPR))
{
tree ne_name = ovl_op_identifier (false, NE_EXPR);
if (DECL_CLASS_SCOPE_P (fn))
{
ne_fns = lookup_fnfields (TREE_TYPE ((*args)[0]), ne_name,
1, tf_none);
if (ne_fns == error_mark_node || ne_fns == NULL_TREE)
ne_fns = NULL_TREE;
else
ne_fns = BASELINK_FUNCTIONS (ne_fns);
}
else
{
tree context = decl_namespace_context (fn);
ne_fns = lookup_qualified_name (context, ne_name, LOOK_want::NORMAL,
/*complain*/false);
if (ne_fns == error_mark_node
|| !is_overloaded_fn (ne_fns))
ne_fns = NULL_TREE;
}
}
if (first_arg)
non_static_args = args;
else
@ -6345,6 +6372,27 @@ add_candidates (tree fns, tree first_arg, const vec<tree, va_gc> *args,
continue;
}
/* When considering reversed operator==, if there's a corresponding
operator!= in the same scope, it's not a rewrite target. */
if (ne_fns)
{
bool found = false;
for (lkp_iterator ne (ne_fns); !found && ne; ++ne)
if (0 && !ne.using_p ()
&& DECL_NAMESPACE_SCOPE_P (fn)
&& DECL_CONTEXT (*ne) != DECL_CONTEXT (fn))
/* ??? This kludge excludes inline namespace members for the H
test in spaceship-eq15.C, but I don't see why we would want
that behavior. Asked Core 2022-11-04. Disabling for now. */;
else if (fns_correspond (fn, *ne))
{
found = true;
break;
}
if (found)
continue;
}
if (TREE_CODE (fn) == TEMPLATE_DECL)
{
if (!add_template_candidate (candidates,
@ -6917,10 +6965,12 @@ build_new_op (const op_location_t &loc, enum tree_code code, int flags,
gcc_checking_assert (cand->reversed ());
gcc_fallthrough ();
case NE_EXPR:
if (result == error_mark_node)
;
/* If a rewritten operator== candidate is selected by
overload resolution for an operator @, its return type
shall be cv bool.... */
if (TREE_CODE (TREE_TYPE (result)) != BOOLEAN_TYPE)
else if (TREE_CODE (TREE_TYPE (result)) != BOOLEAN_TYPE)
{
if (complain & tf_error)
{
@ -12488,10 +12538,53 @@ joust (struct z_candidate *cand1, struct z_candidate *cand2, bool warn,
if (winner && comp != winner)
{
/* Ambiguity between normal and reversed comparison operators
with the same parameter types; prefer the normal one. */
if ((cand1->reversed () != cand2->reversed ())
with the same parameter types. P2468 decided not to go with
this approach to resolving the ambiguity, so pedwarn. */
if ((complain & tf_warning_or_error)
&& (cand1->reversed () != cand2->reversed ())
&& cand_parms_match (cand1, cand2))
return cand1->reversed () ? -1 : 1;
{
struct z_candidate *w, *l;
if (cand2->reversed ())
winner = 1, w = cand1, l = cand2;
else
winner = -1, w = cand2, l = cand1;
if (warn)
{
auto_diagnostic_group d;
if (pedwarn (input_location, 0,
"C++20 says that these are ambiguous, "
"even though the second is reversed:"))
{
print_z_candidate (input_location,
N_("candidate 1:"), w);
print_z_candidate (input_location,
N_("candidate 2:"), l);
if (w->fn == l->fn
&& DECL_NONSTATIC_MEMBER_FUNCTION_P (w->fn)
&& (type_memfn_quals (TREE_TYPE (w->fn))
& TYPE_QUAL_CONST) == 0)
{
/* Suggest adding const to
struct A { bool operator==(const A&); }; */
tree parmtype
= FUNCTION_FIRST_USER_PARMTYPE (w->fn);
parmtype = TREE_VALUE (parmtype);
if (TYPE_REF_P (parmtype)
&& TYPE_READONLY (TREE_TYPE (parmtype))
&& (same_type_ignoring_top_level_qualifiers_p
(TREE_TYPE (parmtype),
DECL_CONTEXT (w->fn))))
inform (DECL_SOURCE_LOCATION (w->fn),
"try making the operator a %<const%> "
"member function");
}
}
}
else
add_warning (w, l);
return winner;
}
winner = 0;
goto tweak;
@ -12880,7 +12973,7 @@ tourney (struct z_candidate *candidates, tsubst_flags_t complain)
{
struct z_candidate *champ = candidates, *challenger;
int fate;
int champ_compared_to_predecessor = 0;
struct z_candidate *champ_compared_to_predecessor = nullptr;
/* Walk through the list once, comparing each current champ to the next
candidate, knocking out a candidate or two with each comparison. */
@ -12897,12 +12990,12 @@ tourney (struct z_candidate *candidates, tsubst_flags_t complain)
champ = challenger->next;
if (champ == 0)
return NULL;
champ_compared_to_predecessor = 0;
champ_compared_to_predecessor = nullptr;
}
else
{
champ_compared_to_predecessor = champ;
champ = challenger;
champ_compared_to_predecessor = 1;
}
challenger = champ->next;
@ -12914,7 +13007,7 @@ tourney (struct z_candidate *candidates, tsubst_flags_t complain)
for (challenger = candidates;
challenger != champ
&& !(champ_compared_to_predecessor && challenger->next == champ);
&& challenger != champ_compared_to_predecessor;
challenger = challenger->next)
{
fate = joust (champ, challenger, 0, complain);

View File

@ -6820,6 +6820,7 @@ extern void note_break_stmt (void);
extern bool note_iteration_stmt_body_start (void);
extern void note_iteration_stmt_body_end (bool);
extern void determine_local_discriminator (tree);
extern bool fns_correspond (tree, tree);
extern int decls_match (tree, tree, bool = true);
extern bool maybe_version_functions (tree, tree, bool);
extern bool merge_default_template_args (tree, tree, bool);

View File

@ -980,6 +980,72 @@ function_requirements_equivalent_p (tree newfn, tree oldfn)
return cp_tree_equal (reqs1, reqs2);
}
/* Two functions of the same name correspond [basic.scope.scope] if
+ both declare functions with the same non-object-parameter-type-list,
equivalent ([temp.over.link]) trailing requires-clauses (if any, except as
specified in [temp.friend]), and, if both are non-static members, they have
corresponding object parameters, or
+ both declare function templates with equivalent
non-object-parameter-type-lists, return types (if any), template-heads, and
trailing requires-clauses (if any), and, if both are non-static members,
they have corresponding object parameters.
This is a subset of decls_match: it identifies declarations that cannot be
overloaded with one another. This function does not consider DECL_NAME. */
bool
fns_correspond (tree newdecl, tree olddecl)
{
if (TREE_CODE (newdecl) != TREE_CODE (olddecl))
return false;
if (TREE_CODE (newdecl) == TEMPLATE_DECL)
{
if (!template_heads_equivalent_p (newdecl, olddecl))
return 0;
newdecl = DECL_TEMPLATE_RESULT (newdecl);
olddecl = DECL_TEMPLATE_RESULT (olddecl);
}
tree f1 = TREE_TYPE (newdecl);
tree f2 = TREE_TYPE (olddecl);
int rq1 = type_memfn_rqual (f1);
int rq2 = type_memfn_rqual (f2);
/* If only one is a non-static member function, ignore ref-quals. */
if (TREE_CODE (f1) != TREE_CODE (f2))
rq1 = rq2;
/* Two non-static member functions have corresponding object parameters if:
+ exactly one is an implicit object member function with no ref-qualifier
and the types of their object parameters ([dcl.fct]), after removing
top-level references, are the same, or
+ their object parameters have the same type. */
/* ??? We treat member functions of different classes as corresponding even
though that means the object parameters have different types. */
else if ((rq1 == REF_QUAL_NONE) != (rq2 == REF_QUAL_NONE))
rq1 = rq2;
bool types_match = rq1 == rq2;
if (types_match)
{
tree p1 = FUNCTION_FIRST_USER_PARMTYPE (newdecl);
tree p2 = FUNCTION_FIRST_USER_PARMTYPE (olddecl);
types_match = compparms (p1, p2);
}
/* Two function declarations match if either has a requires-clause
then both have a requires-clause and their constraints-expressions
are equivalent. */
if (types_match && flag_concepts)
types_match = function_requirements_equivalent_p (newdecl, olddecl);
return types_match;
}
/* Subroutine of duplicate_decls: return truthvalue of whether
or not types of these decls match.

View File

@ -20937,8 +20937,9 @@ tsubst_copy_and_build (tree t,
/* In a lambda fn, we have to be careful to not
introduce new this captures. Legacy code can't
be using lambdas anyway, so it's ok to be
stricter. Be strict with C++20 template-id ADL too. */
bool strict = in_lambda || template_id_p;
stricter. Be strict with C++20 template-id ADL too.
And be strict if we're already failing anyway. */
bool strict = in_lambda || template_id_p || seen_error();
bool diag = true;
if (strict)
error_at (cp_expr_loc_or_input_loc (t),

View File

@ -1400,7 +1400,7 @@ See RS/6000 and PowerPC Options.
-mrdseed -msgx -mavx512vp2intersect -mserialize -mtsxldtrk@gol
-mamx-tile -mamx-int8 -mamx-bf16 -muintr -mhreset -mavxvnni@gol
-mavx512fp16 -mavxifma -mavxvnniint8 -mavxneconvert -mcmpccxadd -mamx-fp16 @gol
-mprefetchi -mraoint -mprefer-remote-atomic@gol
-mprefetchi -mraoint @gol
-mcldemote -mms-bitfields -mno-align-stringops -minline-all-stringops @gol
-minline-stringops-dynamically -mstringop-strategy=@var{alg} @gol
-mkl -mwidekl @gol
@ -33634,10 +33634,6 @@ execute pause if load value is not expected. This reduces excessive
cachline bouncing when and works for all atomic logic fetch builtins
that generates compare and swap loop.
@item -mprefer-remote-atomic
@opindex mprefer-remote-atomic
Prefer use remote atomic insn for atomic operations.
@item -mindirect-branch=@var{choice}
@opindex mindirect-branch
Convert indirect call and jump with @var{choice}. The default is

View File

@ -73,7 +73,7 @@ remap_filename (file_prefix_map *maps, const char *filename)
char *realname;
size_t name_len;
if (lbasename (filename) == filename)
if (!filename || lbasename (filename) == filename)
return filename;
realname = lrealpath (filename);

View File

@ -1,3 +1,12 @@
2022-11-07 Tobias Burnus <tobias@codesourcery.com>
PR fortran/107508
* trans-array.cc (gfc_alloc_allocatable_for_assignment): Fix
string-length check, plug memory leak, and avoid generation of
effectively no-op code.
* trans-expr.cc (alloc_scalar_allocatable_for_assignment): Extend
comment; minor cleanup.
2022-11-03 Tobias Burnus <tobias@codesourcery.com>
* openmp.cc (gfc_match_omp_clauses): Permit derived types for

View File

@ -10527,7 +10527,6 @@ gfc_alloc_allocatable_for_assignment (gfc_loopinfo *loop,
tree offset;
tree jump_label1;
tree jump_label2;
tree neq_size;
tree lbd;
tree class_expr2 = NULL_TREE;
int n;
@ -10607,6 +10606,11 @@ gfc_alloc_allocatable_for_assignment (gfc_loopinfo *loop,
elemsize1 = expr1->ts.u.cl->backend_decl;
else
elemsize1 = lss->info->string_length;
tree unit_size = TYPE_SIZE_UNIT (gfc_get_char_type (expr1->ts.kind));
elemsize1 = fold_build2_loc (input_location, MULT_EXPR,
TREE_TYPE (elemsize1), elemsize1,
fold_convert (TREE_TYPE (elemsize1), unit_size));
}
else if (expr1->ts.type == BT_CLASS)
{
@ -10699,19 +10703,7 @@ gfc_alloc_allocatable_for_assignment (gfc_loopinfo *loop,
/* Allocate if data is NULL. */
cond_null = fold_build2_loc (input_location, EQ_EXPR, logical_type_node,
array1, build_int_cst (TREE_TYPE (array1), 0));
if (expr1->ts.type == BT_CHARACTER && expr1->ts.deferred)
{
tmp = fold_build2_loc (input_location, NE_EXPR,
logical_type_node,
lss->info->string_length,
rss->info->string_length);
cond_null = fold_build2_loc (input_location, TRUTH_OR_EXPR,
logical_type_node, tmp, cond_null);
cond_null= gfc_evaluate_now (cond_null, &fblock);
}
else
cond_null= gfc_evaluate_now (cond_null, &fblock);
cond_null= gfc_evaluate_now (cond_null, &fblock);
tmp = build3_v (COND_EXPR, cond_null,
build1_v (GOTO_EXPR, jump_label1),
@ -10778,19 +10770,6 @@ gfc_alloc_allocatable_for_assignment (gfc_loopinfo *loop,
tmp = build1_v (LABEL_EXPR, jump_label1);
gfc_add_expr_to_block (&fblock, tmp);
/* If the lhs has not been allocated, its bounds will not have been
initialized and so its size is set to zero. */
size1 = gfc_create_var (gfc_array_index_type, NULL);
gfc_init_block (&alloc_block);
gfc_add_modify (&alloc_block, size1, gfc_index_zero_node);
gfc_init_block (&realloc_block);
gfc_add_modify (&realloc_block, size1,
gfc_conv_descriptor_size (desc, expr1->rank));
tmp = build3_v (COND_EXPR, cond_null,
gfc_finish_block (&alloc_block),
gfc_finish_block (&realloc_block));
gfc_add_expr_to_block (&fblock, tmp);
/* Get the rhs size and fix it. */
size2 = gfc_index_one_node;
for (n = 0; n < expr2->rank; n++)
@ -10807,16 +10786,6 @@ gfc_alloc_allocatable_for_assignment (gfc_loopinfo *loop,
}
size2 = gfc_evaluate_now (size2, &fblock);
cond = fold_build2_loc (input_location, NE_EXPR, logical_type_node,
size1, size2);
/* If the lhs is deferred length, assume that the element size
changes and force a reallocation. */
if (expr1->ts.deferred)
neq_size = gfc_evaluate_now (logical_true_node, &fblock);
else
neq_size = gfc_evaluate_now (cond, &fblock);
/* Deallocation of allocatable components will have to occur on
reallocation. Fix the old descriptor now. */
if ((expr1->ts.type == BT_DERIVED)
@ -11048,20 +11017,6 @@ gfc_alloc_allocatable_for_assignment (gfc_loopinfo *loop,
gfc_add_block_to_block (&realloc_block, &caf_se.post);
realloc_expr = gfc_finish_block (&realloc_block);
/* Reallocate if sizes or dynamic types are different. */
if (elemsize1)
{
tmp = fold_build2_loc (input_location, NE_EXPR, logical_type_node,
elemsize1, elemsize2);
tmp = gfc_evaluate_now (tmp, &fblock);
neq_size = fold_build2_loc (input_location, TRUTH_OR_EXPR,
logical_type_node, neq_size, tmp);
}
tmp = build3_v (COND_EXPR, neq_size, realloc_expr,
build_empty_stmt (input_location));
realloc_expr = tmp;
/* Malloc expression. */
gfc_init_block (&alloc_block);
if (!coarray)

View File

@ -11236,10 +11236,10 @@ alloc_scalar_allocatable_for_assignment (stmtblock_t *block,
if (expr1->ts.type == BT_CHARACTER && expr1->ts.deferred)
{
/* Use the rhs string length and the lhs element size. */
/* Use the rhs string length and the lhs element size. Note that 'size' is
used below for the string-length comparison, only. */
size = string_length;
tmp = TREE_TYPE (gfc_typenode_for_spec (&expr1->ts));
tmp = TYPE_SIZE_UNIT (tmp);
tmp = TYPE_SIZE_UNIT (gfc_get_char_type (expr1->ts.kind));
size_in_bytes = fold_build2_loc (input_location, MULT_EXPR,
TREE_TYPE (tmp), tmp,
fold_convert (TREE_TYPE (tmp), size));

View File

@ -1544,8 +1544,27 @@ ranger_cache::range_from_dom (vrange &r, tree name, basic_block start_bb,
return true;
}
// This routine is used during a block walk to move the state of non-null for
// any operands on stmt S to nonnull.
// This routine will register an inferred value in block BB, and possibly
// update the on-entry cache if appropriate.
void
ranger_cache::register_inferred_value (const vrange &ir, tree name,
basic_block bb)
{
Value_Range r (TREE_TYPE (name));
if (!m_on_entry.get_bb_range (r, name, bb))
exit_range (r, name, bb, RFD_READ_ONLY);
if (r.intersect (ir))
{
m_on_entry.set_bb_range (name, bb, r);
// If this range was invariant before, remove invariance.
if (!m_gori.has_edge_range_p (name))
m_gori.set_range_invariant (name, false);
}
}
// This routine is used during a block walk to adjust any inferred ranges
// of operands on stmt S.
void
ranger_cache::apply_inferred_ranges (gimple *s)
@ -1574,17 +1593,6 @@ ranger_cache::apply_inferred_ranges (gimple *s)
tree name = infer.name (x);
m_exit.add_range (name, bb, infer.range (x));
if (update)
{
Value_Range r (TREE_TYPE (name));
if (!m_on_entry.get_bb_range (r, name, bb))
exit_range (r, name, bb, RFD_READ_ONLY);
if (r.intersect (infer.range (x)))
{
m_on_entry.set_bb_range (name, bb, r);
// If this range was invariant before, remove invariance.
if (!m_gori.has_edge_range_p (name))
m_gori.set_range_invariant (name, false);
}
}
register_inferred_value (infer.range (x), name, bb);
}
}

View File

@ -87,6 +87,7 @@ public:
void propagate_updated_value (tree name, basic_block bb);
void register_inferred_value (const vrange &r, tree name, basic_block bb);
void apply_inferred_ranges (gimple *s);
gori_compute m_gori;
infer_range_manager m_exit;

View File

@ -252,6 +252,17 @@ infer_range_manager::get_nonzero (tree name)
return *(m_nonzero[v]);
}
// Return TRUE if there are any range inferences in block BB.
bool
infer_range_manager::has_range_p (basic_block bb)
{
if (bb->index >= (int)m_on_exit.length ())
return false;
bitmap b = m_on_exit[bb->index].m_names;
return b && !bitmap_empty_p (b);
}
// Return TRUE if NAME has a range inference in block BB.
bool

View File

@ -62,6 +62,7 @@ public:
void add_range (tree name, basic_block bb, const vrange &r);
void add_nonzero (tree name, basic_block bb);
bool has_range_p (tree name, basic_block bb);
bool has_range_p (basic_block bb);
bool maybe_adjust_range (vrange &r, tree name, basic_block bb);
private:
class exit_range_head

View File

@ -482,6 +482,54 @@ gimple_ranger::register_inferred_ranges (gimple *s)
m_cache.apply_inferred_ranges (s);
}
// This function will walk the statements in BB to determine if any
// discovered inferred ranges in the block have any transitive effects,
// and if so, register those effects in BB.
void
gimple_ranger::register_transitive_inferred_ranges (basic_block bb)
{
// Return if there are no inferred ranges in BB.
infer_range_manager &infer = m_cache.m_exit;
if (!infer.has_range_p (bb))
return;
if (dump_file && (dump_flags & TDF_DETAILS))
fprintf (dump_file, "Checking for transitive inferred ranges in BB %d\n",
bb->index);
for (gimple_stmt_iterator si = gsi_start_bb (bb); !gsi_end_p (si);
gsi_next (&si))
{
gimple *s = gsi_stmt (si);
tree lhs = gimple_get_lhs (s);
// If the LHS alreayd has an inferred effect, leave it be.
if (!gimple_range_ssa_p (lhs) || infer.has_range_p (lhs, bb))
continue;
// Pick up global value.
Value_Range g (TREE_TYPE (lhs));
range_of_expr (g, lhs);
// If either dependency has an inferred range, check if recalculating
// the LHS is different than the global value. If so, register it as
// an inferred range as well.
Value_Range r (TREE_TYPE (lhs));
r.set_undefined ();
tree name1 = gori ().depend1 (lhs);
tree name2 = gori ().depend2 (lhs);
if ((name1 && infer.has_range_p (name1, bb))
|| (name2 && infer.has_range_p (name2, bb)))
{
// Check if folding S produces a different result.
if (fold_range (r, s, this) && g != r)
{
infer.add_range (lhs, bb, r);
m_cache.register_inferred_value (r, lhs, bb);
}
}
}
}
// When a statement S has changed since the result was cached, re-evaluate
// and update the global cache.

View File

@ -62,6 +62,7 @@ public:
auto_edge_flag non_executable_edge_flag;
bool fold_stmt (gimple_stmt_iterator *gsi, tree (*) (tree));
void register_inferred_ranges (gimple *s);
void register_transitive_inferred_ranges (basic_block bb);
protected:
bool fold_range_internal (vrange &r, gimple *s, tree name);
void prefill_name (vrange &r, tree name);

View File

@ -2209,8 +2209,8 @@ assign_hard_reg (ira_allocno_t a, bool retry_p)
restore_costs_from_copies (a);
ALLOCNO_HARD_REGNO (a) = best_hard_regno;
ALLOCNO_ASSIGNED_P (a) = true;
if (best_hard_regno >= 0)
update_costs_from_copies (a, true, ! retry_p);
if (best_hard_regno >= 0 && !retry_p)
update_costs_from_copies (a, true, true);
ira_assert (ALLOCNO_CLASS (a) == aclass);
/* We don't need updated costs anymore. */
ira_free_allocno_updated_costs (a);

View File

@ -1911,8 +1911,20 @@ operator_mult::wi_fold (irange &r, tree type,
// diff = max - min
prod2 = prod3 - prod0;
if (wi::geu_p (prod2, sizem1))
// The range covers all values.
r.set_varying (type);
{
// Multiplying by X, where X is a power of 2 is [0,0][X,+INF].
if (TYPE_UNSIGNED (type) && rh_lb == rh_ub
&& wi::exact_log2 (rh_lb) != -1 && prec > 1)
{
r.set (type, rh_lb, wi::max_value (prec, sign));
int_range<2> zero;
zero.set_zero (type);
r.union_ (zero);
}
else
// The range covers all values.
r.set_varying (type);
}
else
{
wide_int new_lb = wide_int::from (prod0, prec, sign);
@ -1953,7 +1965,9 @@ operator_div::fold_range (irange &r, tree type,
return true;
tree t;
if (rh.singleton_p (&t))
if (code == TRUNC_DIV_EXPR
&& rh.singleton_p (&t)
&& !wi::neg_p (lh.lower_bound ()))
{
wide_int wi = wi::to_wide (t);
int shift = wi::exact_log2 (wi);

View File

@ -1,3 +1,102 @@
2022-11-07 Aldy Hernandez <aldyh@redhat.com>
PR tree-optimization/55157
* gcc.dg/tree-ssa/pr55157.c: New test.
2022-11-07 H.J. Lu <hjl.tools@gmail.com>
PR middle-end/102566
* g++.target/i386/pr102566-7.C
2022-11-07 Nathan Sidwell <nathan@acm.org>
* g++.dg/abi/lambda-tpl1.h: Add more cases.
* g++.dg/abi/lambda-tpl1-17.C: Add checks.
* g++.dg/abi/lambda-tpl1-18.C: Likewise.
* g++.dg/abi/lambda-tpl1-18vs17.C: Likewise.
2022-11-07 Alexander Monakov <amonakov@ispras.ru>
PR tree-optimization/107505
* gcc.dg/pr107505.c: New test.
2022-11-07 Aldy Hernandez <aldyh@redhat.com>
PR tree-optimization/107541
* gcc.dg/tree-ssa/pr107541.c: New test.
2022-11-07 Tobias Burnus <tobias@codesourcery.com>
PR fortran/107508
* gfortran.dg/widechar_11.f90: New test.
2022-11-07 konglin1 <lingling.kong@intel.com>
* gcc.target/i386/sse-22.c: Fix typo in pragma GCC target.
2022-11-07 Kewen Lin <linkw@linux.ibm.com>
PR tree-optimization/107412
* gcc.target/powerpc/pr107412.c: New test.
* gcc.target/powerpc/p9-vec-length-epil-8.c: Adjust scan times for
folded LEN_LOAD.
2022-11-07 Hu, Lin1 <lin1.hu@intel.com>
* g++.target/i386/mv16.C: Add grandridge.
* gcc.target/i386/funcspec-56.inc: Handle new march.
2022-11-07 konglin1 <lingling.kong@intel.com>
* gcc.target/i386/raoint-atomic-fetch.c: New test.
2022-11-07 konglin1 <lingling.kong@intel.com>
* g++.dg/other/i386-2.C: Add -mraoint.
* g++.dg/other/i386-3.C: Ditto.
* gcc.target/i386/funcspec-56.inc: Add new target attribute.
* gcc.target/i386/sse-12.c: Add -mraoint.
* gcc.target/i386/sse-13.c: Ditto.
* gcc.target/i386/sse-14.c: Ditto.
* gcc.target/i386/sse-22.c: Add raoint target.
* gcc.target/i386/sse-23.c: Ditto.
* lib/target-supports.exp: Add check_effective_target_raoint.
* gcc.target/i386/rao-helper.h: New test.
* gcc.target/i386/raoint-1.c: Ditto.
* gcc.target/i386/raoint-aadd-2.c: Ditto.
* gcc.target/i386/raoint-aand-2.c: Ditto.
* gcc.target/i386/raoint-aor-2.c: Ditto.
* gcc.target/i386/raoint-axor-2.c: Ditto.
* gcc.target/i386/x86gprintrin-1.c: Ditto.
* gcc.target/i386/x86gprintrin-2.c: Ditto.
* gcc.target/i386/x86gprintrin-3.c: Ditto.
* gcc.target/i386/x86gprintrin-4.c: Ditto.
* gcc.target/i386/x86gprintrin-5.c: Ditto.
2022-11-07 Haochen Jiang <haochen.jiang@intel.com>
* g++.target/i386/mv16.C: Add graniterapids.
* gcc.target/i386/funcspec-56.inc: Handle new march.
2022-11-07 Haochen Jiang <haochen.jiang@intel.com>
Hongtao Liu <hongtao.liu@intel.com>
* g++.dg/other/i386-2.C: Add -mprefetchi.
* g++.dg/other/i386-3.C: Ditto.
* gcc.target/i386/avx-1.c: Ditto.
* gcc.target/i386/funcspec-56.inc: Add new target attribute.
* gcc.target/i386/sse-13.c: Add -mprefetchi.
* gcc.target/i386/sse-23.c: Ditto.
* gcc.target/i386/x86gprintrin-1.c: Ditto.
* gcc.target/i386/x86gprintrin-2.c: Ditto.
* gcc.target/i386/x86gprintrin-3.c: Ditto.
* gcc.target/i386/x86gprintrin-4.c: Ditto.
* gcc.target/i386/x86gprintrin-5.c: Ditto.
* gcc.target/i386/prefetchi-1.c: New test.
* gcc.target/i386/prefetchi-2.c: Ditto.
* gcc.target/i386/prefetchi-3.c: Ditto.
* gcc.target/i386/prefetchi-4.c: Ditto.
2022-11-06 Patrick Palka <ppalka@redhat.com>
* g++.dg/special/initpri3.C: New test.

View File

@ -18,3 +18,9 @@
// { dg-final { scan-assembler {_ZNK6l_var3MUlRT_IJXspT0_EEEE_clI1XJLi1ELi2ELi3EEEEDaS1_:} } }
// { dg-final { scan-assembler {_ZNK6l_var4MUlR1YIJDpT_EEE_clIJ1US6_EEEDaS3_:} } }
// { dg-final { scan-assembler {_ZZ2FnILi1EEvvENKUlT_E_clIiEEDaS0_:} } }
// { dg-final { scan-assembler {_ZZ1fvENKUlT_E_clIcLc0EEEDaS_:} } }
// { dg-final { scan-assembler {_ZZ1fvENKUlT_E_clIiLi0EEEDaS_:} } }
// { dg-final { scan-assembler {_ZZZ1fvENKUlT_E_clIcLc0EEEDaS_ENKUlcS_E_clIcEEDacS_:} } }
// { dg-final { scan-assembler {_ZZZ1fvENKUlT_E_clIiLi0EEEDaS_ENKUliS_E_clIiEEDaiS_:} } }
// { dg-final { scan-assembler {_ZZ1fvENKUlP1UIT_Lj0EEPS_IiLj0EEE0_clIcEEDaS2_S4_:} } }

Some files were not shown because too many files have changed in this diff Show More