[multiple changes]

2012-12-05  Robert Dewar  <dewar@adacore.com>

	* lib-writ.adb (Write_ALI): Output T lines.
	* lib-writ.ads: Minor reformatting. Add documentation of T lines.
	* opt.ads (Generate_Target_Dependent_Info): New flag.
	* switch-c.adb (Scan_Switches): Recognize -gnatet switch
	(target dependent info).
	* ttypes.ads: Add four letter codes to declarations (for target
	dependent info).
	* usage.adb: Add line for -gnatet switch.

2012-12-05  Hristian Kirtchev  <kirtchev@adacore.com>

	* exp_prag.adb (Expand_N_Pragma): Add a call to expand
	pragma Loop_Variant.
	(Expand_Pragma_Loop_Assertion): Removed.
	(Expand_Pragma_Loop_Variant): New routine.
	* par-prag.adb: Remove Pragma_Loop_Assertion and add two new
	Pragma_Loop_Invariant and Pragma_Loop_Variant entries.
	* sem_attr.adb (Analyze_Attribute): Update the code which
	locates the enclosing pragma.
	* sem_prag.adb (Analyze_Pragma): Remove the code which analyzes
	pragma Loop_Assertion as the pragma is now obsolete. Add the
	machinery to checks the semantics of pragmas Loop_Invariant
	and Loop_Variant.
	(Check_Loop_Invariant_Variant_Placement): New routine.
	* snames.ads-tmpl: Remove name Loop_Assertion. Add new names
	Loop_Invariant and Loop_Variant.  Rename Name_Decreasing
	to Name_Decreases and Name_Increasing to Name_Increases.
	Remove the pragma Id for Loop_Assertion and add two new Ids for
	Loop_Invariant and Loop_Variant.

From-SVN: r194203

gcc/ada/ChangeLog

 2012-12-05  Robert Dewar  <dewar@adacore.com>
 
+	* lib-writ.adb (Write_ALI): Output T lines.
+	* lib-writ.ads: Minor reformatting. Add documentation of T lines.
+	* opt.ads (Generate_Target_Dependent_Info): New flag.
+	* switch-c.adb (Scan_Switches): Recognize -gnatet switch
+	(target dependent info).
+	* ttypes.ads: Add four letter codes to declarations (for target
+	dependent info).
+	* usage.adb: Add line for -gnatet switch.
+
+2012-12-05  Hristian Kirtchev  <kirtchev@adacore.com>
+
+	* exp_prag.adb (Expand_N_Pragma): Add a call to expand
+	pragma Loop_Variant.
+	(Expand_Pragma_Loop_Assertion): Removed.
+	(Expand_Pragma_Loop_Variant): New routine.
+	* par-prag.adb: Remove Pragma_Loop_Assertion and add two new
+	Pragma_Loop_Invariant and Pragma_Loop_Variant entries.
+	* sem_attr.adb (Analyze_Attribute): Update the code which
+	locates the enclosing pragma.
+	* sem_prag.adb (Analyze_Pragma): Remove the code which analyzes
+	pragma Loop_Assertion as the pragma is now obsolete. Add the
+	machinery to checks the semantics of pragmas Loop_Invariant
+	and Loop_Variant.
+	(Check_Loop_Invariant_Variant_Placement): New routine.
+	* snames.ads-tmpl: Remove name Loop_Assertion. Add new names
+	Loop_Invariant and Loop_Variant.  Rename Name_Decreasing
+	to Name_Decreases and Name_Increasing to Name_Increases.
+	Remove the pragma Id for Loop_Assertion and add two new Ids for
+	Loop_Invariant and Loop_Variant.
+
+2012-12-05  Robert Dewar  <dewar@adacore.com>
+
 	* gnatchop.adb, sem_attr.ads, sem_ch4.adb, sem_ch6.adb, exp_disp.adb,
 	atree.adb, sem_eval.adb: Minor reformatting.
 

gcc/ada/lib-writ.adb

@@ -49,6 +49,7 @@ with Sinput;   use Sinput;
 with Snames;   use Snames;
 with Stringt;  use Stringt;
 with Tbuild;   use Tbuild;
