[multiple changes]
authorArnaud Charlet <charlet@gcc.gnu.org>
Thu, 11 Apr 2013 13:30:34 +0000 (15:30 +0200)
committerArnaud Charlet <charlet@gcc.gnu.org>
Thu, 11 Apr 2013 13:30:34 +0000 (15:30 +0200)
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

gcc/ada/ChangeLog
gcc/ada/debug.adb
gcc/ada/get_targ.ads
gcc/ada/opt.ads
gcc/ada/sem_prag.adb
gcc/ada/set_targ.adb
gcc/ada/ttypes.ads

index 8ac9c7de1c8479f7dabe554ca7d6f9f3c0d2305e..86ad8e43319370461386b2c3eca324f200b48bea 100644 (file)
@@ -1,3 +1,22 @@
+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>
 
        * gnat_ugn.texi: Minor clean ups.
index 18095508a0c9ce00b4d186d1f3e68c8417529fd7..d0923fcd28acc3fe3d372d0be3ba09a820544823 100644 (file)
@@ -143,7 +143,7 @@ package body Debug is
    --  d.W  Print out debugging information for Walk_Library_Items
    --  d.X  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
    --  d2   Eliminate error flags in verbose form error messages
@@ -683,6 +683,11 @@ package body Debug is
    --       forces use of the new N_Expression_With_Actions node in these other
    --       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
    --       case of the gcc back end. Provided as a back up in case the new
    --       scheme has problems.
index 93043e08e933d3886a273005bbe87d69fd65c2de..08af7f33855da44f9279d7944e2ce29dfc339690 100644 (file)
@@ -102,10 +102,11 @@ package Get_Targ is
    --  Alignment guaranteed by malloc falls
 
    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;
-   --  Alignment required for Long_Long_Integer
+   --  Alignment required for Long_Long_Integer or larger integer types
+   --  or 0 if no special requirement.
 
    --  Other subprograms
 
index 4bda344365014a898faf8280906c6aace5499d9d..330c8bfad012e2452e4b1c73c1513770d570f9dc 100644 (file)
@@ -1335,20 +1335,14 @@ package Opt is
    --  GNAT
    --  Set True to override the normal processing in Get_Targ and set the
    --  necessary information by reading the target dependent information
-   --  file (see package Get_Targ in get_targ.ads for full details). Set
-   --  True by use of the -gnateT switch.
+   --  file (see packages Get_Targ and Set_Targ for full details). Set True
+   --  by use of the -gnateT switch.
 
    Target_Dependent_Info_Write : Boolean := False;
    --  GNAT
-   --  Set True to enable a call to Get_Targ.Write_Target_Dependent_Info which
-   --  writes a target independent information file (see package Get_Targ in
-   --  get_targ.ads 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).
+   --  Set True to enable a call to Set_Targ.Write_Target_Dependent_Info which
+   --  writes a target independent information file (see packages Get_Targ and
+   --  Set_Targ for full details). Set True by use of the -gnatet switch.
 
    Task_Dispatching_Policy : Character := ' ';
    --  GNAT, GNATBIND
index 32d3979728bf03725fc48547441f29c08cfd328b..828578048f3567c4ae603aefceeb4b81dce1d013 100644 (file)
@@ -806,6 +806,9 @@ package body Sem_Prag is
       --  Returns True if pragma appears within the context clause of a unit,
       --  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;
       --  Analyzes the argument, and determines if it is a static string
       --  expression, returns True if so, False if non-static or not String.
@@ -3013,6 +3016,17 @@ package body Sem_Prag is
          return True;
       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 --
       ---------------------------------
@@ -9017,8 +9031,8 @@ package body Sem_Prag is
                   Null_Seen : in out Boolean)
                is
                   Is_Output : constant Boolean := not Is_Input;
-                  Item_Id   : Entity_Id;
                   Grouped   : Node_Id;
+                  Item_Id   : Entity_Id;
 
                begin
                   --  Multiple input or output items appear as an aggregate
@@ -9106,15 +9120,19 @@ package body Sem_Prag is
                   else
                      Analyze (Item);
 
-                     if Is_Entity_Name (Item) then
-                        Item_Id := Entity_Of (Item);
+                     --  Find the entity of the item. If this is a renaming,
+                     --  climb the renaming chain to reach the root object.
+                     --  Renamings of non-entire objects do not yield an
+                     --  entity (Empty).
 
-                        if Present (Item_Id)
-                          and then Ekind_In (Item_Id, E_Abstract_State,
-                                                      E_In_Parameter,
-                                                      E_In_Out_Parameter,
-                                                      E_Out_Parameter,
-                                                      E_Variable)
+                     Item_Id := Entity_Of (Item);
+
+                     if Present (Item_Id) then
+                        if Ekind_In (Item_Id, E_Abstract_State,
+                                              E_In_Parameter,
+                                              E_In_Out_Parameter,
+                                              E_Out_Parameter,
+                                              E_Variable)
                         then
                            --  Detect multiple uses of the same state, variable
                            --  or formal parameter. If this is not the case,
