diff --git a/gcc/ada/ChangeLog b/gcc/ada/ChangeLog index 6e2e8a71fdcf..b2cdbc578b8b 100644 --- a/gcc/ada/ChangeLog +++ b/gcc/ada/ChangeLog @@ -1,3 +1,33 @@ +2014-06-13 Robert Dewar + + * back_end.adb (Make_Id): New function. + (Make_SC): New function. + (Set_RND): New procedure. + * back_end.ads (Make_Id): New function. + (Make_SC): New function. + (Set_RND): New procedure. + * einfo.ads: Minor comment updates. + * frontend.adb: Move Atree.Initialize call to Gnat1drv. + * gnat1drv.adb (Gnat1drv): New calling sequence for + Get_Target_Parameters. + (Gnat1drv): Move Atree.Initialize here from Frontend. + * targparm.adb (Get_Target_Parameters): New calling + sequence (Get_Target_Parameters): Handle pragma Restriction + (No_Dependence,..) + * targparm.ads (Get_Target_Parameters): New calling sequence. + +2014-06-13 Gary Dismukes + + * sem_prag.adb (Process_Import_Or_Interface): Exit the homonym + loop if the pragma does not come from source, so that an implicit + pragma Import only applies to the first declaration, avoiding + possible conflicts with earlier explicit and implicit declarations + due to multiple Provide_Shift_Operators pragmas. + (Set_Imported): Remove previous fix that bypassed pragma duplication + error. + * gnat_rm.texi: Change 'equivalent' to 'similar' in description + of Provide_Shift_Operators. + 2014-06-12 Jan Hubicka * gcc-interface/utils.c (process_attributes) : Pass diff --git a/gcc/ada/back_end.adb b/gcc/ada/back_end.adb index bb442ad5e531..6c763ced348e 100644 --- a/gcc/ada/back_end.adb +++ b/gcc/ada/back_end.adb @@ -6,7 +6,7 @@ -- -- -- B o d y -- -- -- --- Copyright (C) 1992-2013, Free Software Foundation, Inc. -- +-- Copyright (C) 1992-2014, Free Software Foundation, Inc. -- -- -- -- GNAT is free software; you can redistribute it and/or modify it under -- -- terms of the GNU General Public License as published by the Free Soft- -- @@ -24,6 +24,7 @@ ------------------------------------------------------------------------------ with Atree; use Atree; +with Csets; use Csets; with Debug; use Debug; with Elists; use Elists; with Errout; use Errout; @@ -33,13 +34,14 @@ with Opt; use Opt; with Osint.C; use Osint.C; with Namet; use Namet; with Nlists; use Nlists; +with Nmake; use Nmake; +with Restrict; use Restrict; with Stand; use Stand; with Sinput; use Sinput; with Stringt; use Stringt; with Switch; use Switch; with Switch.C; use Switch.C; with System; use System; -with Types; use Types; with System.OS_Lib; use System.OS_Lib; @@ -163,6 +165,15 @@ package body Back_End is gigi_operating_mode => Mode); end Call_Back_End; + ------------------------------- + -- Gen_Or_Update_Object_File -- + ------------------------------- + + procedure Gen_Or_Update_Object_File is + begin + null; + end Gen_Or_Update_Object_File; + ------------- -- Len_Arg -- ------------- @@ -178,6 +189,36 @@ package body Back_End is raise Program_Error; end Len_Arg; + ------------- + -- Make_Id -- + ------------- + + function Make_Id (Str : Text_Buffer) return Node_Id is + begin + Name_Len := 0; + + for J in Str'Range loop + Name_Len := Name_Len + 1; + Name_Buffer (Name_Len) := Fold_Lower (Str (J)); + end loop; + + return + Make_Identifier (System_Location, + Chars => Name_Find); + end Make_Id; + + ------------- + -- Make_SC -- + ------------- + + function Make_SC (Pre, Sel : Node_Id) return Node_Id is + begin + return + Make_Selected_Component (System_Location, + Prefix => Pre, + Selector_Name => Sel); + end Make_SC; + ----------------------------- -- Scan_Compiler_Arguments -- ----------------------------- @@ -342,13 +383,13 @@ package body Back_End is end loop; end Scan_Compiler_Arguments; - ------------------------------- - -- Gen_Or_Update_Object_File -- - ------------------------------- + ------------- + -- Set_RND -- + ------------- - procedure Gen_Or_Update_Object_File is + procedure Set_RND (Unit : Node_Id) is begin - null; - end Gen_Or_Update_Object_File; + Restrict.Set_Restriction_No_Dependence (Unit, Warn => False); + end Set_RND; end Back_End; diff --git a/gcc/ada/back_end.ads b/gcc/ada/back_end.ads index 9e28a6ed6f34..d301791fee25 100644 --- a/gcc/ada/back_end.ads +++ b/gcc/ada/back_end.ads @@ -6,7 +6,7 @@ -- -- -- S p e c -- -- -- --- Copyright (C) 1992-2013, Free Software Foundation, Inc. -- +-- Copyright (C) 1992-2014, Free Software Foundation, Inc. -- -- -- -- GNAT is free software; you can redistribute it and/or modify it under -- -- terms of the GNU General Public License as published by the Free Soft- -- @@ -24,6 +24,10 @@ ------------------------------------------------------------------------------ -- Call the back end with all the information needed +-- Note: there are multiple bodies/variants of this package, so do not +-- modify this spec without coordination. + +with Types; use Types; package Back_End is @@ -82,4 +86,13 @@ package Back_End is -- object file's timestamp is correct when compared with the corresponding -- ali file by gnatmake. + function Make_Id (Str : Text_Buffer) return Node_Id; + function Make_SC (Pre, Sel : Node_Id) return Node_Id; + procedure Set_RND (Unit : Node_Id); + -- Subprograms for call to Get_Target_Parameters, see spec of package + -- Targparm for full description of these three subprograms. These are + -- parked in this package because they are have to be at the top level + -- because of accessibility issues, and Gnat1drv, which is where they + -- are used, is a subprogram. + end Back_End; diff --git a/gcc/ada/einfo.ads b/gcc/ada/einfo.ads index fdadf4bc5fa7..6a62e2e7810f 100644 --- a/gcc/ada/einfo.ads +++ b/gcc/ada/einfo.ads @@ -101,9 +101,9 @@ package Einfo is -- pragma Inline declarations -- This order must be observed. There are no restrictions on the procedures, --- since the C header file only includes functions (Gigi is not allowed to --- modify the generated tree). However, functions are required to have headers --- that fit on a single line. +-- since the C header file only includes functions (The back end is not +-- allowed to modify the generated tree). However, functions are required to +-- have headers that fit on a single line. -- XEINFO reads and processes the function specs and the pragma Inlines. For -- functions that are declared as inlined, XEINFO reads the corresponding body @@ -121,7 +121,7 @@ package Einfo is -- For functions that are not inlined, there is no restriction on the body, -- and XEINFO generates a direct reference in the C header file which allows --- the C code in Gigi to directly call the corresponding Ada body. +-- the C code in the backend to directly call the corresponding Ada body. ---------------------------------- -- Handling of Type'Size Values -- @@ -378,16 +378,16 @@ package Einfo is -- the N_Attribute_Definition_Clause node. Empty if no Address clause. -- The expression in the address clause is always a constant that is -- defined before the entity to which the address clause applies. --- Note: Gigi references this field in E_Task_Type entities??? +-- Note: The backend references this field in E_Task_Type entities??? -- Address_Taken (Flag104) -- Defined in all entities. Set if the Address or Unrestricted_Access -- attribute is applied directly to the entity, i.e. the entity is the -- entity of the prefix of the attribute reference. Also set if the -- entity is the second argument of an Asm_Input or Asm_Output attribute, --- as the construct may entail taking its address. Used by Gigi to make --- sure that the address can be meaningfully taken, and also in the case --- of subprograms to control output of certain warnings. +-- as the construct may entail taking its address. Used by the backend to +-- make sure that the address can be meaningfully taken, and also in the +-- case of subprograms to control output of certain warnings. -- Aft_Value (synthesized) -- Applies to fixed and decimal types. Computes a universal integer @@ -415,7 +415,7 @@ package Einfo is -- object. A value of zero (Uint_0) indicates that the alignment has not -- been set yet. The alignment can be set by an explicit alignment -- clause, or set by the front-end in package Layout, or set by the --- back-end as part of the back end back-annotation process. The +-- back-end as part of the back-end back-annotation process. The -- alignment field is also defined in E_Exception entities, but there it -- is used only by the back-end for back annotation. @@ -534,13 +534,13 @@ package Einfo is -- Can_Use_Internal_Rep (Flag229) [base type only] -- Defined in Access_Subprogram_Kind nodes. This flag is set by the --- front end and used by the back end. False means that the back end +-- front end and used by the backend. False means that the backend -- must represent the type in the same way as Convention-C types (and -- other foreign-convention types). On many targets, this means that --- the back end will use dynamically generated trampolines for nested --- subprograms. True means that the back end can represent the type in +-- the backend will use dynamically generated trampolines for nested +-- subprograms. True means that the backend can represent the type in -- some internal way. On the aforementioned targets, this means that the --- back end will not use dynamically generated trampolines. This flag +-- backend will not use dynamically generated trampolines. This flag -- must be False if Has_Foreign_Convention is True; otherwise, the front -- end is free to set the policy. -- @@ -568,11 +568,11 @@ package Einfo is -- table that has the character string of the identifier, character -- literal or operator symbol. See Namet for further details. Note that -- throughout the processing of the front end, this name is the simple --- unqualified name. However, just before gigi is called, a call is made --- to Qualify_All_Entity_Names. This causes entity names to be qualified --- using the encoding described in exp_dbug.ads, and from that point on --- (including post gigi steps such as cross-reference generation), the --- entities will contain the encoded qualified names. +-- unqualified name. However, just before the backend is called, a call +-- is made to Qualify_All_Entity_Names. This causes entity names to be +-- qualified using the encoding described in exp_dbug.ads, and from that +-- point (including post backend steps, e.g. cross-reference generation), +-- the entities will contain the encoded qualified names. -- Checks_May_Be_Suppressed (Flag31) -- Defined in all entities. Set if a pragma Suppress or Unsuppress @@ -639,7 +639,7 @@ package Einfo is -- Note: Component_Bit_Offset is redundant with respect to the fields -- Normalized_First_Bit and Normalized_Position, and could in principle -- be eliminated, but it is convenient in several situations, including --- use in Gigi, to have this redundant field. +-- use in the backend, to have this redundant field. -- Component_Clause (Node13) -- Defined in record components and discriminants. If a record @@ -733,7 +733,7 @@ package Einfo is -- to the entity, or if internal processing in the compiler determines -- that suppression of debug information is desirable. Note that this -- flag is only for use by the front end as part of the processing for --- determining if Needs_Debug_Info should be set. The back end should +-- determining if Needs_Debug_Info should be set. The backend should -- always test Needs_Debug_Info, it should never test Debug_Info_Off. -- Debug_Renaming_Link (Node25) @@ -1088,7 +1088,7 @@ package Einfo is -- Defined in class wide types and subtypes, access to protected -- subprogram types, and in exception types. For a classwide type, it -- is always Empty. For a class wide subtype, it points to an entity --- created by the expander which gives Gigi an easily understandable +-- created by the expander which gives the backend an understandable -- equivalent of the class subtype with a known size (given by an -- initial value). See Exp_Util.Expand_Class_Wide_Subtype for further -- details. For E_Exception_Type, this points to the record containing @@ -1111,8 +1111,8 @@ package Einfo is -- of a component to be set without a component clause defined, which -- means that the component size is specified, but not the position. -- See also RM_Size and the section on "Handling of Type'Size Values". --- During gigi processing, the value is back annotated for all zero --- values, so that after the call to gigi, the value is properly set. +-- During backend processing, the value is back annotated for all zero +-- values, so that after the call to the backend, the value is set. -- Etype (Node5) -- Defined in all entities. Represents the type of the entity, which @@ -1309,7 +1309,7 @@ package Einfo is -- Thread_Local_Storage pragma -- -- If any of these items are present, then the flag Has_Gigi_Rep_Item is --- set, indicating that Gigi should search the chain. +-- set, indicating that the backend should search the chain. -- -- Other representation items are included in the chain so that error -- messages can easily locate the relevant nodes for posting errors. @@ -1558,8 +1558,8 @@ package Einfo is -- Has_Gigi_Rep_Item (Flag82) -- Defined in all entities. Set if the rep item chain (referenced by -- First_Rep_Item and linked through the Next_Rep_Item chain) contains a --- representation item that needs to be specially processed by Gigi, i.e. --- one of the following items: +-- representation item that needs to be specially processed by the back +-- end, i.e. one of the following items: -- -- Machine_Attribute pragma -- Linker_Alias pragma @@ -1568,13 +1568,13 @@ package Einfo is -- Weak_External pragma -- Thread_Local_Storage pragma -- --- If this flag is set, then Gigi should scan the rep item chain to --- process any of these items that appear. At least one such item will +-- If this flag is set, then the backend should scan the rep item chain +-- to process any of these items that appear. At least one such item will -- be present. -- -- Has_Homonym (Flag56) -- Defined in all entities. Set if an entity has a homonym in the same --- scope. Used by Gigi to generate unique names for such entities. +-- scope. Used by the backend to generate unique names for all entities. -- Has_Implicit_Dereference (Flag251) -- Defined in types and discriminants. Set if the type has an aspect @@ -1646,7 +1646,7 @@ package Einfo is -- scope that has an exception handler and the two scopes are in the -- same procedure. This is used by the backend for controlling certain -- optimizations to ensure that they are consistent with exceptions. --- See documentation in Gigi for further details. +-- See documentation in backend for further details. -- Has_Non_Null_Refinement (synth) -- Defined in E_Abstract_State entities. True if the state has at least @@ -2185,9 +2185,9 @@ package Einfo is -- by the expander to represent a task or protected type. For every -- concurrent type, such as record type is constructed, and task and -- protected objects are instances of this record type at runtime --- (Gigi will replace declarations of the concurrent type using the --- declarations of the corresponding record type). See package Exp_Ch9 --- for further details. +-- (The backend will replace declarations of the concurrent type using +-- the declarations of the corresponding record type). See Exp_Ch9 for +-- further details. -- Is_Concurrent_Type (synthesized) -- Applies to all entities, true for task types and subtypes and for @@ -2212,7 +2212,7 @@ package Einfo is -- Defined in all types and subtypes. This flag can be set only if -- Is_Constr_Subt_For_U_Nominal is also set. It indicates that in -- addition the object concerned is aliased. This flag is used by --- Gigi to determine whether a template must be constructed. +-- the backend to determine whether a template must be constructed. -- Is_Constructor (Flag76) -- Defined in function and procedure entities. Set if a pragma @@ -2497,9 +2497,9 @@ package Einfo is -- Is_Itype (Flag91) -- Defined in all entities. Set to indicate that a type is an Itype, -- which means that the declaration for the type does not appear --- explicitly in the tree. Instead gigi will elaborate the type when it --- is first used. Has_Delayed_Freeze can be set for Itypes, and the --- meaning is that the first use (the one which causes the type to be +-- explicitly in the tree. Instead the backend will elaborate the type +-- when it is first used. Has_Delayed_Freeze can be set for Itypes, and +-- the meaning is that the first use (the one which causes the type to be -- defined) will be the freeze node. Note that an important restriction -- on Itypes is that the first use of such a type (the one that causes it -- to be defined) must be in the same scope as the type. @@ -2523,7 +2523,7 @@ package Einfo is -- The flag is dynamically set and reset as semantic analysis and -- expansion proceeds. Its value is meaningless once the tree is -- fully constructed, since it simply indicates the last state. --- Thus this flag has no meaning to the back end. +-- Thus this flag has no meaning to the backend. -- Is_Known_Null (Flag204) -- Defined in all entities. Relevant (and can be set ) only for @@ -2552,7 +2552,7 @@ package Einfo is -- -- For objects, the flag indicates the state of knowledge about the -- current value of the object. This may be modified during expansion, --- and thus the final value is not relevant to gigi. +-- and thus the final value is not relevant to the backend. -- -- For types and subtypes, the flag is set if all possible bit patterns -- of length Object_Size (i.e. Esize of the type) represent valid values @@ -2567,7 +2567,7 @@ package Einfo is -- The flag is dynamically set and reset as semantic analysis and -- expansion proceeds. Its value is meaningless once the tree is -- fully constructed, since it simply indicates the last state. --- Thus this flag has no meaning to the back end. +-- Thus this flag has no meaning to the backend. -- Is_Limited_Composite (Flag106) -- Defined in all entities. Set for composite types that have a limited @@ -2709,11 +2709,11 @@ package Einfo is -- used to implement a packed array (either a modular type, or a subtype -- of Packed_Bytes{1,2,4} as appropriate). The flag is set if and only -- if the type appears in the Packed_Array_Type field of some other type --- entity. It is used by Gigi to activate the special processing for such --- types (unchecked conversions that would not otherwise be allowed are --- allowed for such types). If the Is_Packed_Array_Type flag is set in --- an entity, then the Original_Array_Type field of this entity points --- to the original array type for which this is the packed array type. +-- entity. It is used by the backend to activate the special processing +-- for such types (unchecked conversions that would not otherwise be +-- allowed are allowed for such types). If the Is_Packed_Array_Type flag +-- is set in an entity, then the Original_Array_Type field of this entity +-- points to the array type for which this is the packed array type. -- Is_Potentially_Use_Visible (Flag9) -- Defined in all entities. Set if entity is potentially use visible, @@ -2797,8 +2797,8 @@ package Einfo is -- Defined in all entities. Set to indicate that an entity defined in -- one compilation unit can be referenced from other compilation units. -- If this reference causes a reference in the generated variable, for --- example in the case of a variable name, then Gigi will generate an --- appropriate external name for use by the linker. +-- example in the case of a variable name, then the backend will generate +-- an appropriate external name for use by the linker. -- Is_Protected_Record_Type (synthesized) -- Applies to all entities, true if Is_Concurrent_Record_Type is true and @@ -3011,7 +3011,7 @@ package Einfo is -- and full view. The flag is not set reliably on private subtypes, -- and is always retrieved from the base type (but this is not a base- -- type-only attribute because it applies to other entities). Note that --- the back end should use Treat_As_Volatile, rather than Is_Volatile +-- the backend should use Treat_As_Volatile, rather than Is_Volatile -- to indicate code generation requirements for volatile variables. -- Similarly, any front end test which is concerned with suppressing -- optimizations on volatile objects should test Treat_As_Volatile @@ -3158,7 +3158,7 @@ package Einfo is -- Defined in entities for types and subtypes. Set if objects of the type -- must always be allocated on a byte boundary (more accurately a storage -- unit boundary). The front end checks that component clauses respect --- this rule, and the back end ensures that record packing does not +-- this rule, and the backend ensures that record packing does not -- violate this rule. Currently the flag is set only for packed arrays -- longer than 64 bits where the component size is not a power of 2. @@ -3175,7 +3175,7 @@ package Einfo is -- Comes_From_Source set, and also transitively for entities associated -- with such components (e.g. their types). It is true for all entities -- in Debug_Generated_Code mode (-gnatD switch). This is the flag that --- the back end should check to determine whether or not to generate +-- the backend should check to determine whether or not to generate -- debugging information for an entity. Note that callers should always -- use Sem_Util.Set_Debug_Info_Needed, rather than Set_Needs_Debug_Info, -- so that the flag is set properly on subsidiary entities. @@ -3283,7 +3283,7 @@ package Einfo is -- Next_Inlined_Subprogram (Node12) -- Defined in subprograms. Used to chain inlined subprograms used in -- the current compilation, in the order in which they must be compiled --- by Gigi to insure that all inlinings are performed. +-- by the backend to insure that all inlinings are performed. -- Next_Literal (synthesized) -- Applies to enumeration literals, returns the next literal, or @@ -3339,10 +3339,10 @@ package Einfo is -- there are default discriminants, and also for the 'Size value). -- No_Strict_Aliasing (Flag136) [base type only] --- Defined in access types. Set to direct the back end to avoid any +-- Defined in access types. Set to direct the backend to avoid any -- optimizations based on an assumption about the aliasing status of -- objects designated by the access type. For the case of the gcc --- back end, the effect is as though all references to objects of +-- backend, the effect is as though all references to objects of -- the type were compiled with -fno-strict-aliasing. This flag is -- set if an unchecked conversion with the access type as a target -- type occurs in the same source unit as the declaration of the @@ -3372,7 +3372,7 @@ package Einfo is -- types, it is cheaper to do the copy. -- OK_To_Reorder_Components (Flag239) [base type only] --- Defined in record types. Set if the back end is permitted to reorder +-- Defined in record types. Set if the backend is permitted to reorder -- the components. If not set, the record must be layed out in the order -- in which the components are declared textually. Currently this flag -- can only be set by debug switches. @@ -3413,9 +3413,9 @@ package Einfo is -- In base tagged types: -- When the component is inherited in a record extension, it points -- to the original component (the entity of the ancestor component --- which is not itself inherited) otherwise it points to itself. --- Gigi uses this attribute to implement the automatic dereference in --- the extension and to apply the transformation: +-- which is not itself inherited) otherwise it points to itself. The +-- backend uses this attribute to implement the automatic dereference +-- in the extension and to apply the transformation: -- -- Rec_Ext.Comp -> Rec_Ext.Parent. ... .Parent.Comp -- @@ -3999,7 +3999,7 @@ package Einfo is -- be set as a result of situations (such as address overlays) where -- the front end wishes to force volatile handling to inhibit aliasing -- optimization which might be legally ok, but is undesirable. Note --- that the back end always tests this flag rather than Is_Volatile. +-- that the backend always tests this flag rather than Is_Volatile. -- The front end tests Is_Volatile if it is concerned with legality -- checks associated with declared volatile variables, but if the test -- is for the purposes of suppressing optimizations, then the front @@ -4029,7 +4029,7 @@ package Einfo is -- the full view of a private type T is derived from another private type -- with discriminants Td, the full view of T is also private, and there -- is no way to attach to it a further full view that would convey the --- structure of T to the back end. The Underlying_Full_ View is an +-- structure of T to the backend. The Underlying_Full_ View is an -- attribute of the full view that is a subtype of Td with the same -- constraint as the declaration for T. The declaration for this subtype -- is built at the point of the declaration of T, either as completion, @@ -4222,7 +4222,7 @@ package Einfo is -- In addition, we define the kind E_Allocator_Type to label allocators. -- This is because special resolution rules apply to this construct. -- Eventually the constructs are labeled with the access type imposed by --- the context. Gigi should never see types with this Ekind. +-- the context. The backend should never see types with this Ekind. -- Similarly, the type E_Access_Attribute_Type is used as the initial kind -- associated with an access attribute. After resolution a specific access @@ -4409,8 +4409,8 @@ package Einfo is -- objects using 'Reference. This is needed because special resolution -- rules apply to these constructs. On the resolution pass, this type -- is almost always replaced by the actual access type, but if the - -- context does not provide one Gigi can handle the Allocator_Type - -- itself as long as it has been frozen. + -- context does not provide one, the backend will see Allocator_Type + -- itself (which will already have been frozen). E_General_Access_Type, -- An access type created by an access type declaration with the all diff --git a/gcc/ada/frontend.adb b/gcc/ada/frontend.adb index 2ead14c09da6..24b33cfe2096 100644 --- a/gcc/ada/frontend.adb +++ b/gcc/ada/frontend.adb @@ -6,7 +6,7 @@ -- -- -- B o d y -- -- -- --- Copyright (C) 1992-2013, Free Software Foundation, Inc. -- +-- Copyright (C) 1992-2014, Free Software Foundation, Inc. -- -- -- -- GNAT is free software; you can redistribute it and/or modify it under -- -- terms of the GNU General Public License as published by the Free Soft- -- @@ -80,7 +80,6 @@ begin -- since it uses names table entries. Rtsfind.Initialize; - Atree.Initialize; Nlists.Initialize; Elists.Initialize; Lib.Load.Initialize; diff --git a/gcc/ada/gnat1drv.adb b/gcc/ada/gnat1drv.adb index 87dcaca6afe2..3a390dcb3323 100644 --- a/gcc/ada/gnat1drv.adb +++ b/gcc/ada/gnat1drv.adb @@ -81,6 +81,10 @@ with Validsw; use Validsw; with System.Assertions; +-------------- +-- Gnat1drv -- +-------------- + procedure Gnat1drv is Main_Unit_Node : Node_Id; -- Compilation unit node for main unit @@ -763,6 +767,7 @@ begin Scan_Compiler_Arguments; Osint.Add_Default_Search_Dirs; + Atree.Initialize; Nlists.Initialize; Sinput.Initialize; Sem.Initialize; @@ -785,7 +790,7 @@ begin -- Acquire target parameters from system.ads (source of package System) - declare + Targparm_Acquire : declare use Sinput; S : Source_File_Index; @@ -812,12 +817,17 @@ begin Targparm.Get_Target_Parameters (System_Text => Source_Text (S), Source_First => Source_First (S), - Source_Last => Source_Last (S)); + Source_Last => Source_Last (S), + Make_Id => Back_End.Make_Id'Unrestricted_Access, + Make_SC => Back_End.Make_SC'Unrestricted_Access, + Set_RND => Back_End.Set_RND'Unrestricted_Access); -- Acquire configuration pragma information from Targparm Restrict.Restrictions := Targparm.Restrictions_On_Target; - end; + end Targparm_Acquire; + + -- Perform various adjustments and settings of global switches Adjust_Global_Switches; diff --git a/gcc/ada/gnat_rm.texi b/gcc/ada/gnat_rm.texi index c62579be45c7..0d86a40ccc28 100644 --- a/gcc/ada/gnat_rm.texi +++ b/gcc/ada/gnat_rm.texi @@ -5852,7 +5852,7 @@ pragma Provide_Shift_Operators (integer_first_subtype_LOCAL_NAME); This pragma can be applied to a first subtype local name that specifies either an unsigned or signed type. It has the effect of providing the five shift operators (Shift_Left, Shift_Right, Shift_Right_Arithmetic, -Rotate_Left and Rotate_Right) for the given type. It is equivalent to +Rotate_Left and Rotate_Right) for the given type. It is similar to including the function declarations for these five operators, together with the pragma Import (Intrinsic, ...) statements. diff --git a/gcc/ada/sem_prag.adb b/gcc/ada/sem_prag.adb index dc8b0e8cde10..0aca6646b72a 100644 --- a/gcc/ada/sem_prag.adb +++ b/gcc/ada/sem_prag.adb @@ -8066,7 +8066,8 @@ package body Sem_Prag is then -- If the name is overloaded, pragma applies to all of the denoted -- entities in the same declarative part, unless the pragma comes - -- from an aspect specification. + -- from an aspect specification or was generated by the compiler + -- (such as for pragma Provide_Shift_Operators). Hom_Id := Def_Id; while Present (Hom_Id) loop @@ -8178,6 +8179,19 @@ package body Sem_Prag is elsif From_Aspect_Specification (N) then exit; + -- If the pragma was created by the compiler, then we don't + -- want it to apply to other homonyms. This kind of case can + -- occur when using pragma Provide_Shift_Operators, which + -- generates implicit shift and rotate operators with Import + -- pragmas that might apply to earlier explicit or implicit + -- declarations marked with Import (for example, coming from + -- an earlier pragma Provide_Shift_Operators for another type), + -- and we don't generally want other homonyms being treated + -- as imported or the pragma flagged as an illegal duplicate. + + elsif not Comes_From_Source (N) then + exit; + else Hom_Id := Homonym (Hom_Id); end if; @@ -9576,12 +9590,6 @@ package body Sem_Prag is elsif Import_Interface_Present (N) then goto OK; - -- OK if the pragma was expanded by the compiler. Can occur when - -- using pragma Provide_Shift_Operators on multiple types. - - elsif not Comes_From_Source (N) then - goto OK; - -- Error if being set Imported twice else diff --git a/gcc/ada/targparm.adb b/gcc/ada/targparm.adb index 3357c5dfe0ee..0f93344ef378 100644 --- a/gcc/ada/targparm.adb +++ b/gcc/ada/targparm.adb @@ -6,7 +6,7 @@ -- -- -- B o d y -- -- -- --- Copyright (C) 1999-2013, Free Software Foundation, Inc. -- +-- Copyright (C) 1999-2014, Free Software Foundation, Inc. -- -- -- -- GNAT is free software; you can redistribute it and/or modify it under -- -- terms of the GNU General Public License as published by the Free Soft- -- @@ -160,7 +160,11 @@ package body Targparm is -- Version which reads in system.ads - procedure Get_Target_Parameters is + procedure Get_Target_Parameters + (Make_Id : Make_Id_Type := null; + Make_SC : Make_SC_Type := null; + Set_RND : Set_RND_Type := null) + is Text : Source_Buffer_Ptr; Hi : Source_Ptr; @@ -183,7 +187,10 @@ package body Targparm is Get_Target_Parameters (System_Text => Text, Source_First => 0, - Source_Last => Hi); + Source_Last => Hi, + Make_Id => Make_Id, + Make_SC => Make_SC, + Set_RND => Set_RND); end Get_Target_Parameters; -- Version where caller supplies system.ads text @@ -191,7 +198,10 @@ package body Targparm is procedure Get_Target_Parameters (System_Text : Source_Buffer_Ptr; Source_First : Source_Ptr; - Source_Last : Source_Ptr) + Source_Last : Source_Ptr; + Make_Id : Make_Id_Type := null; + Make_SC : Make_SC_Type := null; + Set_RND : Set_RND_Type := null) is P : Source_Ptr; -- Scans source buffer containing source of system.ads @@ -341,6 +351,61 @@ package body Targparm is null; end loop Ploop; + -- No_Dependence case + + if System_Text (P .. P + 16) = "No_Dependence => " then + P := P + 17; + + -- Skip this processing (and simply ignore No_Dependence lines) + -- if caller did not supply the three subprograms we need to + -- process these lines. + + if Make_Id = null then + goto Line_Loop_Continue; + end if; + + -- We have scanned out "pragma Restrictions (No_Dependence =>" + + declare + Unit : Node_Id; + Id : Node_Id; + Start : Source_Ptr; + + begin + Unit := Empty; + + -- Loop through components of name, building up Unit + + loop + Start := P; + while System_Text (P) /= '.' + and then + System_Text (P) /= ')' + loop + P := P + 1; + end loop; + + Id := Make_Id (System_Text (Start .. P - 1)); + + -- If first name, just capture the identifier + + if Unit = Empty then + Unit := Id; + else + Unit := Make_SC (Unit, Id); + end if; + + exit when System_Text (P) = ')'; + P := P + 1; + end loop; + + Set_RND (Unit); + goto Line_Loop_Continue; + end; + end if; + + -- Here if unrecognizable restrictions pragma form + Set_Standard_Error; Write_Line ("fatal error: system.ads is incorrectly formatted"); diff --git a/gcc/ada/targparm.ads b/gcc/ada/targparm.ads index 11c7a7edfb36..21f2d6db4161 100644 --- a/gcc/ada/targparm.ads +++ b/gcc/ada/targparm.ads @@ -6,7 +6,7 @@ -- -- -- S p e c -- -- -- --- Copyright (C) 1999-2013, Free Software Foundation, Inc. -- +-- Copyright (C) 1999-2014, Free Software Foundation, Inc. -- -- -- -- GNAT is free software; you can redistribute it and/or modify it under -- -- terms of the GNU General Public License as published by the Free Soft- -- @@ -612,17 +612,42 @@ package Targparm is -- These subprograms are used to initialize the target parameter values -- from the system.ads file. Note that this is only done once, so if more -- than one call is made to either routine, the second and subsequent - -- calls are ignored. + -- calls are ignored. It also reads restriction pragmas from system.ads + -- and records them, though as further detailed below, the caller has some + -- control over the handling of No_Dependence restrictions. + + type Make_Id_Type is access function (Str : Text_Buffer) return Node_Id; + -- Parameter type for Get_Target_Parameters for function that creates an + -- identifier node with Sloc value System_Location and given string as the + -- Chars value. + + type Make_SC_Type is access function (Pre, Sel : Node_Id) return Node_Id; + -- Parameter type for Get_Target_Parameters for function that creates a + -- selected component with Sloc value System_Location and given Prefix + -- (Pre) and Selector (Sel) values. + + type Set_RND_Type is access procedure (Unit : Node_Id); + -- Parameter type for Get_Target_Parameters that records a Restriction + -- No_Dependence for the given unit (identifier or selected component). procedure Get_Target_Parameters (System_Text : Source_Buffer_Ptr; Source_First : Source_Ptr; - Source_Last : Source_Ptr); + Source_Last : Source_Ptr; + Make_Id : Make_Id_Type := null; + Make_SC : Make_SC_Type := null; + Set_RND : Set_RND_Type := null); -- Called at the start of execution to obtain target parameters from -- the source of package System. The parameters provide the source -- text to be scanned (in System_Text (Source_First .. Source_Last)). + -- if the three subprograms are left at their default value of null, + -- Get_Target_Parameters will ignore pragma Restrictions No_Dependence + -- lines, otherwise it will use these three subprograms to record them. - procedure Get_Target_Parameters; + procedure Get_Target_Parameters + (Make_Id : Make_Id_Type := null; + Make_SC : Make_SC_Type := null; + Set_RND : Set_RND_Type := null); -- This version reads in system.ads using Osint. The idea is that the -- caller uses the first version if they have to read system.ads anyway -- (e.g. the compiler) and uses this simpler interface if system.ads is