+with Ttypes;   use Ttypes;
 with Uname;    use Uname;
 
 with System.Case_Util; use System.Case_Util;
@@ -1440,6 +1441,93 @@ package body Lib.Writ is
          Output_Alfa;
       end if;
 
+      --  Output target dependent information if needed
+
+      if Generate_Target_Dependent_Info then
+         Gen_TDI : declare
+            subtype Str4 is String (1 .. 4);
+
+            procedure Gen_TDI_Bool (Code : Str4; Val : Boolean);
+            --  Generate T line for Bool value
+
+            procedure Gen_TDI_Nat (Code : Str4; Val : Int);
+            --  Generate T line for Pos or Nat value
+
+            ------------------
+            -- Gen_TDI_Bool --
+            ------------------
+
+            procedure Gen_TDI_Bool (Code : Str4; Val : Boolean) is
+            begin
+               Write_Info_Initiate ('T');
+               Write_Info_Char (' ');
+               Write_Info_Str (Code);
+
+               if Val then
+                  Write_Info_Str (" TRUE");
+               else
+                  Write_Info_Str (" FALSE");
+               end if;
+
+               Write_Info_EOL;
+            end Gen_TDI_Bool;
+
+            -----------------
+            -- Gen_TDI_Nat --
+            -----------------
+
+            procedure Gen_TDI_Nat (Code : Str4; Val : Int) is
+            begin
+               Write_Info_Initiate ('T');
+               Write_Info_Char (' ');
+               Write_Info_Str (Code);
+               Write_Info_Char (' ');
+               Write_Info_Nat (Val);
+
+               Write_Info_EOL;
+            end Gen_TDI_Nat;
+
+         --  Start of processing for Gen_TDI
+
+         begin
+            Gen_TDI_Nat  ("SINS", Standard_Short_Short_Integer_Size);
+            Gen_TDI_Nat  ("SINW", Standard_Short_Short_Integer_Width);
+            Gen_TDI_Nat  ("SHIS", Standard_Short_Integer_Size);
+            Gen_TDI_Nat  ("SHIW", Standard_Short_Integer_Width);
+            Gen_TDI_Nat  ("INTS", Standard_Integer_Size);
+            Gen_TDI_Nat  ("INTW", Standard_Integer_Width);
+            Gen_TDI_Nat  ("LINS", Standard_Long_Integer_Size);
+            Gen_TDI_Nat  ("LINW", Standard_Long_Integer_Width);
+            Gen_TDI_Nat  ("LLIS", Standard_Long_Long_Integer_Size);
+            Gen_TDI_Nat  ("LLIW", Standard_Long_Long_Integer_Width);
+            Gen_TDI_Nat  ("SFLS", Standard_Short_Float_Size);
+            Gen_TDI_Nat  ("SFLD", Standard_Short_Float_Digits);
+            Gen_TDI_Nat  ("FLTS", Standard_Float_Size);
+            Gen_TDI_Nat  ("FLTD", Standard_Float_Digits);
+            Gen_TDI_Nat  ("LFLS", Standard_Long_Float_Size);
+            Gen_TDI_Nat  ("LFLD", Standard_Long_Float_Digits);
+            Gen_TDI_Nat  ("LLFS", Standard_Long_Long_Float_Size);
+            Gen_TDI_Nat  ("LLFD", Standard_Long_Long_Float_Digits);
+            Gen_TDI_Nat  ("CHAS", Standard_Character_Size);
+            Gen_TDI_Nat  ("WCHS", Standard_Wide_Character_Size);
+            Gen_TDI_Nat  ("WWCS", Standard_Wide_Wide_Character_Size);
+            Gen_TDI_Nat  ("ADRS", System_Address_Size);
+            Gen_TDI_Nat  ("MBMP", System_Max_Binary_Modulus_Power);
+            Gen_TDI_Nat  ("MNMP", System_Max_Nonbinary_Modulus_Power);
+            Gen_TDI_Nat  ("SUNI", System_Storage_Unit);
+            Gen_TDI_Nat  ("WRDS", System_Word_Size);
+            Gen_TDI_Nat  ("TICK", System_Tick_Nanoseconds);
+            Gen_TDI_Nat  ("WCTS", Interfaces_Wchar_T_Size);
+            Gen_TDI_Nat  ("MAXA", Maximum_Alignment);
+            Gen_TDI_Nat  ("ALLA", System_Allocator_Alignment);
+            Gen_TDI_Nat  ("MUNF", Max_Unaligned_Field);
+            Gen_TDI_Bool ("BEND", Bytes_Big_Endian);
+            Gen_TDI_Bool ("STRA", Target_Strict_Alignment);
+            Gen_TDI_Nat  ("DFLA", Target_Double_Float_Alignment);
+            Gen_TDI_Nat  ("DSCA", Target_Double_Scalar_Alignment);
+         end Gen_TDI;
+      end if;
+
       --  Output final blank line and we are done. This final blank line is
       --  probably junk, but we don't feel like making an incompatible change!
 

