[multiple changes]

2014-06-13  Robert Dewar  <dewar@adacore.com>

	* 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  <dismukes@adacore.com>

	* 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.

From-SVN: r211610
This commit is contained in:
Arnaud Charlet 2014-06-13 11:38:29 +02:00
parent ca6cbdca8a
commit 28bc33232d
10 changed files with 283 additions and 92 deletions

View File

@ -1,3 +1,33 @@
2014-06-13 Robert Dewar <dewar@adacore.com>
* 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 <dismukes@adacore.com>
* 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 <hubicka@ucw.cz> 2014-06-12 Jan Hubicka <hubicka@ucw.cz>
* gcc-interface/utils.c (process_attributes) <ATTR_LINK_SECTION>: Pass * gcc-interface/utils.c (process_attributes) <ATTR_LINK_SECTION>: Pass

View File

@ -6,7 +6,7 @@
-- -- -- --
-- B o d y -- -- 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 -- -- 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- -- -- terms of the GNU General Public License as published by the Free Soft- --
@ -24,6 +24,7 @@
------------------------------------------------------------------------------ ------------------------------------------------------------------------------
with Atree; use Atree; with Atree; use Atree;
with Csets; use Csets;
with Debug; use Debug; with Debug; use Debug;
with Elists; use Elists; with Elists; use Elists;
with Errout; use Errout; with Errout; use Errout;
@ -33,13 +34,14 @@ with Opt; use Opt;
with Osint.C; use Osint.C; with Osint.C; use Osint.C;
with Namet; use Namet; with Namet; use Namet;
with Nlists; use Nlists; with Nlists; use Nlists;
with Nmake; use Nmake;
with Restrict; use Restrict;
with Stand; use Stand; with Stand; use Stand;
with Sinput; use Sinput; with Sinput; use Sinput;
with Stringt; use Stringt; with Stringt; use Stringt;
with Switch; use Switch; with Switch; use Switch;
with Switch.C; use Switch.C; with Switch.C; use Switch.C;
with System; use System; with System; use System;
with Types; use Types;
with System.OS_Lib; use System.OS_Lib; with System.OS_Lib; use System.OS_Lib;
@ -163,6 +165,15 @@ package body Back_End is
gigi_operating_mode => Mode); gigi_operating_mode => Mode);
end Call_Back_End; 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 -- -- Len_Arg --
------------- -------------
@ -178,6 +189,36 @@ package body Back_End is
raise Program_Error; raise Program_Error;
end Len_Arg; 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 -- -- Scan_Compiler_Arguments --
----------------------------- -----------------------------
@ -342,13 +383,13 @@ package body Back_End is
end loop; end loop;
end Scan_Compiler_Arguments; 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 begin
null; Restrict.Set_Restriction_No_Dependence (Unit, Warn => False);
end Gen_Or_Update_Object_File; end Set_RND;
end Back_End; end Back_End;

View File

@ -6,7 +6,7 @@
-- -- -- --
-- S p e c -- -- 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 -- -- 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- -- -- 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 -- 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 package Back_End is
@ -82,4 +86,13 @@ package Back_End is
-- object file's timestamp is correct when compared with the corresponding -- object file's timestamp is correct when compared with the corresponding
-- ali file by gnatmake. -- 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; end Back_End;

View File