@@ -9148,6 +9166,15 @@ package body Sem_Prag is
                               Append_Unique_Elmt (Item_Id, All_Inputs_Seen);
                            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
 
                         else
@@ -10809,7 +10836,7 @@ package body Sem_Prag is
                  (Item        : Node_Id;
                   Global_Mode : Name_Id)
                is
-                  Id : Entity_Id;
+                  Item_Id : Entity_Id;
 
                begin
                   --  Detect one of the following cases
@@ -10826,13 +10853,18 @@ package body Sem_Prag is
 
                   Analyze (Item);
 
-                  if Is_Entity_Name (Item) then
-                     Id := Entity (Item);
+                  --  Find the entity of the item. If this is a renaming, climb
+                  --  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
                      --  this check first to provide a better error diagnostic.
 
-                     if Is_Formal (Id) then
+                     if Is_Formal (Item_Id) then
                         Error_Msg_N
                           ("global item cannot reference formal parameter",
                            Item);
@@ -10841,14 +10873,23 @@ package body Sem_Prag is
                      --  The only legal references are those to abstract states
                      --  and variables.
 
-                     elsif not Ekind_In (Entity (Item), E_Abstract_State,
-                                                        E_Variable)
+                     elsif not Ekind_In (Item_Id, E_Abstract_State,
+                                                  E_Variable)
                      then
                         Error_Msg_N
                           ("global item must denote variable or state", Item);
                         return;
                      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
 
                   else
@@ -10860,7 +10901,7 @@ package body Sem_Prag is
                   --  The same entity might be referenced through various way.
                   --  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);
 
                   --  Add the entity of the current item to the list of
@@ -10871,16 +10912,16 @@ package body Sem_Prag is
                         Seen := New_Elmt_List;
                      end if;
 
-                     Append_Elmt (Id, Seen);
+                     Append_Elmt (Item_Id, Seen);
                   end if;
 
-                  if Ekind (Id) = E_Abstract_State
-                    and then Is_Volatile_State (Id)
+                  if Ekind (Item_Id) = E_Abstract_State
+                    and then Is_Volatile_State (Item_Id)
                   then
                      --  A global item of mode In_Out or Output cannot denote a
                      --  volatile Input state.
 
-                     if Is_Input_State (Id)
+                     if Is_Input_State (Item_Id)
                        and then (Global_Mode = Name_In_Out
                                    or else
                                  Global_Mode = Name_Output)
@@ -10892,7 +10933,7 @@ package body Sem_Prag is
                      --  A global item of mode In_Out or Input cannot reference
                      --  a volatile Output state.
 
-                     elsif Is_Output_State (Id)
+                     elsif Is_Output_State (Item_Id)
                        and then (Global_Mode = Name_In_Out
                                    or else
                                  Global_Mode = Name_Input)
index 90e83a68e86f94a079ce625fdf21fd0b3b65348a..bc8cf674fcfe3ad50d75f3860fe97a39f0fa100b 100755 (executable)
@@ -470,8 +470,8 @@ package body Set_Targ is
 begin
    --  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
-   --  for reading switches and setting switches in opt. The following code
-   --  will set Opt.Target_Dependent_Info_Read if an option starting -gnatet
+   --  for reading switches and setting switches in Opt. The following code
+   --  will set Opt.Target_Dependent_Info_Read if an option starting -gnateT
    --  is present in the options string.
 
    declare
@@ -494,6 +494,12 @@ begin
          declare
             Argv_Ptr : constant Big_String_Ptr := save_argv (Arg);
          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
                Opt.Target_Dependent_Info_Read := True;
             elsif Argv_Ptr (1 .. 8) = "-gnatd.b" then
@@ -507,7 +513,7 @@ begin
 
    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_Per_Unit              := Get_Bits_Per_Unit;
@@ -536,13 +542,13 @@ begin
 
       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
-      --  be done very early. All kinds of packages depend on these values,
-      --  and we can't wait till the normal processing of reading command line
-      --  switches etc to read the file. We do this at the System.OS_Lib level
-      --  since it is too early to be using Osint directly.
+   --  This is bit more complex than might be expected, because it has to be
+   --  done very early. All kinds of packages depend on these values, and we
+   --  can't wait till the normal processing of reading command line switches
+   --  etc to read the file. We do this at the System.OS_Lib level since it is
+   --  too early to be using Osint directly.
 
    else
       Read_File : declare
index 924fb0e90517200a150b02fb011d737fc85e489d..5e27cbd2e5829834fa156dca1b1e1dd30603fb30 100644 (file)
@@ -234,12 +234,16 @@ package Ttypes is
                                      Set_Targ.Double_Float_Alignment;
    --  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
-   --  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 :=
                                       Set_Targ.Double_Scalar_Alignment;
    --  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
-   --  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;