gcc/ada/lib-writ.ads

@@ -801,21 +801,40 @@ package Lib.Writ is
    --------------------------
 
    --  The cross-reference data follows the dependency lines. See the spec of
-   --  Lib.Xref for details on the format of this data.
+   --  Lib.Xref in file lib-xref.ads for details on the format of this data.
 
    ---------------------------------
    -- Source Coverage Obligations --
    ---------------------------------
 
    --  The Source Coverage Obligation (SCO) information follows the cross-
-   --  reference data. See the spec of Par_SCO for full details of the format.
+   --  reference data. See the spec of Par_SCO in file par_sco.ads for full
+   --  details of the format.
 
    ----------------------
    -- Alfa Information --
    ----------------------
 
    --  The Alfa information follows the SCO information. See the spec of Alfa
-   --  for full details of the format.
+   --  in file alfa.ads for full details of the format.
+
+   -------------------------------------
+   -- T  Target Dependent Information --
+   -------------------------------------
+
+   --  This section is present if the option to generate target dependent
+   --  information is present (this flag is set by the -gnatT switch). The
+   --  format of T lines is:
+
+   --    T key val
+
+   --  There is one line for each constant declared in the Ttypes package
+
+   --    key   is the four letter code (which can be found as a comment on each
+   --          of the constant declarations in Ttypes).
+
+   --    val   is the value of the constant, which is either a non-negative
+   --          decimal constant, or TRUE or FALSE for a Boolean value.
 
    ----------------------
    -- Global Variables --

gcc/ada/opt.ads

@@ -658,6 +658,11 @@ package Opt is
    --  True when switch -fdebug-instances is used. When True, a table of
    --  instances is included in SCOs.
 
+   Generate_Target_Dependent_Info : Boolean := False;
+   --  GNAT
+   --  When true (-gnatet switch used). True if target dependent info is to be
+   --  generated in the ali file.
+
    Generating_Code : Boolean := False;
    --  GNAT
    --  True if the frontend finished its work and has called the backend to

gcc/ada/par-prag.adb

@@ -1189,7 +1189,8 @@ begin
            Pragma_Lock_Free                      |
            Pragma_Locking_Policy                 |
            Pragma_Long_Float                     |
-           Pragma_Loop_Assertion                 |
+           Pragma_Loop_Invariant                 |
+           Pragma_Loop_Variant                   |
            Pragma_Machine_Attribute              |
            Pragma_Main                           |
            Pragma_Main_Storage                   |

gcc/ada/sem_attr.adb

@@ -3795,15 +3795,17 @@ package body Sem_Attr is
          Stmt := N;
          while Present (Stmt) loop
 
-            --  Locate the enclosing Loop_Assertion pragma (if any). Note that
-            --  when Loop_Assertion is expanded, we must look for an Assertion
-            --  pragma.
+            --  Locate the enclosing Loop_Invariant / Loop_Variant pragma (if
+            --  any). Note that when these two are expanded, we must look for
+            --  an Assertion pragma.
 
             if Nkind (Original_Node (Stmt)) = N_Pragma
               and then
                 (Pragma_Name (Original_Node (Stmt)) = Name_Assert
                    or else
-                 Pragma_Name (Original_Node (Stmt)) = Name_Loop_Assertion)
+                 Pragma_Name (Original_Node (Stmt)) = Name_Loop_Invariant
+                   or else
+                 Pragma_Name (Original_Node (Stmt)) = Name_Loop_Variant)
             then
                In_Loop_Assertion := True;
 