@ -101,9 +101,9 @@ package Einfo is
-- pragma Inline declarations -- pragma Inline declarations
-- This order must be observed. There are no restrictions on the procedures, -- 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 -- since the C header file only includes functions (The back end is not
-- modify the generated tree). However, functions are required to have headers -- allowed to modify the generated tree). However, functions are required to
-- that fit on a single line. -- have headers that fit on a single line.
-- XEINFO reads and processes the function specs and the pragma Inlines. For -- XEINFO reads and processes the function specs and the pragma Inlines. For
-- functions that are declared as inlined, XEINFO reads the corresponding body -- 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, -- 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 -- 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 -- -- Handling of Type'Size Values --
@ -378,16 +378,16 @@ package Einfo is
-- the N_Attribute_Definition_Clause node. Empty if no Address clause. -- the N_Attribute_Definition_Clause node. Empty if no Address clause.
-- The expression in the address clause is always a constant that is -- The expression in the address clause is always a constant that is
-- defined before the entity to which the address clause applies. -- 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) -- Address_Taken (Flag104)
-- Defined in all entities. Set if the Address or Unrestricted_Access -- Defined in all entities. Set if the Address or Unrestricted_Access
-- attribute is applied directly to the entity, i.e. the entity is the -- 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 of the prefix of the attribute reference. Also set if the
-- entity is the second argument of an Asm_Input or Asm_Output attribute, -- 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 -- as the construct may entail taking its address. Used by the backend to
-- sure that the address can be meaningfully taken, and also in the case -- make sure that the address can be meaningfully taken, and also in the
-- of subprograms to control output of certain warnings. -- case of subprograms to control output of certain warnings.
-- Aft_Value (synthesized) -- Aft_Value (synthesized)
-- Applies to fixed and decimal types. Computes a universal integer -- 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 -- 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 -- 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 -- 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 -- alignment field is also defined in E_Exception entities, but there it
-- is used only by the back-end for back annotation. -- 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] -- Can_Use_Internal_Rep (Flag229) [base type only]
-- Defined in Access_Subprogram_Kind nodes. This flag is set by the -- 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 -- must represent the type in the same way as Convention-C types (and
-- other foreign-convention types). On many targets, this means that -- other foreign-convention types). On many targets, this means that
-- the back end will use dynamically generated trampolines for nested -- the backend will use dynamically generated trampolines for nested
-- subprograms. True means that the back end can represent the type in -- subprograms. True means that the backend can represent the type in
-- some internal way. On the aforementioned targets, this means that the -- 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 -- must be False if Has_Foreign_Convention is True; otherwise, the front
-- end is free to set the policy. -- end is free to set the policy.
-- --
@ -568,11 +568,11 @@ package Einfo is
-- table that has the character string of the identifier, character -- table that has the character string of the identifier, character
-- literal or operator symbol. See Namet for further details. Note that -- literal or operator symbol. See Namet for further details. Note that
-- throughout the processing of the front end, this name is the simple -- throughout the processing of the front end, this name is the simple
-- unqualified name. However, just before gigi is called, a call is made -- unqualified name. However, just before the backend is called, a call
-- to Qualify_All_Entity_Names. This causes entity names to be qualified -- is made to Qualify_All_Entity_Names. This causes entity names to be
-- using the encoding described in exp_dbug.ads, and from that point on -- qualified using the encoding described in exp_dbug.ads, and from that
-- (including post gigi steps such as cross-reference generation), the -- point (including post backend steps, e.g. cross-reference generation),
-- entities will contain the encoded qualified names. -- the entities will contain the encoded qualified names.
-- Checks_May_Be_Suppressed (Flag31) -- Checks_May_Be_Suppressed (Flag31)
-- Defined in all entities. Set if a pragma Suppress or Unsuppress -- 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 -- Note: Component_Bit_Offset is redundant with respect to the fields
-- Normalized_First_Bit and Normalized_Position, and could in principle -- Normalized_First_Bit and Normalized_Position, and could in principle
-- be eliminated, but it is convenient in several situations, including -- 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) -- Component_Clause (Node13)
-- Defined in record components and discriminants. If a record -- 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 -- to the entity, or if internal processing in the compiler determines
-- that suppression of debug information is desirable. Note that this -- 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 -- 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. -- always test Needs_Debug_Info, it should never test Debug_Info_Off.
-- Debug_Renaming_Link (Node25) -- Debug_Renaming_Link (Node25)
@ -1088,7 +1088,7 @@ package Einfo is
-- Defined in class wide types and subtypes, access to protected -- Defined in class wide types and subtypes, access to protected
-- subprogram types, and in exception types. For a classwide type, it -- subprogram types, and in exception types. For a classwide type, it
-- is always Empty. For a class wide subtype, it points to an entity -- 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 -- equivalent of the class subtype with a known size (given by an
-- initial value). See Exp_Util.Expand_Class_Wide_Subtype for further -- initial value). See Exp_Util.Expand_Class_Wide_Subtype for further
-- details. For E_Exception_Type, this points to the record containing -- 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 -- of a component to be set without a component clause defined, which
-- means that the component size is specified, but not the position. -- means that the component size is specified, but not the position.
-- See also RM_Size and the section on "Handling of Type'Size Values". -- See also RM_Size and the section on "Handling of Type'Size Values".
-- During gigi processing, the value is back annotated for all zero -- During backend processing, the value is back annotated for all zero
-- values, so that after the call to gigi, the value is properly set. -- values, so that after the call to the backend, the value is set.
-- Etype (Node5) -- Etype (Node5)
-- Defined in all entities. Represents the type of the entity, which -- Defined in all entities. Represents the type of the entity, which
@ -1309,7 +1309,7 @@ package Einfo is
-- Thread_Local_Storage pragma -- Thread_Local_Storage pragma
-- --
-- If any of these items are present, then the flag Has_Gigi_Rep_Item is -- 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 -- Other representation items are included in the chain so that error
-- messages can easily locate the relevant nodes for posting errors. -- messages can easily locate the relevant nodes for posting errors.
@ -1558,8 +1558,8 @@ package Einfo is
-- Has_Gigi_Rep_Item (Flag82) -- Has_Gigi_Rep_Item (Flag82)
-- Defined in all entities. Set if the rep item chain (referenced by -- 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 -- 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. -- representation item that needs to be specially processed by the back
-- one of the following items: -- end, i.e. one of the following items:
-- --
-- Machine_Attribute pragma -- Machine_Attribute pragma
-- Linker_Alias pragma -- Linker_Alias pragma
@ -1568,13 +1568,13 @@ package Einfo is
-- Weak_External pragma -- Weak_External pragma
-- Thread_Local_Storage pragma -- Thread_Local_Storage pragma
-- --
-- If this flag is set, then Gigi should scan the rep item chain to -- If this flag is set, then the backend should scan the rep item chain
-- process any of these items that appear. At least one such item will -- to process any of these items that appear. At least one such item will
-- be present. -- be present.
-- --
-- Has_Homonym (Flag56) -- Has_Homonym (Flag56)
-- Defined in all entities. Set if an entity has a homonym in the same -- 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) -- Has_Implicit_Dereference (Flag251)
-- Defined in types and discriminants. Set if the type has an aspect -- 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 -- scope that has an exception handler and the two scopes are in the
-- same procedure. This is used by the backend for controlling certain -- same procedure. This is used by the backend for controlling certain
-- optimizations to ensure that they are consistent with exceptions. -- 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) -- Has_Non_Null_Refinement (synth)
-- Defined in E_Abstract_State entities. True if the state has at least -- 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 -- by the expander to represent a task or protected type. For every
-- concurrent type, such as record type is constructed, and task and -- concurrent type, such as record type is constructed, and task and
-- protected objects are instances of this record type at runtime -- protected objects are instances of this record type at runtime
-- (Gigi will replace declarations of the concurrent type using the -- (The backend will replace declarations of the concurrent type using
-- declarations of the corresponding record type). See package Exp_Ch9 -- the declarations of the corresponding record type). See Exp_Ch9 for
-- for further details. -- further details.
-- Is_Concurrent_Type (synthesized) -- Is_Concurrent_Type (synthesized)
-- Applies to all entities, true for task types and subtypes and for -- 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 -- 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 -- Is_Constr_Subt_For_U_Nominal is also set. It indicates that in
-- addition the object concerned is aliased. This flag is used by -- 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) -- Is_Constructor (Flag76)
-- Defined in function and procedure entities. Set if a pragma -- Defined in function and procedure entities. Set if a pragma
@ -2497,9 +2497,9 @@ package Einfo is
-- Is_Itype (Flag91) -- Is_Itype (Flag91)
-- Defined in all entities. Set to indicate that a type is an Itype, -- Defined in all entities. Set to indicate that a type is an Itype,
-- which means that the declaration for the type does not appear -- which means that the declaration for the type does not appear
-- explicitly in the tree. Instead gigi will elaborate the type when it -- explicitly in the tree. Instead the backend will elaborate the type
-- is first used. Has_Delayed_Freeze can be set for Itypes, and the -- when it is first used. Has_Delayed_Freeze can be set for Itypes, and
-- meaning is that the first use (the one which causes the type to be -- 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 -- 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 -- 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. -- 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 -- The flag is dynamically set and reset as semantic analysis and
-- expansion proceeds. Its value is meaningless once the tree is -- expansion proceeds. Its value is meaningless once the tree is
-- fully constructed, since it simply indicates the last state. -- 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) -- Is_Known_Null (Flag204)
-- Defined in all entities. Relevant (and can be set ) only for -- 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 -- For objects, the flag indicates the state of knowledge about the
-- current value of the object. This may be modified during expansion, -- 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 -- 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 -- 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 -- The flag is dynamically set and reset as semantic analysis and
-- expansion proceeds. Its value is meaningless once the tree is -- expansion proceeds. Its value is meaningless once the tree is
-- fully constructed, since it simply indicates the last state. -- 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) -- Is_Limited_Composite (Flag106)
-- Defined in all entities. Set for composite types that have a limited -- 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 -- 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 -- 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 -- 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 -- entity. It is used by the backend to activate the special processing
-- types (unchecked conversions that would not otherwise be allowed are -- for such types (unchecked conversions that would not otherwise be
-- allowed for such types). If the Is_Packed_Array_Type flag is set in -- allowed are allowed for such types). If the Is_Packed_Array_Type flag
-- an entity, then the Original_Array_Type field of this entity points -- is set in an entity, then the Original_Array_Type field of this entity
-- to the original array type for which this is the packed array type. -- points to the array type for which this is the packed array type.
-- Is_Potentially_Use_Visible (Flag9) -- Is_Potentially_Use_Visible (Flag9)
-- Defined in all entities. Set if entity is potentially use visible, -- 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 -- Defined in all entities. Set to indicate that an entity defined in
-- one compilation unit can be referenced from other compilation units. -- one compilation unit can be referenced from other compilation units.
-- If this reference causes a reference in the generated variable, for -- If this reference causes a reference in the generated variable, for
-- example in the case of a variable name, then Gigi will generate an -- example in the case of a variable name, then the backend will generate
-- appropriate external name for use by the linker. -- an appropriate external name for use by the linker.
-- Is_Protected_Record_Type (synthesized) -- Is_Protected_Record_Type (synthesized)
-- Applies to all entities, true if Is_Concurrent_Record_Type is true and -- 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 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- -- 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 -- 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. -- to indicate code generation requirements for volatile variables.
-- Similarly, any front end test which is concerned with suppressing -- Similarly, any front end test which is concerned with suppressing
-- optimizations on volatile objects should test Treat_As_Volatile -- 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 -- 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 -- must always be allocated on a byte boundary (more accurately a storage
-- unit boundary). The front end checks that component clauses respect -- 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 -- 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. -- 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 -- Comes_From_Source set, and also transitively for entities associated
-- with such components (e.g. their types). It is true for all entities -- 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 -- 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 -- debugging information for an entity. Note that callers should always
-- use Sem_Util.Set_Debug_Info_Needed, rather than Set_Needs_Debug_Info, -- use Sem_Util.Set_Debug_Info_Needed, rather than Set_Needs_Debug_Info,
-- so that the flag is set properly on subsidiary entities. -- so that the flag is set properly on subsidiary entities.
@ -3283,7 +3283,7 @@ package Einfo is
-- Next_Inlined_Subprogram (Node12) -- Next_Inlined_Subprogram (Node12)
-- Defined in subprograms. Used to chain inlined subprograms used in -- Defined in subprograms. Used to chain inlined subprograms used in
-- the current compilation, in the order in which they must be compiled -- 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) -- Next_Literal (synthesized)
-- Applies to enumeration literals, returns the next literal, or -- 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). -- there are default discriminants, and also for the 'Size value).
-- No_Strict_Aliasing (Flag136) [base type only] -- 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 -- optimizations based on an assumption about the aliasing status of
-- objects designated by the access type. For the case of the gcc -- 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 -- the type were compiled with -fno-strict-aliasing. This flag is
-- set if an unchecked conversion with the access type as a target -- set if an unchecked conversion with the access type as a target
-- type occurs in the same source unit as the declaration of the -- 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. -- types, it is cheaper to do the copy.
-- OK_To_Reorder_Components (Flag239) [base type only] -- 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 -- the components. If not set, the record must be layed out in the order
-- in which the components are declared textually. Currently this flag -- in which the components are declared textually. Currently this flag
-- can only be set by debug switches. -- can only be set by debug switches.
@ -3413,9 +3413,9 @@ package Einfo is
-- In base tagged types: -- In base tagged types:
-- When the component is inherited in a record extension, it points -- When the component is inherited in a record extension, it points
-- to the original component (the entity of the ancestor component -- to the original component (the entity of the ancestor component
-- which is not itself inherited) otherwise it points to itself. -- which is not itself inherited) otherwise it points to itself. The
-- Gigi uses this attribute to implement the automatic dereference in -- backend uses this attribute to implement the automatic dereference
-- the extension and to apply the transformation: -- in the extension and to apply the transformation:
-- --
-- Rec_Ext.Comp -> Rec_Ext.Parent. ... .Parent.Comp -- 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 -- be set as a result of situations (such as address overlays) where
-- the front end wishes to force volatile handling to inhibit aliasing -- the front end wishes to force volatile handling to inhibit aliasing
-- optimization which might be legally ok, but is undesirable. Note -- 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 -- The front end tests Is_Volatile if it is concerned with legality
-- checks associated with declared volatile variables, but if the test -- checks associated with declared volatile variables, but if the test
-- is for the purposes of suppressing optimizations, then the front -- 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 -- 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 -- 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 -- 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 -- 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 -- constraint as the declaration for T. The declaration for this subtype
-- is built at the point of the declaration of T, either as completion, -- 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. -- In addition, we define the kind E_Allocator_Type to label allocators.
-- This is because special resolution rules apply to this construct. -- This is because special resolution rules apply to this construct.
-- Eventually the constructs are labeled with the access type imposed by -- 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 -- Similarly, the type E_Access_Attribute_Type is used as the initial kind
-- associated with an access attribute. After resolution a specific access -- 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 -- objects using 'Reference. This is needed because special resolution
-- rules apply to these constructs. On the resolution pass, this type -- rules apply to these constructs. On the resolution pass, this type
-- is almost always replaced by the actual access type, but if the -- is almost always replaced by the actual access type, but if the
-- context does not provide one Gigi can handle the Allocator_Type -- context does not provide one, the backend will see Allocator_Type
-- itself as long as it has been frozen. -- itself (which will already have been frozen).
E_General_Access_Type, E_General_Access_Type,
-- An access type created by an access type declaration with the all -- An access type created by an access type declaration with the all

