Commit a96157e6 by Arnaud Charlet

[multiple changes]

2013-04-11  Eric Botcazou  <ebotcazou@adacore.com>

	* ttypes.ads, get_targ.ads: More minor rewording of comments.

2013-04-11  Johannes Kanig  <kanig@adacore.com>

	* debug.adb: Document use of switch -gnatd.Z.

2013-04-11  Hristian Kirtchev  <kirtchev@adacore.com>

	* sem_prag.adb (Analyze_Pragma): Both pragma Depends and Global can now
	support renamings of entire objects. Legal renamings are replaced by
	the object they rename.
	(Is_Renaming): New routine.

2013-04-11  Yannick Moy  <moy@adacore.com>

	* set_targ.adb, opt.ads: Minor changes in comments.

From-SVN: r197795
parent 88ff8916
2013-04-11 Eric Botcazou <ebotcazou@adacore.com>
* ttypes.ads, get_targ.ads: More minor rewording of comments.
2013-04-11 Johannes Kanig <kanig@adacore.com>
* debug.adb: Document use of switch -gnatd.Z.
2013-04-11 Hristian Kirtchev <kirtchev@adacore.com>
* sem_prag.adb (Analyze_Pragma): Both pragma Depends and Global can now
support renamings of entire objects. Legal renamings are replaced by
the object they rename.
(Is_Renaming): New routine.
2013-04-11 Yannick Moy <moy@adacore.com>
* set_targ.adb, opt.ads: Minor changes in comments.
2013-04-11 Ben Brosgol <brosgol@adacore.com> 2013-04-11 Ben Brosgol <brosgol@adacore.com>
* gnat_ugn.texi: Minor clean ups. * gnat_ugn.texi: Minor clean ups.
......
...@@ -143,7 +143,7 @@ package body Debug is ...@@ -143,7 +143,7 @@ package body Debug is
-- d.W Print out debugging information for Walk_Library_Items -- d.W Print out debugging information for Walk_Library_Items
-- d.X Use Expression_With_Actions -- d.X Use Expression_With_Actions
-- d.Y Do not use Expression_With_Actions -- d.Y Do not use Expression_With_Actions
-- d.Z -- d.Z Dump flow analysis graphs, for debugging purposes (gnat2why)
-- d1 Error msgs have node numbers where possible -- d1 Error msgs have node numbers where possible
-- d2 Eliminate error flags in verbose form error messages -- d2 Eliminate error flags in verbose form error messages
...@@ -683,6 +683,11 @@ package body Debug is ...@@ -683,6 +683,11 @@ package body Debug is
-- forces use of the new N_Expression_With_Actions node in these other -- forces use of the new N_Expression_With_Actions node in these other
-- cases and is intended for transitional use. -- cases and is intended for transitional use.
-- d.Z In gnat2why, in Flow analysis mode (-gnatd.Q), dump the different
-- graphs (control flow, control dependence) for debugging purposes.
-- This debug flag will be removed when flow analysis is sufficiently
-- stable.
-- d.Y Prevents the use of the N_Expression_With_Actions node even in the -- d.Y Prevents the use of the N_Expression_With_Actions node even in the
-- case of the gcc back end. Provided as a back up in case the new -- case of the gcc back end. Provided as a back up in case the new
-- scheme has problems. -- scheme has problems.
......
...@@ -102,10 +102,11 @@ package Get_Targ is ...@@ -102,10 +102,11 @@ package Get_Targ is
-- Alignment guaranteed by malloc falls -- Alignment guaranteed by malloc falls
function Get_Double_Float_Alignment return Nat; function Get_Double_Float_Alignment return Nat;
-- Alignment required for Long_Float -- Alignment required for Long_Float or 0 if no special requirement
function Get_Double_Scalar_Alignment return Nat; function Get_Double_Scalar_Alignment return Nat;
-- Alignment required for Long_Long_Integer -- Alignment required for Long_Long_Integer or larger integer types
-- or 0 if no special requirement.
-- Other subprograms -- Other subprograms
......
...@@ -1335,20 +1335,14 @@ package Opt is ...@@ -1335,20 +1335,14 @@ package Opt is
-- GNAT -- GNAT
-- Set True to override the normal processing in Get_Targ and set the -- Set True to override the normal processing in Get_Targ and set the
-- necessary information by reading the target dependent information -- necessary information by reading the target dependent information
-- file (see package Get_Targ in get_targ.ads for full details). Set -- file (see packages Get_Targ and Set_Targ for full details). Set True
-- True by use of the -gnateT switch. -- by use of the -gnateT switch.
Target_Dependent_Info_Write : Boolean := False; Target_Dependent_Info_Write : Boolean := False;
-- GNAT -- GNAT
-- Set True to enable a call to Get_Targ.Write_Target_Dependent_Info which -- Set True to enable a call to Set_Targ.Write_Target_Dependent_Info which
-- writes a target independent information file (see package Get_Targ in -- writes a target independent information file (see packages Get_Targ and
-- get_targ.ads for full details). Set True by use of the -gnatet switch. -- Set_Targ for full details). Set True by use of the -gnatet switch.
--
-- Note: although we do indeed set this switch to True as documented above
-- if -gnatet is encountered, we actually do not use this flag to enable
-- writing of the file. That's because the read in Get_Targ has to be done
-- long before the normal circuit for setting switches (see Get_Targ for
-- full details of how we handle this requirement).
Task_Dispatching_Policy : Character := ' '; Task_Dispatching_Policy : Character := ' ';
-- GNAT, GNATBIND -- GNAT, GNATBIND
......
...@@ -806,6 +806,9 @@ package body Sem_Prag is ...@@ -806,6 +806,9 @@ package body Sem_Prag is
-- Returns True if pragma appears within the context clause of a unit, -- Returns True if pragma appears within the context clause of a unit,
-- and False for any other placement (does not generate any messages). -- and False for any other placement (does not generate any messages).
function Is_Renaming (N : Node_Id) return Boolean;
-- Determine whether arbitrary node N is a renaming
function Is_Static_String_Expression (Arg : Node_Id) return Boolean; function Is_Static_String_Expression (Arg : Node_Id) return Boolean;
-- Analyzes the argument, and determines if it is a static string -- Analyzes the argument, and determines if it is a static string
-- expression, returns True if so, False if non-static or not String. -- expression, returns True if so, False if non-static or not String.
...@@ -3013,6 +3016,17 @@ package body Sem_Prag is ...@@ -3013,6 +3016,17 @@ package body Sem_Prag is
return True; return True;
end Is_In_Context_Clause; end Is_In_Context_Clause;
-----------------
-- Is_Renaming --
-----------------
function Is_Renaming (N : Node_Id) return Boolean is
begin
return
Is_Entity_Name (N)
and then Present (Renamed_Object (Entity (N)));
end Is_Renaming;
--------------------------------- ---------------------------------
-- Is_Static_String_Expression -- -- Is_Static_String_Expression --
--------------------------------- ---------------------------------
...@@ -9017,8 +9031,8 @@ package body Sem_Prag is ...@@ -9017,8 +9031,8 @@ package body Sem_Prag is
Null_Seen : in out Boolean) Null_Seen : in out Boolean)
is is
Is_Output : constant Boolean := not Is_Input; Is_Output : constant Boolean := not Is_Input;
Item_Id : Entity_Id;
Grouped : Node_Id; Grouped : Node_Id;
Item_Id : Entity_Id;
begin begin
-- Multiple input or output items appear as an aggregate -- Multiple input or output items appear as an aggregate
...@@ -9106,15 +9120,19 @@ package body Sem_Prag is ...@@ -9106,15 +9120,19 @@ package body Sem_Prag is
else else
Analyze (Item); Analyze (Item);
if Is_Entity_Name (Item) then -- Find the entity of the item. If this is a renaming,
Item_Id := Entity_Of (Item); -- climb the renaming chain to reach the root object.
-- Renamings of non-entire objects do not yield an
-- entity (Empty).
if Present (Item_Id) Item_Id := Entity_Of (Item);
and then Ekind_In (Item_Id, E_Abstract_State,
E_In_Parameter, if Present (Item_Id) then
E_In_Out_Parameter, if Ekind_In (Item_Id, E_Abstract_State,
E_Out_Parameter, E_In_Parameter,
E_Variable) E_In_Out_Parameter,
E_Out_Parameter,
E_Variable)
then then
-- Detect multiple uses of the same state, variable -- Detect multiple uses of the same state, variable
-- or formal parameter. If this is not the case, -- or formal parameter. If this is not the case,
...@@ -9148,6 +9166,15 @@ package body Sem_Prag is ...@@ -9148,6 +9166,15 @@ package body Sem_Prag is
Append_Unique_Elmt (Item_Id, All_Inputs_Seen); Append_Unique_Elmt (Item_Id, All_Inputs_Seen);
end if; end if;
-- When the item renames an entire object, replace
-- the item with a reference to the object.
if Is_Renaming (Item) then
Rewrite (Item,
New_Reference_To (Item_Id, Sloc (Item)));
Analyze (Item);
end if;
-- All other input/output items are illegal -- All other input/output items are illegal
else else
...@@ -10809,7 +10836,7 @@ package body Sem_Prag is ...@@ -10809,7 +10836,7 @@ package body Sem_Prag is
(Item : Node_Id; (Item : Node_Id;
Global_Mode : Name_Id) Global_Mode : Name_Id)
is is
Id : Entity_Id; Item_Id : Entity_Id;
begin begin
-- Detect one of the following cases -- Detect one of the following cases
...@@ -10826,13 +10853,18 @@ package body Sem_Prag is ...@@ -10826,13 +10853,18 @@ package body Sem_Prag is
Analyze (Item); Analyze (Item);
if Is_Entity_Name (Item) then -- Find the entity of the item. If this is a renaming, climb
Id := Entity (Item); -- the renaming chain to reach the root object. Renamings of
-- non-entire objects do not yield an entity (Empty).
Item_Id := Entity_Of (Item);
if Present (Item_Id) then
-- A global item cannot reference a formal parameter. Do -- A global item cannot reference a formal parameter. Do
-- this check first to provide a better error diagnostic. -- this check first to provide a better error diagnostic.
if Is_Formal (Id) then if Is_Formal (Item_Id) then
Error_Msg_N Error_Msg_N
("global item cannot reference formal parameter", ("global item cannot reference formal parameter",
Item); Item);
...@@ -10841,14 +10873,23 @@ package body Sem_Prag is ...@@ -10841,14 +10873,23 @@ package body Sem_Prag is
-- The only legal references are those to abstract states -- The only legal references are those to abstract states
-- and variables. -- and variables.
elsif not Ekind_In (Entity (Item), E_Abstract_State, elsif not Ekind_In (Item_Id, E_Abstract_State,
E_Variable) E_Variable)
then then
Error_Msg_N Error_Msg_N
("global item must denote variable or state", Item); ("global item must denote variable or state", Item);
return; return;
end if; end if;
-- When the item renames an entire object, replace the
-- item with a reference to the object.
if Is_Renaming (Item) then
Rewrite (Item,
New_Reference_To (Item_Id, Sloc (Item)));
Analyze (Item);
end if;
-- Some form of illegal construct masquerading as a name -- Some form of illegal construct masquerading as a name
else else
...@@ -10860,7 +10901,7 @@ package body Sem_Prag is ...@@ -10860,7 +10901,7 @@ package body Sem_Prag is
-- The same entity might be referenced through various way. -- The same entity might be referenced through various way.
-- Check the entity of the item rather than the item itself. -- Check the entity of the item rather than the item itself.
if Contains (Seen, Id) then if Contains (Seen, Item_Id) then
Error_Msg_N ("duplicate global item", Item); Error_Msg_N ("duplicate global item", Item);
-- Add the entity of the current item to the list of -- Add the entity of the current item to the list of
...@@ -10871,16 +10912,16 @@ package body Sem_Prag is ...@@ -10871,16 +10912,16 @@ package body Sem_Prag is
Seen := New_Elmt_List; Seen := New_Elmt_List;
end if; end if;
Append_Elmt (Id, Seen); Append_Elmt (Item_Id, Seen);
end if; end if;
if Ekind (Id) = E_Abstract_State if Ekind (Item_Id) = E_Abstract_State
and then Is_Volatile_State (Id) and then Is_Volatile_State (Item_Id)
then then
-- A global item of mode In_Out or Output cannot denote a -- A global item of mode In_Out or Output cannot denote a
-- volatile Input state. -- volatile Input state.
if Is_Input_State (Id) if Is_Input_State (Item_Id)
and then (Global_Mode = Name_In_Out and then (Global_Mode = Name_In_Out
or else or else
Global_Mode = Name_Output) Global_Mode = Name_Output)
...@@ -10892,7 +10933,7 @@ package body Sem_Prag is ...@@ -10892,7 +10933,7 @@ package body Sem_Prag is
-- A global item of mode In_Out or Input cannot reference -- A global item of mode In_Out or Input cannot reference
-- a volatile Output state. -- a volatile Output state.
elsif Is_Output_State (Id) elsif Is_Output_State (Item_Id)
and then (Global_Mode = Name_In_Out and then (Global_Mode = Name_In_Out
or else or else
Global_Mode = Name_Input) Global_Mode = Name_Input)
......
...@@ -470,8 +470,8 @@ package body Set_Targ is ...@@ -470,8 +470,8 @@ package body Set_Targ is
begin begin
-- First step: see if the -gnateT switch is present. As we have noted, -- First step: see if the -gnateT switch is present. As we have noted,
-- this has to be done very early, so can not depend on the normal circuit -- this has to be done very early, so can not depend on the normal circuit
-- for reading switches and setting switches in opt. The following code -- for reading switches and setting switches in Opt. The following code
-- will set Opt.Target_Dependent_Info_Read if an option starting -gnatet -- will set Opt.Target_Dependent_Info_Read if an option starting -gnateT
-- is present in the options string. -- is present in the options string.
declare declare
...@@ -494,6 +494,12 @@ begin ...@@ -494,6 +494,12 @@ begin
declare declare
Argv_Ptr : constant Big_String_Ptr := save_argv (Arg); Argv_Ptr : constant Big_String_Ptr := save_argv (Arg);
begin begin
-- ??? Is there no problem accessing at indices 1 to 7 or 8
-- without first checking if the length of the underlying string
-- may be smaller? See back_end.adb for an example where function
-- Len_Arg is used to retrieve this length.
if Argv_Ptr (1 .. 7) = "-gnateT" then if Argv_Ptr (1 .. 7) = "-gnateT" then
Opt.Target_Dependent_Info_Read := True; Opt.Target_Dependent_Info_Read := True;
elsif Argv_Ptr (1 .. 8) = "-gnatd.b" then elsif Argv_Ptr (1 .. 8) = "-gnatd.b" then
...@@ -507,7 +513,7 @@ begin ...@@ -507,7 +513,7 @@ begin
if not Opt.Target_Dependent_Info_Read then if not Opt.Target_Dependent_Info_Read then
-- Set values set by direct calls to the back end -- Set values by direct calls to the back end
Bits_BE := Get_Bits_BE; Bits_BE := Get_Bits_BE;
Bits_Per_Unit := Get_Bits_Per_Unit; Bits_Per_Unit := Get_Bits_Per_Unit;
...@@ -536,13 +542,13 @@ begin ...@@ -536,13 +542,13 @@ begin
Register_Back_End_Types (Register_Float_Type'Access); Register_Back_End_Types (Register_Float_Type'Access);
-- Case of reading the target dependent values from target.atp -- Case of reading the target dependent values from target.atp
-- This is bit more complex than might be expected, because it has to -- This is bit more complex than might be expected, because it has to be
-- be done very early. All kinds of packages depend on these values, -- done very early. All kinds of packages depend on these values, and we
-- and we can't wait till the normal processing of reading command line -- can't wait till the normal processing of reading command line switches
-- switches etc to read the file. We do this at the System.OS_Lib level -- etc to read the file. We do this at the System.OS_Lib level since it is
-- since it is too early to be using Osint directly. -- too early to be using Osint directly.
else else
Read_File : declare Read_File : declare
......
...@@ -234,12 +234,16 @@ package Ttypes is ...@@ -234,12 +234,16 @@ package Ttypes is
Set_Targ.Double_Float_Alignment; Set_Targ.Double_Float_Alignment;
-- The default alignment of "double" floating-point types, i.e. floating -- The default alignment of "double" floating-point types, i.e. floating
-- point types whose size is equal to 64 bits, or 0 if this alignment is -- point types whose size is equal to 64 bits, or 0 if this alignment is
-- not specifically capped. -- not lower than the largest power of 2 multiple of System.Storage_Unit
-- that does not exceed either the object size of the type or the maximum
-- allowed alignment.
Target_Double_Scalar_Alignment : constant Nat := Target_Double_Scalar_Alignment : constant Nat :=
Set_Targ.Double_Scalar_Alignment; Set_Targ.Double_Scalar_Alignment;
-- The default alignment of "double" or larger scalar types, i.e. scalar -- The default alignment of "double" or larger scalar types, i.e. scalar
-- types whose size is greater or equal to 64 bits, or 0 if this alignment -- types whose size is greater or equal to 64 bits, or 0 if this alignment
-- is not specifically capped. -- is not lower than the largest power of 2 multiple of System.Storage_Unit
-- that does not exceed either the object size of the type or the maximum
-- allowed alignment.
end Ttypes; end Ttypes;
Markdown is supported
0% or
You are about to add 0 people to the discussion. Proceed with caution.
Finish editing this message first!
Please register or to comment