gcc/ada/sem_prag.adb

@@ -618,6 +618,10 @@ package body Sem_Prag is
       --  Common processing for first argument of pragma Interrupt_Handler or
       --  pragma Attach_Handler.
 
+      procedure Check_Loop_Invariant_Variant_Placement;
+      --  Verify whether pragma Loop_Invariant or pragma Loop_Variant appear
+      --  immediately within the statements of the related loop.
+
       procedure Check_Is_In_Decl_Part_Or_Package_Spec;
       --  Check that pragma appears in a declarative part, or in a package
       --  specification, i.e. that it does not occur in a statement sequence
@@ -1912,6 +1916,44 @@ package body Sem_Prag is
          end if;
       end Check_Interrupt_Or_Attach_Handler;
 
+      --------------------------------------------
+      -- Check_Loop_Invariant_Variant_Placement --
+      --------------------------------------------
+
+      procedure Check_Loop_Invariant_Variant_Placement is
+         Loop_Stmt : Node_Id;
+
+      begin
+         --  Locate the enclosing loop statement (if any)
+
+         Loop_Stmt := N;
+         while Present (Loop_Stmt) loop
+            if Nkind (Loop_Stmt) = N_Loop_Statement then
+               exit;
+
+            --  Prevent the search from going too far
+
+            elsif Nkind_In (Loop_Stmt, N_Entry_Body,
+                                       N_Package_Body,
+                                       N_Package_Declaration,
+                                       N_Protected_Body,
+                                       N_Subprogram_Body,
+                                       N_Task_Body)
+            then
+               Error_Pragma ("pragma % must appear inside a loop statement");
+               return;
+
+            else
+               Loop_Stmt := Parent (Loop_Stmt);
+            end if;
+         end loop;
+
+         if List_Containing (N) /= Statements (Loop_Stmt) then
+            Error_Pragma
+              ("pragma % must occur immediately in the statements of a loop");
+         end if;
+      end Check_Loop_Invariant_Variant_Placement;
+
       -------------------------------------------
       -- Check_Is_In_Decl_Part_Or_Package_Spec --
       -------------------------------------------
@@ -11453,74 +11495,62 @@ package body Sem_Prag is
          end Long_Float;
 
          --------------------
-         -- Loop_Assertion --
+         -- Loop_Invariant --
          --------------------
 