View File

@ -6,7 +6,7 @@
-- -- -- --
-- B o d y -- -- 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 -- -- 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- -- -- terms of the GNU General Public License as published by the Free Soft- --
@ -80,7 +80,6 @@ begin
-- since it uses names table entries. -- since it uses names table entries.
Rtsfind.Initialize; Rtsfind.Initialize;
Atree.Initialize;
Nlists.Initialize; Nlists.Initialize;
Elists.Initialize; Elists.Initialize;
Lib.Load.Initialize; Lib.Load.Initialize;

View File

@ -81,6 +81,10 @@ with Validsw; use Validsw;
with System.Assertions; with System.Assertions;
--------------
-- Gnat1drv --
--------------
procedure Gnat1drv is procedure Gnat1drv is
Main_Unit_Node : Node_Id; Main_Unit_Node : Node_Id;
-- Compilation unit node for main unit -- Compilation unit node for main unit
@ -763,6 +767,7 @@ begin
Scan_Compiler_Arguments; Scan_Compiler_Arguments;
Osint.Add_Default_Search_Dirs; Osint.Add_Default_Search_Dirs;
Atree.Initialize;
Nlists.Initialize; Nlists.Initialize;
Sinput.Initialize; Sinput.Initialize;
Sem.Initialize; Sem.Initialize;
@ -785,7 +790,7 @@ begin
-- Acquire target parameters from system.ads (source of package System) -- Acquire target parameters from system.ads (source of package System)
declare Targparm_Acquire : declare
use Sinput; use Sinput;
S : Source_File_Index; S : Source_File_Index;
@ -812,12 +817,17 @@ begin
Targparm.Get_Target_Parameters Targparm.Get_Target_Parameters
(System_Text => Source_Text (S), (System_Text => Source_Text (S),
Source_First => Source_First (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 -- Acquire configuration pragma information from Targparm
Restrict.Restrictions := Targparm.Restrictions_On_Target; Restrict.Restrictions := Targparm.Restrictions_On_Target;
end; end Targparm_Acquire;
-- Perform various adjustments and settings of global switches
Adjust_Global_Switches; Adjust_Global_Switches;

View File

@ -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 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 either an unsigned or signed type. It has the effect of providing the
five shift operators (Shift_Left, Shift_Right, Shift_Right_Arithmetic, 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 including the function declarations for these five operators, together
with the pragma Import (Intrinsic, ...) statements. with the pragma Import (Intrinsic, ...) statements.

View File

@ -8066,7 +8066,8 @@ package body Sem_Prag is
then then
-- If the name is overloaded, pragma applies to all of the denoted -- If the name is overloaded, pragma applies to all of the denoted
-- entities in the same declarative part, unless the pragma comes -- 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; Hom_Id := Def_Id;
while Present (Hom_Id) loop while Present (Hom_Id) loop
@ -8178,6 +8179,19 @@ package body Sem_Prag is
elsif From_Aspect_Specification (N) then elsif From_Aspect_Specification (N) then
exit; 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 else
Hom_Id := Homonym (Hom_Id); Hom_Id := Homonym (Hom_Id);
end if; end if;
@ -9576,12 +9590,6 @@ package body Sem_Prag is
elsif Import_Interface_Present (N) then elsif Import_Interface_Present (N) then
goto OK; 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 -- Error if being set Imported twice
else else

View File

@ -6,7 +6,7 @@
-- -- -- --
-- B o d y -- -- 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 -- -- 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- -- -- 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 -- 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; Text : Source_Buffer_Ptr;
Hi : Source_Ptr; Hi : Source_Ptr;
@ -183,7 +187,10 @@ package body Targparm is
Get_Target_Parameters Get_Target_Parameters
(System_Text => Text, (System_Text => Text,
Source_First => 0, 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; end Get_Target_Parameters;
-- Version where caller supplies system.ads text -- Version where caller supplies system.ads text
@ -191,7 +198,10 @@ package body Targparm is
procedure Get_Target_Parameters procedure Get_Target_Parameters
(System_Text : Source_Buffer_Ptr; (System_Text : Source_Buffer_Ptr;
Source_First : Source_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 is
P : Source_Ptr; P : Source_Ptr;
-- Scans source buffer containing source of system.ads -- Scans source buffer containing source of system.ads
@ -341,6 +351,61 @@ package body Targparm is
null; null;
end loop Ploop; 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; Set_Standard_Error;
Write_Line Write_Line
("fatal error: system.ads is incorrectly formatted"); ("fatal error: system.ads is incorrectly formatted");

View File

@ -6,7 +6,7 @@
-- -- -- --
-- S p e c -- -- 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 -- -- 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- -- -- 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 -- 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 -- 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 -- 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 procedure Get_Target_Parameters
(System_Text : Source_Buffer_Ptr; (System_Text : Source_Buffer_Ptr;
Source_First : Source_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 -- Called at the start of execution to obtain target parameters from
-- the source of package System. The parameters provide the source -- the source of package System. The parameters provide the source
-- text to be scanned (in System_Text (Source_First .. Source_Last)). -- 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 -- 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 -- 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 -- (e.g. the compiler) and uses this simpler interface if system.ads is