-         --  pragma Loop_Assertion
-         --        (  [Invariant =>] boolean_Expression );
-         --     |  ( [[Invariant =>] boolean_Expression ,]
-         --            Variant   =>
-         --              ( TERMINATION_VARIANT {, TERMINATION_VARIANT ) );
-
-         --  TERMINATION_VARIANT ::= CHANGE_MODIFIER => discrete_EXPRESSION
-
-         --  CHANGE_MODIFIER ::= Increasing | Decreasing
+         --  pragma Loop_Invariant ( boolean_EXPRESSION );
 
-         when Pragma_Loop_Assertion => Loop_Assertion : declare
-            procedure Check_Variant (Arg : Node_Id);
-            --  Verify the legality of a variant
-
-            -------------------
-            -- Check_Variant --
-            -------------------
+         when Pragma_Loop_Invariant => Loop_Invariant : declare
+         begin
+            GNAT_Pragma;
+            S14_Pragma;
+            Check_Arg_Count (1);
+            Check_Loop_Invariant_Variant_Placement;
 
-            procedure Check_Variant (Arg : Node_Id) is
-               Expr : constant Node_Id := Expression (Arg);
+            --  Completely ignore if disabled
 
-            begin
-               --  Variants appear in aggregate form
+            if Check_Disabled (Pname) then
+               Rewrite (N, Make_Null_Statement (Loc));
+               Analyze (N);
+               return;
+            end if;
 
-               if Nkind (Expr) = N_Aggregate then
-                  declare
-                     Comp  : Node_Id;
-                     Extra : Node_Id;
-                     Modif : Node_Id;
+            Preanalyze_And_Resolve (Expression (Arg1), Any_Boolean);
 
-                  begin
-                     Comp := First (Component_Associations (Expr));
-                     while Present (Comp) loop
-                        Modif := First (Choices (Comp));
-                        Extra := Next (Modif);
+            --  Transform pagma Loop_Invariant into an equivalent pragma Check.
+            --  Generate:
+            --    pragma Check (Loop_Invaraint, Arg1);
 
-                        Check_Arg_Is_One_Of
-                          (Modif, Name_Decreasing, Name_Increasing);
+            Rewrite (N,
+              Make_Pragma (Loc,
+                Chars                        => Name_Check,
+                Pragma_Argument_Associations => New_List (
+                  Make_Pragma_Argument_Association (Loc,
+                    Expression => Make_Identifier (Loc, Name_Loop_Invariant)),
+                  Relocate_Node (Arg1))));
 
-                        if Present (Extra) then
-                           Error_Pragma_Arg
-                             ("only one modifier allowed in argument", Expr);
-                        end if;
+            Analyze (N);
+         end Loop_Invariant;
 
-                        Preanalyze_And_Resolve
-                          (Expression (Comp), Any_Discrete);
+         ------------------
+         -- Loop_Variant --
+         ------------------
 
-                        Next (Comp);
-                     end loop;
-                  end;
-               else
-                  Error_Pragma_Arg
-                    ("expression on variant must be an aggregate", Expr);
-               end if;
-            end Check_Variant;
+         --  pragma Loop_Variant
+         --         ( LOOP_VARIANT_ITEM {, LOOP_VARIANT_ITEM } );
 
-            --  Local variables
+         --  LOOP_VARIANT_ITEM ::= CHANGE_DIRECTION => discrete_EXPRESSION
 
-            Stmt : Node_Id;
+         --  CHANGE_DIRECTION ::= Increases | Decreases
 
-         --  Start of processing for Loop_Assertion
+         when Pragma_Loop_Variant => Loop_Variant : declare
+            Variant : Node_Id;
 
          begin
             GNAT_Pragma;
             S14_Pragma;
+            Check_At_Least_N_Arguments (1);
+            Check_Loop_Invariant_Variant_Placement;
 
             --  Completely ignore if disabled
 
@@ -11530,56 +11560,21 @@ package body Sem_Prag is
                return;
             end if;
 
-            --  Verify that the pragma appears inside a loop
-
-            Stmt := N;
-            while Present (Stmt) and then Nkind (Stmt) /= N_Loop_Statement loop
-               Stmt := Parent (Stmt);
-            end loop;
-
-            if No (Stmt) then
-               Error_Pragma ("pragma % must appear inside a loop");
-            end if;
-
-            Check_At_Least_N_Arguments (1);
-            Check_At_Most_N_Arguments  (2);
-
-            --  Process the first argument
-
-            if Chars (Arg1) = Name_Variant then
-               Check_Variant (Arg1);
-
-            elsif Chars (Arg1) = No_Name
-              or else Chars (Arg1) = Name_Invariant
-            then
-               Preanalyze_And_Resolve (Expression (Arg1), Any_Boolean);
-
-            else
-               Error_Pragma_Arg ("argument not allowed in pragma %", Arg1);
-            end if;
-
-            --  Process the second argument
+            --  Process all increasing / decreasing expressions
 
-            if Present (Arg2) then
-               if Chars (Arg2) = Name_Variant then
-                  if Chars (Arg1) = Name_Variant then
-                     Error_Pragma ("only one variant allowed in pragma %");
-                  else
-                     Check_Variant (Arg2);
-                  end if;
+            Variant := First (Pragma_Argument_Associations (N));
+            while Present (Variant) loop
+               if Chars (Variant) /= Name_Decreases
+                 and then Chars (Variant) /= Name_Increases
+               then
+                  Error_Pragma_Arg ("wrong change modifier", Variant);
+               end if;
 
-               elsif Chars (Arg2) = Name_Invariant then
-                  if Chars (Arg1) = Name_Variant then
-                     Error_Pragma_Arg ("invariant must precede variant", Arg2);
-                  else
-                     Error_Pragma ("only one invariant allowed in pragma %");
-                  end if;
+               Preanalyze_And_Resolve (Expression (Variant), Any_Discrete);
 
-               else
-                  Error_Pragma_Arg ("argument not allowed in pragma %", Arg2);
-               end if;
-            end if;
-         end Loop_Assertion;
+               Next (Variant);
+            end loop;
+         end Loop_Variant;
 
          -----------------------
          -- Machine_Attribute --
@@ -15707,7 +15702,8 @@ package body Sem_Prag is
       Pragma_Lock_Free                      => -1,
       Pragma_Locking_Policy                 => -1,
       Pragma_Long_Float                     => -1,
-      Pragma_Loop_Assertion                 => -1,
+      Pragma_Loop_Invariant                 => -1,
+      Pragma_Loop_Variant                   => -1,
       Pragma_Machine_Attribute              => -1,
       Pragma_Main                           => -1,
       Pragma_Main_Storage                   => -1,

gcc/ada/snames.ads-tmpl

@@ -405,7 +405,8 @@ package Snames is
    Name_License                        : constant Name_Id := N + $; -- GNAT
    Name_Locking_Policy                 : constant Name_Id := N + $;
    Name_Long_Float                     : constant Name_Id := N + $; -- VMS
-   Name_Loop_Assertion                 : constant Name_Id := N + $; -- GNAT
+   Name_Loop_Invariant                 : constant Name_Id := N + $; -- GNAT
+   Name_Loop_Variant                   : constant Name_Id := N + $; -- GNAT
    Name_No_Run_Time                    : constant Name_Id := N + $; -- GNAT
    Name_No_Strict_Aliasing             : constant Name_Id := N + $; -- GNAT
    Name_Normalize_Scalars              : constant Name_Id := N + $;
@@ -671,7 +672,7 @@ package Snames is
    Name_Component_Size_4               : constant Name_Id := N + $;
    Name_Copy                           : constant Name_Id := N + $;
    Name_D_Float                        : constant Name_Id := N + $;
-   Name_Decreasing                     : constant Name_Id := N + $;
+   Name_Decreases                      : constant Name_Id := N + $;
    Name_Descriptor                     : constant Name_Id := N + $;
    Name_Disable                        : constant Name_Id := N + $;
    Name_Dot_Replacement                : constant Name_Id := N + $;
@@ -691,7 +692,7 @@ package Snames is
    Name_GPL                            : constant Name_Id := N + $;
    Name_IEEE_Float                     : constant Name_Id := N + $;
    Name_Ignore                         : constant Name_Id := N + $;
-   Name_Increasing                     : constant Name_Id := N + $;
+   Name_Increases                      : constant Name_Id := N + $;
    Name_Info                           : constant Name_Id := N + $;
    Name_Internal                       : constant Name_Id := N + $;
    Name_Link_Name                      : constant Name_Id := N + $;
@@ -1686,7 +1687,8 @@ package Snames is
       Pragma_License,
       Pragma_Locking_Policy,
       Pragma_Long_Float,
-      Pragma_Loop_Assertion,
+      Pragma_Loop_Invariant,
+      Pragma_Loop_Variant,
       Pragma_No_Run_Time,
       Pragma_No_Strict_Aliasing,
       Pragma_Normalize_Scalars,

gcc/ada/switch-c.adb

@@ -614,6 +614,12 @@ package body Switch.C is
                      Generate_SCO := True;
                      Ptr := Ptr + 1;
 
+                  --  -gnatet (generate target dependent information)
+
+                  when 't' =>
+                     Generate_Target_Dependent_Info := True;
+                     Ptr := Ptr + 1;
+
                   --  -gnateV (validity checks on parameters)
 
                   when 'V' =>

gcc/ada/usage.adb

@@ -232,6 +232,11 @@ begin
    Write_Switch_Char ("eS");
    Write_Line ("Generate SCO (Source Coverage Obligation) information");
 
+   --  Line for -gnatet switch
+
+   Write_Switch_Char ("et");
+   Write_Line ("Generate target dependent information in ALI file");
+
    --  Line for -gnateV switch
 
    Write_Switch_Char ("eV");