[multiple changes]

2013-04-11  Arnaud Charlet  <charlet@adacore.com>

	* xgnatugn.adb: Remove obsolete comments.

2013-04-11  Robert Dewar  <dewar@adacore.com>

	* back_end.ads, back_end.adb: Minor reformatting.
	* set_targ.ads, set_targ.adb: New files.

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

	* sem_case.adb (Check_Against_Predicate): New routine.
	(Check_Choices): When the type covered by the list of choices
	is a static subtype with a static predicate, check all choices
	agains the predicate.
	(Issue_Msg): All versions removed.
	(Missing_Choice): New routines.
	* sem_ch4.adb: Code and comment reformatting.
	(Analyze_Case_Expression): Do not check the choices when the case
	expression is being preanalyzed and the type of the expression
	is a subtype with a static predicate.
	(Has_Static_Predicate): New routine.
	* sem_ch13.adb: Code and comment reformatting.	(Build_Range):
	Always build a range even if the low and hi bounds denote the
	same value. This is needed by the machinery in Check_Choices.
	(Build_Static_Predicate): Always build a range even if the low and
	hi bounds denote the same value. This is needed by the machinery
	in Check_Choices.

From-SVN: r197789

9 files changed, 1631 insertions, 216 deletions

diff --git a/gcc/ada/ChangeLog b/gcc/ada/ChangeLog
index cc11908..4852ff9 100644
--- a/gcc/ada/ChangeLog
+++ b/gcc/ada/ChangeLog
@@ -1,3 +1,32 @@
+2013-04-11  Arnaud Charlet  <charlet@adacore.com>
+
+	* xgnatugn.adb: Remove obsolete comments.
+
+2013-04-11  Robert Dewar  <dewar@adacore.com>
+
+	* back_end.ads, back_end.adb: Minor reformatting.
+	* set_targ.ads, set_targ.adb: New files.
+
+2013-04-11  Hristian Kirtchev  <kirtchev@adacore.com>
+
+	* sem_case.adb (Check_Against_Predicate): New routine.
+	(Check_Choices): When the type covered by the list of choices
+	is a static subtype with a static predicate, check all choices
+	agains the predicate.
+	(Issue_Msg): All versions removed.
+	(Missing_Choice): New routines.
+	* sem_ch4.adb: Code and comment reformatting.
+	(Analyze_Case_Expression): Do not check the choices when the case
+	expression is being preanalyzed and the type of the expression
+	is a subtype with a static predicate.
+	(Has_Static_Predicate): New routine.
+	* sem_ch13.adb: Code and comment reformatting.	(Build_Range):
+	Always build a range even if the low and hi bounds denote the
+	same value. This is needed by the machinery in Check_Choices.
+	(Build_Static_Predicate): Always build a range even if the low and
+	hi bounds denote the same value. This is needed by the machinery
+	in Check_Choices.
+
 2013-04-11  Robert Dewar  <dewar@adacore.com>
 
 	* einfo.ads, sem_util.adb, exp_ch6.adb, xgnatugn.adb: Minor
diff --git a/gcc/ada/back_end.adb b/gcc/ada/back_end.adb
index f23230e..fafbbc4 100644
--- a/gcc/ada/back_end.adb
+++ b/gcc/ada/back_end.adb
@@ -6,7 +6,7 @@
 --                                                                          --
 --                                 B o d y                                  --
 --                                                                          --
---          Copyright (C) 1992-2012, Free Software Foundation, Inc.         --
+--          Copyright (C) 1992-2013, Free Software Foundation, Inc.         --
 --                                                                          --
 -- GNAT is free software;  you can  redistribute it  and/or modify it under --
 -- terms of the  GNU General Public License as published  by the Free Soft- --
@@ -347,7 +347,6 @@ package body Back_End is
    procedure Register_Back_End_Types (Call_Back : Register_Type_Proc) is
       procedure Enumerate_Modes (Call_Back : Register_Type_Proc);
       pragma Import (C, Enumerate_Modes, "enumerate_modes");
-
    begin
       Enumerate_Modes (Call_Back);
    end Register_Back_End_Types;
diff --git a/gcc/ada/back_end.ads b/gcc/ada/back_end.ads
index bfa2eb5..4f30b03 100644
--- a/gcc/ada/back_end.ads
+++ b/gcc/ada/back_end.ads
@@ -6,7 +6,7 @@
 --                                                                          --
 --                                 S p e c                                  --
 --                                                                          --
---          Copyright (C) 1992-2011, Free Software Foundation, Inc.         --
+--          Copyright (C) 1992-2013, Free Software Foundation, Inc.         --
 --                                                                          --
 -- GNAT is free software;  you can  redistribute it  and/or modify it under --
 -- terms of the  GNU General Public License as published  by the Free Soft- --
@@ -24,7 +24,8 @@
 ------------------------------------------------------------------------------
 
 --  Call the back end with all the information needed. Also contains other
---  back-end specific interfaces required by the front end.
+--  back-end specific interfaces required by the front end. See also Get_Targ,
+--  which defines additional interfaces to the back end.
 
 with Einfo; use Einfo;
 
@@ -63,13 +64,13 @@ package Back_End is
    --  the back end.
 
    procedure Register_Back_End_Types (Call_Back : Register_Type_Proc);
-   --  Calls the Call_Back function with information for each supported type.
+   --  Calls the Call_Back function with information for each supported type
 
    procedure Call_Back_End (Mode : Back_End_Mode_Type);
    --  Call back end, i.e. make call to driver traversing the tree and
-   --  outputting code. This call is made with all tables locked.
-   --  The back end is responsible for unlocking any tables it may need
-   --  to change, and locking them again before returning.
+   --  outputting code. This call is made with all tables locked. The back
+   --  end is responsible for unlocking any tables it may need to change,
+   --  and locking them again before returning.
 
    procedure Scan_Compiler_Arguments;
    --  Acquires command-line parameters passed to the compiler and processes
diff --git a/gcc/ada/sem_case.adb b/gcc/ada/sem_case.adb
index 432de5d..6f066fe 100644
--- a/gcc/ada/sem_case.adb
+++ b/gcc/ada/sem_case.adb
@@ -6,7 +6,7 @@
 --                                                                          --
 --                                 B o d y                                  --
 --                                                                          --
---          Copyright (C) 1996-2012, Free Software Foundation, Inc.         --
+--          Copyright (C) 1996-2013, Free Software Foundation, Inc.         --
 --                                                                          --
 -- GNAT is free software;  you can  redistribute it  and/or modify it under --
 -- terms of the  GNU General Public License as published  by the Free Soft- --
@@ -114,6 +114,18 @@ package body Sem_Case is
       Others_Present : Boolean;
       Case_Node      : Node_Id)
    is
+      procedure Check_Against_Predicate
+        (Pred    : in out Node_Id;
+         Choice  : Choice_Bounds;
+         Prev_Lo : in out Uint;
+         Prev_Hi : in out Uint;
+         Error   : in out Boolean);
+      --  Determine whether a choice covers legal values as defined by a static
+      --  predicate set. Pred is a static predicate range. Choice is the choice
+      --  to be examined. Prev_Lo and Prev_Hi are the bounds of the previous
+      --  choice that covered a predicate set. Error denotes whether the check
+      --  found an illegal intersection.
+
       procedure Explain_Non_Static_Bound;
       --  Called when we find a non-static bound, requiring the base type to
       --  be covered. Provides where possible a helpful explanation of why the
@@ -123,102 +135,292 @@ package body Sem_Case is
       --  Comparison routine for comparing Choice_Table entries. Use the lower
       --  bound of each Choice as the key.
 
+      procedure Missing_Choice (Value1 : Node_Id; Value2 : Node_Id);
+      procedure Missing_Choice (Value1 : Node_Id; Value2 : Uint);
+      procedure Missing_Choice (Value1 : Uint;    Value2 : Node_Id);
+      procedure Missing_Choice (Value1 : Uint;    Value2 : Uint);
+      --  Issue an error message indicating that there are missing choices,
+      --  followed by the image of the missing choices themselves which lie
+      --  between Value1 and Value2 inclusive.
+
+      procedure Missing_Choices (Pred : Node_Id; Prev_Hi : Uint);
+      --  Emit an error message for each non-covered static predicate set.
+      --  Prev_Hi denotes the upper bound of the last choice that covered a
+      --  set.
+
       procedure Move_Choice (From : Natural; To : Natural);
       --  Move routine for sorting the Choice_Table
 
       package Sorting is new GNAT.Heap_Sort_G (Move_Choice, Lt_Choice);
 
-      procedure Issue_Msg (Value1 : Node_Id; Value2 : Node_Id);
-      procedure Issue_Msg (Value1 : Node_Id; Value2 : Uint);
-      procedure Issue_Msg (Value1 : Uint;    Value2 : Node_Id);
-      procedure Issue_Msg (Value1 : Uint;    Value2 : Uint);
-      --  Issue an error message indicating that there are missing choices,
-      --  followed by the image of the missing choices themselves which lie
-      --  between Value1 and Value2 inclusive.
+      -----------------------------
+      -- Check_Against_Predicate --
+      -----------------------------
 
-      ---------------
-      -- Issue_Msg --
-      ---------------
+      procedure Check_Against_Predicate
+        (Pred    : in out Node_Id;
+         Choice  : Choice_Bounds;
+         Prev_Lo : in out Uint;
+         Prev_Hi : in out Uint;
+         Error   : in out Boolean)
+      is
+         procedure Illegal_Range
+           (Loc : Source_Ptr;
+            Lo  : Uint;
+            Hi  : Uint);
+         --  Emit an error message regarding a choice that clashes with the
+         --  legal static predicate sets. Loc is the location of the choice
+         --  that introduced the illegal range. Lo .. Hi is the range.
+
+         function Inside_Range
+           (Lo  : Uint;
+            Hi  : Uint;
+            Val : Uint) return Boolean;
+         --  Determine whether position Val within a discrete type is within
+         --  the range Lo .. Hi inclusive.
+
+         -------------------
+         -- Illegal_Range --
+         -------------------
+
+         procedure Illegal_Range
+           (Loc : Source_Ptr;
+            Lo  : Uint;
+            Hi  : Uint)
+         is
+         begin
+            Error_Msg_Name_1 := Chars (Bounds_Type);
 
-      procedure Issue_Msg (Value1 : Node_Id; Value2 : Node_Id) is
-      begin
-         Issue_Msg (Expr_Value (Value1), Expr_Value (Value2));
-      end Issue_Msg;
+            --  Single value
 
-      procedure Issue_Msg (Value1 : Node_Id; Value2 : Uint) is
-      begin
-         Issue_Msg (Expr_Value (Value1), Value2);
-      end Issue_Msg;
+            if Lo = Hi then
+               if Is_Integer_Type (Bounds_Type) then
+                  Error_Msg_Uint_1 := Lo;
+                  Error_Msg ("static predicate on % excludes value ^!", Loc);
+               else
+                  Error_Msg_Name_2 := Choice_Image (Lo, Bounds_Type);
+                  Error_Msg ("static predicate on % excludes value %!", Loc);
+               end if;
 
-      procedure Issue_Msg (Value1 : Uint; Value2 : Node_Id) is
-      begin
-         Issue_Msg (Value1, Expr_Value (Value2));
-      end Issue_Msg;
+            --  Range
 
-      procedure Issue_Msg (Value1 : Uint; Value2 : Uint) is
-         Msg_Sloc : constant Source_Ptr := Sloc (Case_Node);
+            else
+               if Is_Integer_Type (Bounds_Type) then
+                  Error_Msg_Uint_1 := Lo;
+                  Error_Msg_Uint_2 := Hi;
+                  Error_Msg
+                    ("static predicate on % excludes range ^ .. ^!", Loc);
+               else
+                  Error_Msg_Name_2 := Choice_Image (Lo, Bounds_Type);
+                  Error_Msg_Name_3 := Choice_Image (Hi, Bounds_Type);
+                  Error_Msg
+                    ("static predicate on % excludes range % .. %!", Loc);
+               end if;
+            end if;
+         end Illegal_Range;
+
+         ------------------
+         -- Inside_Range --
+         ------------------
+
+         function Inside_Range
+           (Lo  : Uint;
+            Hi  : Uint;
+            Val : Uint) return Boolean
+         is
+         begin
+            return
+              Val = Lo or else Val = Hi or else (Lo < Val and then Val < Hi);
+         end Inside_Range;
+
+         --  Local variables
+
+         Choice_Hi : constant Uint := Expr_Value (Choice.Hi);
+         Choice_Lo : constant Uint := Expr_Value (Choice.Lo);
+         Loc       : Source_Ptr;
+         Next_Hi   : Uint;
+         Next_Lo   : Uint;
+         Pred_Hi   : Uint;
+         Pred_Lo   : Uint;
+
+      --  Start of processing for Check_Against_Predicate
 
       begin
-         --  AI05-0188 : within an instance the non-others choices do not
-         --  have to belong to the actual subtype.
+         --  Find the proper error message location
 
-         if Ada_Version >= Ada_2012 and then In_Instance then
-            return;
+         if Present (Choice.Node) then
+            Loc := Sloc (Choice.Node);
+         else
+            Loc := Sloc (Case_Node);
          end if;
 
-         --  In some situations, we call this with a null range, and
-         --  obviously we don't want to complain in this case!
+         if Present (Pred) then
+            Pred_Lo := Expr_Value (Low_Bound  (Pred));
+            Pred_Hi := Expr_Value (High_Bound (Pred));
+
+         --  Previous choices managed to satisfy all static predicate sets
+
+         else
+            Illegal_Range (Loc, Choice_Lo, Choice_Hi);
+            Error := True;
 
-         if Value1 > Value2 then
             return;
          end if;
 
-         --  Case of only one value that is missing
+         --  Step 1: Detect duplicate choices
 
-         if Value1 = Value2 then
-            if Is_Integer_Type (Bounds_Type) then
-               Error_Msg_Uint_1 := Value1;
-               Error_Msg ("missing case value: ^!", Msg_Sloc);
+         if Inside_Range (Choice_Lo, Choice_Hi, Prev_Lo)
+           or else Inside_Range (Choice_Lo, Choice_Hi, Prev_Hi)
+         then
+            Error_Msg ("duplication of choice value", Loc);
+            Error := True;
+
+         --  Step 2: Detect full coverage
+
+         --  Choice_Lo    Choice_Hi
+         --  +============+
+         --  Pred_Lo      Pred_Hi
+
+         elsif Choice_Lo = Pred_Lo and then Choice_Hi = Pred_Hi then
+            Prev_Lo := Choice_Lo;
+            Prev_Hi := Choice_Hi;
+            Next (Pred);
+
+         --  Step 3: Detect all cases where a choice mentions values that are
+         --  not part of the static predicate sets.
+
+         --  Choice_Lo   Choice_Hi   Pred_Lo   Pred_Hi
+         --  +-----------+ . . . . . +=========+
+         --   ^ illegal ^
+
+         elsif Choice_Lo < Pred_Lo and then Choice_Hi < Pred_Lo then
+            Illegal_Range (Loc, Choice_Lo, Choice_Hi);
+            Error := True;
+
+         --  Choice_Lo   Pred_Lo   Choice_Hi   Pred_Hi
+         --  +-----------+=========+===========+
+         --   ^ illegal ^
+
+         elsif Choice_Lo < Pred_Lo
+           and then Inside_Range (Pred_Lo, Pred_Hi, Choice_Hi)
+         then
+            Illegal_Range (Loc, Choice_Lo, Pred_Lo - 1);
+            Error := True;
+
+         --  Pred_Lo   Pred_Hi   Choice_Lo   Choice_Hi
+         --  +=========+ . . . . +-----------+
+         --                       ^ illegal ^
+
+         elsif Pred_Lo < Choice_Lo and then Pred_Hi < Choice_Lo then
+            Missing_Choice (Pred_Lo, Pred_Hi);
+            Error := True;
+
+            --  There may be several static predicate sets between the current
+            --  one and the choice. Inspect the next static predicate set.
+
+            Next (Pred);
+            Check_Against_Predicate
+              (Pred    => Pred,
+               Choice  => Choice,
+               Prev_Lo => Prev_Lo,
+               Prev_Hi => Prev_Hi,
+               Error   => Error);
+
+         --  Pred_Lo   Choice_Lo   Pred_Hi     Choice_Hi
+         --  +=========+===========+-----------+
+         --                         ^ illegal ^
+
+         elsif Pred_Hi < Choice_Hi
+           and then Inside_Range (Pred_Lo, Pred_Hi, Choice_Lo)
+         then
+            Next (Pred);
+
+            --  The choice may fall in a static predicate set. If this is the
+            --  case, avoid mentioning legal values in the error message.
+
+            if Present (Pred) then
+               Next_Lo := Expr_Value (Low_Bound  (Pred));
+               Next_Hi := Expr_Value (High_Bound (Pred));
+
+               --  The next static predicate set is to the right of the choice
+
+               if Choice_Hi < Next_Lo and then Choice_Hi < Next_Hi then
+                  Illegal_Range (Loc, Pred_Hi + 1, Choice_Hi);
+               else
+                  Illegal_Range (Loc, Pred_Hi + 1, Next_Lo - 1);
+               end if;
             else
-               Error_Msg_Name_1 := Choice_Image (Value1, Bounds_Type);
-               Error_Msg ("missing case value: %!", Msg_Sloc);
+               Illegal_Range (Loc, Pred_Hi + 1, Choice_Hi);
             end if;
 
-         --  More than one choice value, so print range of values
+            Error := True;
+
+         --  Choice_Lo   Pred_Lo   Pred_Hi     Choice_Hi
+         --  +-----------+=========+-----------+
+         --   ^ illegal ^           ^ illegal ^
+
+         --  Emit an error on the low gap, disregard the upper gap
+
+         elsif Choice_Lo < Pred_Lo and then Pred_Hi < Choice_Hi then
+            Illegal_Range (Loc, Choice_Lo, Pred_Lo - 1);
+            Error := True;
+
+         --  Step 4: Detect all cases of partial or missing coverage
+
+         --  Pred_Lo   Choice_Lo  Choice_Hi   Pred_Hi
+         --  +=========+==========+===========+
+         --   ^  gap  ^            ^   gap   ^
 
          else
-            if Is_Integer_Type (Bounds_Type) then
-               Error_Msg_Uint_1 := Value1;
-               Error_Msg_Uint_2 := Value2;
-               Error_Msg ("missing case values: ^ .. ^!", Msg_Sloc);
-            else
-               Error_Msg_Name_1 := Choice_Image (Value1, Bounds_Type);
-               Error_Msg_Name_2 := Choice_Image (Value2, Bounds_Type);
-               Error_Msg ("missing case values: % .. %!", Msg_Sloc);
-            end if;
-         end if;
-      end Issue_Msg;
+            --  An "others" choice covers all gaps
 
-      ---------------
-      -- Lt_Choice --
-      ---------------
+            if Others_Present then
+               Prev_Lo := Choice_Lo;
+               Prev_Hi := Choice_Hi;
+               Next (Pred);
 
-      function Lt_Choice (C1, C2 : Natural) return Boolean is
-      begin
-         return
-           Expr_Value (Choice_Table (Nat (C1)).Lo)
-             <
-           Expr_Value (Choice_Table (Nat (C2)).Lo);
-      end Lt_Choice;
+            --  Choice_Lo   Choice_Hi   Pred_Hi
+            --  +===========+===========+
+            --  Pred_Lo      ^   gap   ^
 
-      -----------------
-      -- Move_Choice --
-      -----------------
+            --  The upper gap may be covered by a subsequent choice
 
-      procedure Move_Choice (From : Natural; To : Natural) is
-      begin
-         Choice_Table (Nat (To)) := Choice_Table (Nat (From));
-      end Move_Choice;
+            elsif Pred_Lo = Choice_Lo then
+               Prev_Lo := Choice_Lo;
+               Prev_Hi := Choice_Hi;
+
+            --  Pred_Lo     Prev_Hi   Choice_Lo   Choice_Hi   Pred_Hi
+            --  +===========+=========+===========+===========+
+            --   ^ covered ^ ^  gap  ^
+
+            else pragma Assert (Pred_Lo < Choice_Lo);
+
+               --  A previous choice covered the gap up to the current choice
+
+               if Prev_Hi = Choice_Lo - 1 then
+                  Prev_Lo := Choice_Lo;
+                  Prev_Hi := Choice_Hi;
+
+                  if Choice_Hi = Pred_Hi then
+                     Next (Pred);
+                  end if;
+
+               --  The previous choice did not intersect with the current
+               --  static predicate set.
+
+               elsif Prev_Hi < Pred_Lo then
+                  Missing_Choice (Pred_Lo, Choice_Lo - 1);
+                  Error := True;
+
+               --  The previous choice covered part of the static predicate set
+
+               else
+                  Missing_Choice (Prev_Hi, Choice_Lo - 1);
+                  Error := True;
+               end if;
+            end if;
+         end if;
+      end Check_Against_Predicate;
 
       ------------------------------
       -- Explain_Non_Static_Bound --
@@ -236,16 +438,16 @@ package body Sem_Case is
 
          if Bounds_Type /= Subtyp then
 
-            --  If the case is a variant part, the expression is given by
-            --  the discriminant itself, and the bounds are the culprits.
+            --  If the case is a variant part, the expression is given by the
+            --  discriminant itself, and the bounds are the culprits.
 
             if Nkind (Case_Node) = N_Variant_Part then
                Error_Msg_NE
                  ("bounds of & are not static," &
                      " alternatives must cover base type", Expr, Expr);
 
-            --  If this is a case statement, the expression may be
-            --  non-static or else the subtype may be at fault.
+            --  If this is a case statement, the expression may be non-static
+            --  or else the subtype may be at fault.
 
             elsif Is_Entity_Name (Expr) then
                Error_Msg_NE
@@ -269,30 +471,150 @@ package body Sem_Case is
          end if;
       end Explain_Non_Static_Bound;
 
-      --  Variables local to Check_Choices
+      ---------------
+      -- Lt_Choice --
+      ---------------
+
+      function Lt_Choice (C1, C2 : Natural) return Boolean is
+      begin
+         return
+           Expr_Value (Choice_Table (Nat (C1)).Lo)
+             <
+           Expr_Value (Choice_Table (Nat (C2)).Lo);
+      end Lt_Choice;
+
+      --------------------
+      -- Missing_Choice --
+      --------------------
 
-      Choice    : Node_Id;
-      Bounds_Lo : constant Node_Id := Type_Low_Bound  (Bounds_Type);
-      Bounds_Hi : constant Node_Id := Type_High_Bound (Bounds_Type);
+      procedure Missing_Choice (Value1 : Node_Id; Value2 : Node_Id) is
+      begin
+         Missing_Choice (Expr_Value (Value1), Expr_Value (Value2));
+      end Missing_Choice;
 
-      Prev_Choice : Node_Id;
+      procedure Missing_Choice (Value1 : Node_Id; Value2 : Uint) is
+      begin
+         Missing_Choice (Expr_Value (Value1), Value2);
+      end Missing_Choice;
+
+      procedure Missing_Choice (Value1 : Uint; Value2 : Node_Id) is
+      begin
+         Missing_Choice (Value1, Expr_Value (Value2));
+      end Missing_Choice;
+
+      procedure Missing_Choice (Value1 : Uint; Value2 : Uint) is
+         Msg_Sloc : constant Source_Ptr := Sloc (Case_Node);
+
+      begin
+         --  AI05-0188 : within an instance the non-others choices do not have
+         --  to belong to the actual subtype.
+
+         if Ada_Version >= Ada_2012 and then In_Instance then
+            return;
+
+         --  In some situations, we call this with a null range, and obviously
+         --  we don't want to complain in this case.
+
+         elsif Value1 > Value2 then
+            return;
+         end if;
+
+         --  Case of only one value that is missing
+
+         if Value1 = Value2 then
+            if Is_Integer_Type (Bounds_Type) then
+               Error_Msg_Uint_1 := Value1;
+               Error_Msg ("missing case value: ^!", Msg_Sloc);
+            else
+               Error_Msg_Name_1 := Choice_Image (Value1, Bounds_Type);
+               Error_Msg ("missing case value: %!", Msg_Sloc);
+            end if;
+
+         --  More than one choice value, so print range of values
+
+         else
+            if Is_Integer_Type (Bounds_Type) then
+               Error_Msg_Uint_1 := Value1;
+               Error_Msg_Uint_2 := Value2;
+               Error_Msg ("missing case values: ^ .. ^!", Msg_Sloc);
+            else
+               Error_Msg_Name_1 := Choice_Image (Value1, Bounds_Type);
+               Error_Msg_Name_2 := Choice_Image (Value2, Bounds_Type);
+               Error_Msg ("missing case values: % .. %!", Msg_Sloc);
+            end if;
+         end if;
+      end Missing_Choice;
+
+      ---------------------
+      -- Missing_Choices --
+      ---------------------
 
-      Hi      : Uint;
-      Lo      : Uint;
-      Prev_Hi : Uint;
+      procedure Missing_Choices (Pred : Node_Id; Prev_Hi : Uint) is
+         Hi  : Uint;
+         Lo  : Uint;
+         Set : Node_Id;
+
+      begin
+         Set := Pred;
+         while Present (Set) loop
+            Lo := Expr_Value (Low_Bound (Set));
+            Hi := Expr_Value (High_Bound (Set));
+
+            --  A choice covered part of a static predicate set
+
+            if Lo <= Prev_Hi and then Prev_Hi < Hi then
+               Missing_Choice (Prev_Hi + 1, Hi);
+
+            else
+               Missing_Choice (Lo, Hi);
+            end if;
+
+            Next (Set);
+         end loop;
+      end Missing_Choices;
+
+      -----------------
+      -- Move_Choice --
+      -----------------
+
+      procedure Move_Choice (From : Natural; To : Natural) is
+      begin
+         Choice_Table (Nat (To)) := Choice_Table (Nat (From));
+      end Move_Choice;
+
+      --  Local variables
+
+      Bounds_Hi     : constant Node_Id := Type_High_Bound (Bounds_Type);
+      Bounds_Lo     : constant Node_Id := Type_Low_Bound  (Bounds_Type);
+      Has_Predicate : constant Boolean :=
+                        Is_Static_Subtype (Bounds_Type)
+                          and then Present (Static_Predicate (Bounds_Type));
+      Num_Choices   : constant Nat     := Choice_Table'Last;
+
+      Choice      : Node_Id;
+      Choice_Hi   : Uint;
+      Choice_Lo   : Uint;
+      Error       : Boolean;
+      Pred        : Node_Id;
+      Prev_Choice : Node_Id;
+      Prev_Lo     : Uint;
+      Prev_Hi     : Uint;
 
    --  Start of processing for Check_Choices
 
    begin
-      --  Choice_Table must start at 0 which is an unused location used
-      --  by the sorting algorithm. However the first valid position for
-      --  a discrete choice is 1.
+      --  Choice_Table must start at 0 which is an unused location used by the
+      --  sorting algorithm. However the first valid position for a discrete
+      --  choice is 1.
 
       pragma Assert (Choice_Table'First = 0);
 
-      if Choice_Table'Last = 0 then
+      --  The choices do not cover the base range. Emit an error if "others" is
+      --  not available and return as there is no need for further processing.
+
+      if Num_Choices = 0 then
          if not Others_Present then
-            Issue_Msg (Bounds_Lo, Bounds_Hi);
+            Missing_Choice (Bounds_Lo, Bounds_Hi);
          end if;
 
          return;
@@ -300,59 +622,98 @@ package body Sem_Case is
 
       Sorting.Sort (Positive (Choice_Table'Last));
 
-      Lo      := Expr_Value (Choice_Table (1).Lo);
-      Hi      := Expr_Value (Choice_Table (1).Hi);
-      Prev_Hi := Hi;
+      --  The type covered by the list of choices is actually a static subtype
+      --  subject to a static predicate. The predicate defines subsets of legal
+      --  values and requires finer grained analysis.
+
+      if Has_Predicate then
+         Pred    := First (Static_Predicate (Bounds_Type));
+         Prev_Lo := Uint_Minus_1;
+         Prev_Hi := Uint_Minus_1;
+         Error   := False;
+
+         for Index in 1 .. Num_Choices loop
+            Check_Against_Predicate
+              (Pred    => Pred,
+               Choice  => Choice_Table (Index),
+               Prev_Lo => Prev_Lo,
+               Prev_Hi => Prev_Hi,
+               Error   => Error);
+
+            --  The analysis detected an illegal intersection between a choice
+            --  and a static predicate set.
 
-      if not Others_Present and then Expr_Value (Bounds_Lo) < Lo then
-         Issue_Msg (Bounds_Lo, Lo - 1);
+            if Error then
+               return;
+            end if;
+         end loop;
 
-         --  If values are missing outside of the subtype, add explanation.
-         --  No additional message if only one value is missing.
+         --  The choices may legally cover some of the static predicate sets,
+         --  but not all. Emit an error for each non-covered set.
 
-         if Expr_Value (Bounds_Lo) < Lo - 1 then
-            Explain_Non_Static_Bound;
+         if not Others_Present then
+            Missing_Choices (Pred, Prev_Hi);
          end if;
-      end if;
 
-      for J in 2 .. Choice_Table'Last loop
-         Lo := Expr_Value (Choice_Table (J).Lo);
-         Hi := Expr_Value (Choice_Table (J).Hi);
+      --  Default analysis
 
-         if Lo <= Prev_Hi then
-            Choice := Choice_Table (J).Node;
+      else
+         Choice_Lo := Expr_Value (Choice_Table (1).Lo);
+         Choice_Hi := Expr_Value (Choice_Table (1).Hi);
+         Prev_Hi   := Choice_Hi;
 
-            --  Find first previous choice that overlaps
+         if not Others_Present and then Expr_Value (Bounds_Lo) < Choice_Lo then
+            Missing_Choice (Bounds_Lo, Choice_Lo - 1);
 
-            for K in 1 .. J - 1 loop
-               if Lo <= Expr_Value (Choice_Table (K).Hi) then
-                  Prev_Choice := Choice_Table (K).Node;
-                  exit;
-               end if;
-            end loop;
+            --  If values are missing outside of the subtype, add explanation.
+            --  No additional message if only one value is missing.
 
-            if Sloc (Prev_Choice) <= Sloc (Choice) then
-               Error_Msg_Sloc := Sloc (Prev_Choice);
-               Error_Msg_N ("duplication of choice value#", Choice);
-            else
-               Error_Msg_Sloc := Sloc (Choice);
-               Error_Msg_N ("duplication of choice value#", Prev_Choice);
+            if Expr_Value (Bounds_Lo) < Choice_Lo - 1 then
+               Explain_Non_Static_Bound;
             end if;
-
-         elsif not Others_Present and then Lo /= Prev_Hi + 1 then
-            Issue_Msg (Prev_Hi + 1, Lo - 1);
          end if;
 
-         if Hi > Prev_Hi then
-            Prev_Hi := Hi;
-         end if;
-      end loop;
+         for Outer_Index in 2 .. Num_Choices loop
+            Choice_Lo := Expr_Value (Choice_Table (Outer_Index).Lo);
+            Choice_Hi := Expr_Value (Choice_Table (Outer_Index).Hi);
+
+            if Choice_Lo <= Prev_Hi then
+               Choice := Choice_Table (Outer_Index).Node;
 
-      if not Others_Present and then Expr_Value (Bounds_Hi) > Hi then
-         Issue_Msg (Hi + 1, Bounds_Hi);
+               --  Find first previous choice that overlaps
 
-         if Expr_Value (Bounds_Hi) > Hi + 1 then
-            Explain_Non_Static_Bound;
+               for Inner_Index in 1 .. Outer_Index - 1 loop
+                  if Choice_Lo <=
+                       Expr_Value (Choice_Table (Inner_Index).Hi)
+                  then
+                     Prev_Choice := Choice_Table (Inner_Index).Node;
+                     exit;
+                  end if;
+               end loop;
+
+               if Sloc (Prev_Choice) <= Sloc (Choice) then
+                  Error_Msg_Sloc := Sloc (Prev_Choice);
+                  Error_Msg_N ("duplication of choice value#", Choice);
+               else
+                  Error_Msg_Sloc := Sloc (Choice);
+                  Error_Msg_N ("duplication of choice value#", Prev_Choice);
+               end if;
+
+            elsif not Others_Present and then Choice_Lo /= Prev_Hi + 1 then
+               Missing_Choice (Prev_Hi + 1, Choice_Lo - 1);
+            end if;
+
+            if Choice_Hi > Prev_Hi then
+               Prev_Hi := Choice_Hi;
+            end if;
+         end loop;
+
+         if not Others_Present and then Expr_Value (Bounds_Hi) > Choice_Hi then
+            Missing_Choice (Choice_Hi + 1, Bounds_Hi);
+
+            if Expr_Value (Bounds_Hi) > Choice_Hi + 1 then
+               Explain_Non_Static_Bound;
+            end if;
          end if;
       end if;
    end Check_Choices;
diff --git a/gcc/ada/sem_ch13.adb b/gcc/ada/sem_ch13.adb
index 832e7c2..654df43 100644
--- a/gcc/ada/sem_ch13.adb
+++ b/gcc/ada/sem_ch13.adb
@@ -93,7 +93,7 @@ package body Sem_Ch13 is
    --  the function is inserted before the freeze node, and the body of the
    --  function is inserted after the freeze node. If the predicate expression
    --  has at least one Raise_Expression, then this procedure also builds the
-   --  M version of the predicate function for ue in membership tests.
+   --  M version of the predicate function for use in membership tests.
 
    procedure Build_Static_Predicate
      (Typ  : Entity_Id;
@@ -6188,15 +6188,15 @@ package body Sem_Ch13 is
       type REnt is record
          Lo, Hi : Uint;
       end record;
-      --  One entry in a Rlist value, a single REnt (range entry) value
-      --  denotes one range from Lo to Hi. To represent a single value
-      --  range Lo = Hi = value.
+      --  One entry in a Rlist value, a single REnt (range entry) value denotes
+      --  one range from Lo to Hi. To represent a single value range Lo = Hi =
+      --  value.
 
       type RList is array (Nat range <>) of REnt;
-      --  A list of ranges. The ranges are sorted in increasing order,
-      --  and are disjoint (there is a gap of at least one value between
-      --  each range in the table). A value is in the set of ranges in
-      --  Rlist if it lies within one of these ranges
+      --  A list of ranges. The ranges are sorted in increasing order, and are
+      --  disjoint (there is a gap of at least one value between each range in
+      --  the table). A value is in the set of ranges in Rlist if it lies
+      --  within one of these ranges.
 
       False_Range : constant RList :=
                       RList'(1 .. 0 => REnt'(No_Uint, No_Uint));
@@ -6210,41 +6210,41 @@ package body Sem_Ch13 is
       True_Range : constant RList := RList'(1 => REnt'(BLo, BHi));
       --  Range representing True, value must be in the base range
 
-      function "and" (Left, Right : RList) return RList;
-      --  And's together two range lists, returning a range list. This is
-      --  a set intersection operation.
+      function "and" (Left : RList; Right : RList) return RList;
+      --  And's together two range lists, returning a range list. This is a set
+      --  intersection operation.
 
-      function "or" (Left, Right : RList) return RList;
-      --  Or's together two range lists, returning a range list. This is a
-      --  set union operation.
+      function "or" (Left : RList; Right : RList) return RList;
+      --  Or's together two range lists, returning a range list. This is a set
+      --  union operation.
 
       function "not" (Right : RList) return RList;
       --  Returns complement of a given range list, i.e. a range list
-      --  representing all the values in TLo .. THi that are not in the
-      --  input operand Right.
+      --  representing all the values in TLo .. THi that are not in the input
+      --  operand Right.
 
       function Build_Val (V : Uint) return Node_Id;
       --  Return an analyzed N_Identifier node referencing this value, suitable
       --  for use as an entry in the Static_Predicate list. This node is typed
       --  with the base type.
 
-      function Build_Range (Lo, Hi : Uint) return Node_Id;
-      --  Return an analyzed N_Range node referencing this range, suitable
-      --  for use as an entry in the Static_Predicate list. This node is typed
-      --  with the base type.
+      function Build_Range (Lo : Uint; Hi : Uint) return Node_Id;
+      --  Return an analyzed N_Range node referencing this range, suitable for
+      --  use as an entry in the Static_Predicate list. This node is typed with
+      --  the base type.
 
       function Get_RList (Exp : Node_Id) return RList;
-      --  This is a recursive routine that converts the given expression into
-      --  a list of ranges, suitable for use in building the static predicate.
+      --  This is a recursive routine that converts the given expression into a
+      --  list of ranges, suitable for use in building the static predicate.
 
       function Is_False (R : RList) return Boolean;
       pragma Inline (Is_False);
-      --  Returns True if the given range list is empty, and thus represents
-      --  a False list of ranges that can never be satisfied.
+      --  Returns True if the given range list is empty, and thus represents a
+      --  False list of ranges that can never be satisfied.
 
       function Is_True (R : RList) return Boolean;
-      --  Returns True if R trivially represents the True predicate by having
-      --  a single range from BLo to BHi.
+      --  Returns True if R trivially represents the True predicate by having a
+      --  single range from BLo to BHi.
 
       function Is_Type_Ref (N : Node_Id) return Boolean;
       pragma Inline (Is_Type_Ref);
@@ -6277,7 +6277,7 @@ package body Sem_Ch13 is
       -- "and" --
       -----------
 
-      function "and" (Left, Right : RList) return RList is
+      function "and" (Left : RList; Right : RList) return RList is
          FEnt : REnt;
          --  First range of result
 
@@ -6302,8 +6302,8 @@ package body Sem_Ch13 is
             return False_Range;
          end if;
 
-         --  Loop to remove entries at start that are disjoint, and thus
-         --  just get discarded from the result entirely.
+         --  Loop to remove entries at start that are disjoint, and thus just
+         --  get discarded from the result entirely.
 
          loop
             --  If no operands left in either operand, result is false
@@ -6328,15 +6328,15 @@ package body Sem_Ch13 is
             end if;
          end loop;
 
-         --  Now we have two non-null operands, and first entries overlap.
-         --  The first entry in the result will be the overlapping part of
-         --  these two entries.
+         --  Now we have two non-null operands, and first entries overlap. The
+         --  first entry in the result will be the overlapping part of these
+         --  two entries.
 
          FEnt := REnt'(Lo => UI_Max (Left (SLeft).Lo, Right (SRight).Lo),
                        Hi => UI_Min (Left (SLeft).Hi, Right (SRight).Hi));
 
-         --  Now we can remove the entry that ended at a lower value, since
-         --  its contribution is entirely contained in Fent.
+         --  Now we can remove the entry that ended at a lower value, since its
+         --  contribution is entirely contained in Fent.
 
          if Left (SLeft).Hi <= Right (SRight).Hi then
             SLeft := SLeft + 1;
@@ -6344,10 +6344,10 @@ package body Sem_Ch13 is
             SRight := SRight + 1;
          end if;
 
-         --  Compute result by concatenating this first entry with the "and"
-         --  of the remaining parts of the left and right operands. Note that
-         --  if either of these is empty, "and" will yield empty, so that we
-         --  will end up with just Fent, which is what we want in that case.
+         --  Compute result by concatenating this first entry with the "and" of
+         --  the remaining parts of the left and right operands. Note that if
+         --  either of these is empty, "and" will yield empty, so that we will
+         --  end up with just Fent, which is what we want in that case.
 
          return
            FEnt & (Left (SLeft .. Left'Last) and Right (SRight .. Right'Last));
@@ -6411,7 +6411,7 @@ package body Sem_Ch13 is
       -- "or" --
       ----------
 
-      function "or" (Left, Right : RList) return RList is
+      function "or" (Left : RList; Right : RList) return RList is
          FEnt : REnt;
          --  First range of result
 
@@ -6436,8 +6436,8 @@ package body Sem_Ch13 is
             return Left;
          end if;
 
-         --  Initialize result first entry from left or right operand
-         --  depending on which starts with the lower range.
+         --  Initialize result first entry from left or right operand depending
+         --  on which starts with the lower range.
 
          if Left (SLeft).Lo < Right (SRight).Lo then
             FEnt := Left (SLeft);
@@ -6447,12 +6447,12 @@ package body Sem_Ch13 is
             SRight := SRight + 1;
          end if;
 
-         --  This loop eats ranges from left and right operands that
-         --  are contiguous with the first range we are gathering.
+         --  This loop eats ranges from left and right operands that are
+         --  contiguous with the first range we are gathering.
 
          loop
-            --  Eat first entry in left operand if contiguous or
-            --  overlapped by gathered first operand of result.
+            --  Eat first entry in left operand if contiguous or overlapped by
+            --  gathered first operand of result.
 
             if SLeft <= Left'Last
               and then Left (SLeft).Lo <= FEnt.Hi + 1
@@ -6460,8 +6460,8 @@ package body Sem_Ch13 is
                FEnt.Hi := UI_Max (FEnt.Hi, Left (SLeft).Hi);
                SLeft := SLeft + 1;
 
-               --  Eat first entry in right operand if contiguous or
-               --  overlapped by gathered right operand of result.
+            --  Eat first entry in right operand if contiguous or overlapped by
+            --  gathered right operand of result.
 
             elsif SRight <= Right'Last
               and then Right (SRight).Lo <= FEnt.Hi + 1
@@ -6469,7 +6469,7 @@ package body Sem_Ch13 is
                FEnt.Hi := UI_Max (FEnt.Hi, Right (SRight).Hi);
                SRight := SRight + 1;
 
-               --  All done if no more entries to eat!
+            --  All done if no more entries to eat
 
             else
                exit;
@@ -6488,20 +6488,18 @@ package body Sem_Ch13 is
       -- Build_Range --
       -----------------
 
-      function Build_Range (Lo, Hi : Uint) return Node_Id is
+      function Build_Range (Lo : Uint; Hi : Uint) return Node_Id is
          Result : Node_Id;
+
       begin
-         if Lo = Hi then
-            return Build_Val (Hi);
-         else
-            Result :=
-              Make_Range (Loc,
-                Low_Bound  => Build_Val (Lo),
-                High_Bound => Build_Val (Hi));
-            Set_Etype (Result, Btyp);
-            Set_Analyzed (Result);
-            return Result;
-         end if;
+         Result :=
+           Make_Range (Loc,
+             Low_Bound  => Build_Val (Lo),
+             High_Bound => Build_Val (Hi));
+         Set_Etype (Result, Btyp);
+         Set_Analyzed (Result);
+
+         return Result;
       end Build_Range;
 
       ---------------
@@ -6911,11 +6909,7 @@ package body Sem_Ch13 is
 
                   --  Convert range into required form
 
-                  if Lo = Hi then
-                     Append_To (Plist, Build_Val (Lo));
-                  else
-                     Append_To (Plist, Build_Range (Lo, Hi));
-                  end if;
+                  Append_To (Plist, Build_Range (Lo, Hi));
                end if;
             end;
          end loop;
@@ -9452,12 +9446,12 @@ package body Sem_Ch13 is
       --  storage orders differ.
 
       if (Is_Record_Type (T1) or else Is_Array_Type (T1))
-        and then
+            and then
          (Is_Record_Type (T2) or else Is_Array_Type (T2))
         and then
          (Component_Alignment (T1) /= Component_Alignment (T2)
             or else
-          Reverse_Storage_Order (T1) /= Reverse_Storage_Order (T2))
+              Reverse_Storage_Order (T1) /= Reverse_Storage_Order (T2))
       then
          return False;
       end if;
diff --git a/gcc/ada/sem_ch4.adb b/gcc/ada/sem_ch4.adb
index 421cd81..cd26260 100644
--- a/gcc/ada/sem_ch4.adb
+++ b/gcc/ada/sem_ch4.adb
@@ -1248,14 +1248,8 @@ package body Sem_Ch4 is
    -----------------------------
 
    procedure Analyze_Case_Expression (N : Node_Id) is
-      Expr      : constant Node_Id := Expression (N);
-      FirstX    : constant Node_Id := Expression (First (Alternatives (N)));
-      Alt       : Node_Id;
-      Exp_Type  : Entity_Id;
-      Exp_Btype : Entity_Id;
-
-      Dont_Care      : Boolean;
-      Others_Present : Boolean;
+      function Has_Static_Predicate (Subtyp : Entity_Id) return Boolean;
+      --  Determine whether subtype Subtyp has aspect Static_Predicate
 
       procedure Non_Static_Choice_Error (Choice : Node_Id);
       --  Error routine invoked by the generic instantiation below when
@@ -1270,6 +1264,28 @@ package body Sem_Ch4 is
            Process_Associated_Node   => No_OP);
       use Case_Choices_Processing;
 
+      --------------------------
+      -- Has_Static_Predicate --
+      --------------------------
+
+      function Has_Static_Predicate (Subtyp : Entity_Id) return Boolean is
+         Item : Node_Id;
+
+      begin
+         Item := First_Rep_Item (Subtyp);
+         while Present (Item) loop
+            if Nkind (Item) = N_Aspect_Specification
+              and then Chars (Identifier (Item)) = Name_Static_Predicate
+            then
+               return True;
+            end if;
+
+            Next_Rep_Item (Item);
+         end loop;
+
+         return False;
+      end Has_Static_Predicate;
+
       -----------------------------
       -- Non_Static_Choice_Error --
       -----------------------------
@@ -1280,6 +1296,17 @@ package body Sem_Ch4 is
            ("choice given in case expression is not static!", Choice);
       end Non_Static_Choice_Error;
 
+      --  Local variables
+
+      Expr      : constant Node_Id := Expression (N);
+      FirstX    : constant Node_Id := Expression (First (Alternatives (N)));
+      Alt       : Node_Id;
+      Exp_Type  : Entity_Id;
+      Exp_Btype : Entity_Id;
+
+      Dont_Care      : Boolean;
+      Others_Present : Boolean;
+
    --  Start of processing for Analyze_Case_Expression
 
    begin
@@ -1364,9 +1391,22 @@ package body Sem_Ch4 is
          Exp_Type := Exp_Btype;
       end if;
 
+      --  The case expression alternatives cover the range of a static subtype
+      --  subject to aspect Static_Predicate. Do not check the choices when the
+      --  case expression has not been fully analyzed yet because this may lead
+      --  to bogus errors.
+
+      if Is_Static_Subtype (Exp_Type)
+        and then Has_Static_Predicate (Exp_Type)
+        and then In_Spec_Expression
+      then
+         null;
+
       --  Call instantiated Analyze_Choices which does the rest of the work
 
-      Analyze_Choices (N, Exp_Type, Dont_Care, Others_Present);
+      else
+         Analyze_Choices (N, Exp_Type, Dont_Care, Others_Present);
+      end if;
 
       if Exp_Type = Universal_Integer and then not Others_Present then
          Error_Msg_N
@@ -1896,10 +1936,9 @@ package body Sem_Ch4 is
 
    begin
       A := First (Actions (N));
-      loop
+      while Present (A) loop
          Analyze (A);
          Next (A);
-         exit when No (A);
       end loop;
 
       --  This test needs a comment ???
diff --git a/gcc/ada/set_targ.adb b/gcc/ada/set_targ.adb
new file mode 100755
index 0000000..ee72d57
--- /dev/null
+++ b/gcc/ada/set_targ.adb
@@ -0,0 +1,854 @@
+------------------------------------------------------------------------------
+--                                                                          --
+--                         GNAT COMPILER COMPONENTS                         --
+--                                                                          --
+--                             S E T _ T A R G                              --
+--                                                                          --
+--                                 B o d y                                  --
+--                                                                          --
+--            Copyright (C) 2013, Free Software Foundation, Inc.            --
+--                                                                          --
+-- GNAT is free software;  you can  redistribute it  and/or modify it under --
+-- terms of the  GNU General Public License as published  by the Free Soft- --
+-- ware  Foundation;  either version 3,  or (at your option) any later ver- --
+-- sion.  GNAT is distributed in the hope that it will be useful, but WITH- --
+-- OUT ANY WARRANTY;  without even the  implied warranty of MERCHANTABILITY --
+-- or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU General Public License --
+-- for  more details.  You should have  received  a copy of the GNU General --
+-- Public License  distributed with GNAT; see file COPYING3.  If not, go to --
+-- http://www.gnu.org/licenses for a complete copy of the license.          --
+--                                                                          --
+-- GNAT was originally developed  by the GNAT team at  New York University. --
+-- Extensive contributions were provided by Ada Core Technologies Inc.      --
+--                                                                          --
+------------------------------------------------------------------------------
+
+with Debug;    use Debug;
+with Get_Targ; use Get_Targ;
+with Opt;      use Opt;
+with Output;   use Output;
+
+with System;        use System;
+with System.OS_Lib; use System.OS_Lib;
+
+with Unchecked_Conversion;
+
+package body Set_Targ is
+
+   ---------------------------------------------
+   -- Data Used to Read/Write target.atp File --
+   ---------------------------------------------
+
+   File_Name : aliased constant String := "target.atp";
+   --  Name of file to read/write
+
+   --  Table of string names written to file
+
+   subtype Str is String;
+
+   S_Bits_BE                    : constant Str := "Bits_BE";
+   S_Bits_Per_Unit              : constant Str := "Bits_Per_Unit";
+   S_Bits_Per_Word              : constant Str := "Bits_Per_Word";
+   S_Bytes_BE                   : constant Str := "Bytes_BE";
+   S_Char_Size                  : constant Str := "Char_Size";
+   S_Double_Float_Alignment     : constant Str := "Double_Float_Alignment";
+   S_Double_Scalar_Alignment    : constant Str := "Double_Scalar_Alignment";
+   S_Double_Size                : constant Str := "Double_Size";
+   S_Float_Size                 : constant Str := "Float_Size";
+   S_Float_Words_BE             : constant Str := "Float_Words_BE";
+   S_Int_Size                   : constant Str := "Int_Size";
+   S_Long_Double_Size           : constant Str := "Long_Double_Size";
+   S_Long_Long_Size             : constant Str := "Long_Long_Size";
+   S_Long_Size                  : constant Str := "Long_Size";
+   S_Maximum_Alignment          : constant Str := "Maximum_Alignment";
+   S_Max_Unaligned_Field        : constant Str := "Max_Unaligned_Field";
+   S_Pointer_Size               : constant Str := "Pointer_Size";
+   S_Short_Size                 : constant Str := "Short_Size";
+   S_Strict_Alignment           : constant Str := "Strict_Alignment";
+   S_System_Allocator_Alignment : constant Str := "System_Allocator_Alignment";
+   S_Wchar_T_Size               : constant Str := "Wchar_T_Size";
+   S_Words_BE                   : constant Str := "Words_BE";
+
+   --  Table of names
+
+   type AStr is access all String;
+
+   DTN : constant array (Nat range <>) of AStr := (
+          S_Bits_BE                    'Unrestricted_Access,
+          S_Bits_Per_Unit              'Unrestricted_Access,
+          S_Bits_Per_Word              'Unrestricted_Access,
+          S_Bytes_BE                   'Unrestricted_Access,
+          S_Char_Size                  'Unrestricted_Access,
+          S_Double_Float_Alignment     'Unrestricted_Access,
+          S_Double_Scalar_Alignment    'Unrestricted_Access,
+          S_Double_Size                'Unrestricted_Access,
+          S_Float_Size                 'Unrestricted_Access,
+          S_Float_Words_BE             'Unrestricted_Access,
+          S_Int_Size                   'Unrestricted_Access,
+          S_Long_Double_Size           'Unrestricted_Access,
+          S_Long_Long_Size             'Unrestricted_Access,
+          S_Long_Size                  'Unrestricted_Access,
+          S_Maximum_Alignment          'Unrestricted_Access,
+          S_Max_Unaligned_Field        'Unrestricted_Access,
+          S_Pointer_Size               'Unrestricted_Access,
+          S_Short_Size                 'Unrestricted_Access,
+          S_Strict_Alignment           'Unrestricted_Access,
+          S_System_Allocator_Alignment 'Unrestricted_Access,
+          S_Wchar_T_Size               'Unrestricted_Access,
+          S_Words_BE                   'Unrestricted_Access);
+
+   --  Table of corresponding value pointers
+
+   DTV : constant array (Nat range <>) of System.Address := (
+          Bits_BE                    'Address,
+          Bits_Per_Unit              'Address,
+          Bits_Per_Word              'Address,
+          Bytes_BE                   'Address,
+          Char_Size                  'Address,
+          Double_Float_Alignment     'Address,
+          Double_Scalar_Alignment    'Address,
+          Double_Size                'Address,
+          Float_Size                 'Address,
+          Float_Words_BE             'Address,
+          Int_Size                   'Address,
+          Long_Double_Size           'Address,
+          Long_Long_Size             'Address,
+          Long_Size                  'Address,
+          Maximum_Alignment          'Address,
+          Max_Unaligned_Field        'Address,
+          Pointer_Size               'Address,
+          Short_Size                 'Address,
+          Strict_Alignment           'Address,
+          System_Allocator_Alignment 'Address,
+          Wchar_T_Size               'Address,
+          Words_BE                   'Address);
+
+   DTR : array (Nat range DTV'Range) of Boolean := (others => False);
+   --  Table of flags used to validate that all values are present in file
+
+   -----------------------
+   -- Local Subprograms --
+   -----------------------
+
+   procedure Fail (E : String);
+   pragma No_Return (Fail);
+   --  Terminate program with fatal error message passed as parameter
+
+   type C_String is array (0 .. 255) of aliased Character;
+   pragma Convention (C, C_String);
+   --  String long enough to hold any mode name for the following call
+
+   procedure Register_Float_Type
+     (Name      : C_String;
+      Digs      : Natural;
+      Complex   : Boolean;
+      Count     : Natural;
+      Float_Rep : Float_Rep_Kind;
+      Size      : Positive;
+      Alignment : Natural);
+   pragma Convention (C, Register_Float_Type);
+   --  Call back to allow the back end to register available types. This call
+   --  back makes entries in the FPT_Mode_Table for any floating point types
+   --  reported by the back end. Name is the name of the type as a normal
+   --  format Null-terminated string. Digs is the number of digits, where 0
+   --  means it is not a fpt type (ignored during registration). Complex is
+   --  non-zero if the type has real and imaginary parts (also ignored during
+   --  registration). Count is the number of elements in a vector type (zero =
+   --  not a vector, registration ignores vectors). Float_Rep shows the kind of
+   --  floating-point type, and Size/Alignment are the size/alignment in bits.
+   --
+   --  So to summarize, the only types that are actually registered have Digs
+   --  non-zero, Complex zero (false), and Count zero (not a vector).
+
+   ----------
+   -- Fail --
+   ----------
+
+   procedure Fail (E : String) is
+      E_Fatal : constant := 4;
+      --  Code for fatal error
+   begin
+      Write_Str (E);
+      Write_Eol;
+      OS_Exit (E_Fatal);
+   end Fail;
+
+   -------------------------
+   -- Register_Float_Type --
+   -------------------------
+
+   procedure Register_Float_Type
+     (Name      : C_String;
+      Digs      : Natural;
+      Complex   : Boolean;
+      Count     : Natural;
+      Float_Rep : Float_Rep_Kind;
+      Size      : Positive;
+      Alignment : Natural)
+   is
+      T    : String (1 .. Name'Length);
+      Last : Natural := 0;
+
+      procedure Dump;
+      --  Dump information given by the back end for the type to register
+
+      ----------
+      -- Dump --
+      ----------
+
+      procedure Dump is
+      begin
+         Write_Str ("type " & T (1 .. Last) & " is ");
+
+         if Count > 0 then
+            Write_Str ("array (1 .. ");
+            Write_Int (Int (Count));
+
+            if Complex then
+               Write_Str (", 1 .. 2");
+            end if;
+
+            Write_Str (") of ");
+
+         elsif Complex then
+            Write_Str ("array (1 .. 2) of ");
+         end if;
+
+         if Digs > 0 then
+            Write_Str ("digits ");
+            Write_Int (Int (Digs));
+            Write_Line (";");
+
+            Write_Str ("pragma Float_Representation (");
+
+            case Float_Rep is
+               when IEEE_Binary =>
+                  Write_Str ("IEEE");
+
+               when VAX_Native =>
+                  case Digs is
+                     when  6 =>
+                        Write_Str ("VAXF");
+
+                     when  9 =>
+                        Write_Str ("VAXD");
+
+                     when 15 =>
+                        Write_Str ("VAXG");
+
+                     when others =>
+                        Write_Str ("VAX_");
+                        Write_Int (Int (Digs));
+                  end case;
+
+               when AAMP =>         Write_Str ("AAMP");
+            end case;
+
+            Write_Line (", " & T (1 .. Last) & ");");
+
+         else
+            Write_Str ("mod 2**");
+            Write_Int (Int (Size / Positive'Max (1, Count)));
+            Write_Line (";");
+         end if;
+
+         Write_Str ("for " & T (1 .. Last) & "'Size use ");
+         Write_Int (Int (Size));
+         Write_Line (";");
+
+         Write_Str ("for " & T (1 .. Last) & "'Alignment use ");
+         Write_Int (Int (Alignment / 8));
+         Write_Line (";");
+         Write_Eol;
+      end Dump;
+
+   --  Start of processing for Register_Float_Type
+
+   begin
+      --  Acquire name
+
+      for J in T'Range loop
+         T (J) := Name (Name'First + J - 1);
+
+         if T (J) = ASCII.NUL then
+            Last := J - 1;
+            exit;
+         end if;
+      end loop;
+
+      --  Dump info if debug flag set
+
+      if Debug_Flag_Dot_B then
+         Dump;
+      end if;
+
+      --  Acquire entry if non-vector non-complex fpt type (digits non-zero)
+
+      if Digs > 0 and then not Complex and then Count = 0 then
+         Num_FPT_Modes := Num_FPT_Modes + 1;
+         FPT_Mode_Table (Num_FPT_Modes) :=
+           (NAME      => new String'(T (1 .. Last)),
+            DIGS      => Digs,
+            FLOAT_REP => Float_Rep,
+            SIZE      => Size,
+            ALIGNMENT => Alignment);
+      end if;
+   end Register_Float_Type;
+
+   -----------------------------------
+   -- Write_Target_Dependent_Values --
+   -----------------------------------
+
+   --  We do this at the System.Os_Lib level, since we have to do the read at
+   --  that level anyway, so it is easier and more consistent to follow the
+   --  same path for the write.
+
+   procedure Write_Target_Dependent_Values is
+      Fdesc  : File_Descriptor;
+      OK     : Boolean;
+
+      Buffer : String (1 .. 80);
+      Buflen : Natural;
+      --  Buffer used to build line one of file
+
+      type ANat is access all Natural;
+      --  Pointer to Nat or Pos value (it is harmless to treat Pos values and
+      --  Nat values as Natural via Unchecked_Conversion).
+
+      function To_ANat is new Unchecked_Conversion (Address, ANat);
+
+      procedure AddC (C : Character);
+      --  Add one character to buffer
+
+      procedure AddN (N : Natural);
+      --  Add representation of integer N to Buffer, updating Buflen. N
+      --  must be less than 1000, and output is 3 characters with leading
+      --  spaces as needed.
+
+      procedure Write_Line;
+      --  Output contents of Buffer (1 .. Buflen) followed by a New_Line,
+      --  and set Buflen back to zero.
+
+      ----------
+      -- AddC --
+      ----------
+
+      procedure AddC (C : Character) is
+      begin
+         Buflen := Buflen + 1;
+         Buffer (Buflen) := C;
+      end AddC;
+
+      ----------
+      -- AddN --
+      ----------
+
+      procedure AddN (N : Natural) is
+      begin
+         if N > 999 then
+            raise Program_Error;
+         end if;
+
+         if N > 99 then
+            AddC (Character'Val (48 + N / 100));
+         else
+            AddC (' ');
+         end if;
+
+         if N > 9 then
+            AddC (Character'Val (48 + N / 10 mod 10));
+         else
+            AddC (' ');
+         end if;
+
+         AddC (Character'Val (48 + N mod 10));
+      end AddN;
+
+      ----------------
+      -- Write_Line --
+      ----------------
+
+      procedure Write_Line is
+      begin
+         AddC (ASCII.LF);
+
+         if Buflen /= Write (Fdesc, Buffer'Address, Buflen) then
+            Delete_File (File_Name'Address, OK);
+            Fail ("disk full writing target.atp");
+         end if;
+
+         Buflen := 0;
+      end Write_Line;
+
+   --  Start of processing for Write_Target_Dependent_Values
+
+   begin
+      Fdesc := Create_File (File_Name'Address, Text);
+
+      if Fdesc = Invalid_FD then
+         Fail ("cannot create target.atp");
+      end if;
+
+      --  Loop through values
+
+      for J in DTN'Range loop
+
+         --  Output name
+
+         Buflen := DTN (J)'Length;
+         Buffer (1 .. Buflen) := DTN (J).all;
+
+         --  Line up values
+
+         while Buflen < 26 loop
+            AddC (' ');
+         end loop;
+
+         AddC (' ');
+         AddC (' ');
+
+         --  Output value and write line
+
+         AddN (To_ANat (DTV (J)).all);
+         Write_Line;
+      end loop;
+
+      --  Blank line to separate sections
+
+      Write_Line;
+
+      --  Write lines for registered FPT types
+
+      for J in 1 .. Num_FPT_Modes loop
+         declare
+            E : FPT_Mode_Entry renames FPT_Mode_Table (J);
+         begin
+            Buflen := E.NAME'Last;
+            Buffer (1 .. Buflen) := E.NAME.all;
+
+            --  Pad out to line up values
+
+            while Buflen < 11 loop
+               AddC (' ');
+            end loop;
+
+            AddC (' ');
+            AddC (' ');
+
+            AddN (E.DIGS);
+            AddC (' ');
+            AddC (' ');
+
+            case E.FLOAT_REP is
+               when IEEE_Binary =>
+                  AddC ('I');
+               when VAX_Native  =>
+                  AddC ('V');
+               when AAMP        =>
+                  AddC ('A');
+            end case;
+
+            AddC (' ');
+
+            AddN (E.SIZE);
+            AddC (' ');
+
+            AddN (E.ALIGNMENT);
+            Write_Line;
+         end;
+      end loop;
+
+      --  Close file
+
+      Close (Fdesc, OK);
+
+      if not OK then
+         Fail ("disk full writing target.atp");
+      end if;
+   end Write_Target_Dependent_Values;
+
+--  Package Initialization, set target dependent values. This must be done
+--  early on, before we start accessing various compiler packages, since
+--  these values are used all over the place.
+
+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
+   --  is present in the options string.
+
+   declare
+      type Arg_Array is array (Nat) of Big_String_Ptr;
+      type Arg_Array_Ptr is access Arg_Array;
+      --  Types to access compiler arguments
+
+      save_argc : Nat;
+      pragma Import (C, save_argc);
+      --  Saved value of argc (number of arguments), imported from misc.c
+
+      save_argv : Arg_Array_Ptr;
+      pragma Import (C, save_argv);
+      --  Saved value of argv (argument pointers), imported from misc.c
+
+   begin
+      --  Loop through arguments looking for -gnateT, also look for -gnatd.b
+
+      for Arg in 1 .. save_argc - 1 loop
+         declare
+            Argv_Ptr : constant Big_String_Ptr := save_argv (Arg);
+         begin
+            if Argv_Ptr (1 .. 7) = "-gnateT" then
+               Opt.Target_Dependent_Info_Read := True;
+            elsif Argv_Ptr (1 .. 8) = "-gnatd.b" then
+               Debug_Flag_Dot_B := True;
+            end if;
+         end;
+      end loop;
+   end;
+
+   --  If the switch is not set, we get all values from the back end
+
+   if not Opt.Target_Dependent_Info_Read then
+
+      --  Set values set by direct calls to the back end
+
+      Bits_BE                    := Get_Bits_BE;
+      Bits_Per_Unit              := Get_Bits_Per_Unit;
+      Bits_Per_Word              := Get_Bits_Per_Word;
+      Bytes_BE                   := Get_Bytes_BE;
+      Char_Size                  := Get_Char_Size;
+      Double_Float_Alignment     := Get_Double_Float_Alignment;
+      Double_Scalar_Alignment    := Get_Double_Scalar_Alignment;
+      Double_Size                := Get_Double_Size;
+      Float_Size                 := Get_Float_Size;
+      Float_Words_BE             := Get_Float_Words_BE;
+      Int_Size                   := Get_Int_Size;
+      Long_Double_Size           := Get_Long_Double_Size;
+      Long_Long_Size             := Get_Long_Long_Size;
+      Long_Size                  := Get_Long_Size;
+      Maximum_Alignment          := Get_Maximum_Alignment;
+      Max_Unaligned_Field        := Get_Max_Unaligned_Field;
+      Pointer_Size               := Get_Pointer_Size;
+      Short_Size                 := Get_Short_Size;
+      Strict_Alignment           := Get_Strict_Alignment;
+      System_Allocator_Alignment := Get_System_Allocator_Alignment;
+      Wchar_T_Size               := Get_Wchar_T_Size;
+      Words_BE                   := Get_Words_BE;
+
+      --  Register floating-point types from the back end (depending on the
+      --  back end in use, we have to do different things to get this info).
+
+      case Get_Back_End is
+
+         --  GCC back end, get information using Enumerate_Modes
+
+         when GCC =>
+            declare
+               type Register_Type_Proc is access procedure
+                 (C_Name    : C_String;
+                  Digs      : Natural;
+                  Complex   : Boolean;
+                  Count     : Natural;
+                  Float_Rep : Float_Rep_Kind;
+                  Size      : Positive;
+                  Alignment : Natural);
+               pragma Convention (C, Register_Type_Proc);
+               --  Call back procedure for Register_Back_End_Types
+
+               procedure Enumerate_Modes (Call_Back : Register_Type_Proc);
+               pragma Import (C, Enumerate_Modes, "enumerate_modes");
+               --  Back end procedure that does the call backs (see misc.c)
+
+            begin
+               Num_FPT_Modes := 0;
+               Enumerate_Modes (Register_Float_Type'Access);
+            end;
+
+         --  AAMP back end, supply the two needed types directly
+
+         when AAMP =>
+            declare
+               Str : C_String;
+
+            begin
+               Str (1 .. 6) := "float" & ASCII.NUL;
+               Register_Float_Type
+                 (Name      => Str,
+                  Digs      => 6,
+                  Complex   => False,
+                  Count     => 0,
+                  Float_Rep => AAMP,
+                  Size      => 32,
+                  Alignment => 16);
+
+               Str (1 .. 7) := "double" & ASCII.NUL;
+               Register_Float_Type
+                 (Name      => Str,
+                  Digs      => 9,
+                  Complex   => False,
+                  Count     => 0,
+                  Float_Rep => AAMP,
+                  Size      => 48,
+                  Alignment => 16);
+            end;
+
+            --  DotNet TBD
+
+         when DOTNET =>
+            null;
+      end case;
+
+      --  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.
+
+   else
+      Read_File : declare
+         File_Desc : File_Descriptor;
+         N         : Natural;
+
+         type ANat is access all Natural;
+         --  Pointer to Nat or Pos value (it is harmless to treat Pos values
+         --  as Nat via Unchecked_Conversion).
+
+         function To_ANat is new Unchecked_Conversion (Address, ANat);
+
+         VP : ANat;
+
+         Buffer : String (1 .. 2000);
+         Buflen : Natural;
+         --  File information and length (2000 easily enough!)
+
+         Nam_Buf : String (1 .. 40);
+         Nam_Len : Natural;
+
+         procedure Check_Spaces;
+         --  Checks that we have one or more spaces and skips them
+
+         procedure FailN (S : String);
+         --  Calls Fail prefixing "target.atp: " to the start of the given
+         --  string, and " name" to the end where name is the currently
+         --  gathered name in Nam_Buf, surrounded by quotes.
+
+         procedure Get_Name;
+         --  Scan out name, leaving it in Nam_Buf with Nam_Len set. Calls
+         --  Skip_Spaces to skip any following spaces. Note that the name is
+         --  terminated by a sequence of at least two spaces.
+
+         function Get_Nat return Natural;
+         --  N on entry points to decimal integer, scan out decimal integer
+         --  and return it, leaving N pointing to following space or LF.
+
+         procedure Skip_Spaces;
+         --  Skip past spaces
+
+         ------------------
+         -- Check_Spaces --
+         ------------------
+
+         procedure Check_Spaces is
+         begin
+            if N > Buflen or else Buffer (N) /= ' ' then
+               FailN ("missing space for");
+            end if;
+
+            Skip_Spaces;
+            return;
+         end Check_Spaces;
+
+         -----------
+         -- FailN --
+         -----------
+
+         procedure FailN (S : String) is
+         begin
+            Fail ("target.atp: " & S & " """ & Nam_Buf (1 .. Nam_Len) & '"');
+         end FailN;
+
+         --------------
+         -- Get_Name --
+         --------------
+
+         procedure Get_Name is
+         begin
+            Nam_Len := 0;
+
+            --  Scan out name and put it in Nam_Buf
+
+            loop
+               if N > Buflen or else Buffer (N) = ASCII.LF then
+                  FailN ("incorrectly formatted line for");
+               end if;
+
+               --  Name is terminated by two blanks
+
+               exit when N < Buflen and then Buffer (N .. N + 1) = "  ";
+
+               Nam_Len := Nam_Len + 1;
+
+               if Nam_Len > Nam_Buf'Last then
+                  Fail ("name too long");
+               end if;
+
+               Nam_Buf (Nam_Len) := Buffer (N);
+               N := N + 1;
+            end loop;
+
+            Check_Spaces;
+         end Get_Name;
+
+         -------------
+         -- Get_Nat --
+         -------------
+
+         function Get_Nat return Natural is
+            Result : Natural := 0;
+
+         begin
+            loop
+               if N > Buflen
+                 or else Buffer (N) not in '0' .. '9'
+                 or else Result > 999
+               then
+                  FailN ("bad value for");
+               end if;
+
+               Result := Result * 10 + (Character'Pos (Buffer (N)) - 48);
+               N := N + 1;
+
+               exit when N <= Buflen
+                 and then (Buffer (N) = ASCII.LF or else Buffer (N) = ' ');
+            end loop;
+
+            return Result;
+         end Get_Nat;
+
+         -----------------
+         -- Skip_Spaces --
+         -----------------
+
+         procedure Skip_Spaces is
+         begin
+            while N <= Buflen and Buffer (N) = ' ' loop
+               N := N + 1;
+            end loop;
+         end Skip_Spaces;
+
+      --  Start of processing for Read_File
+
+      begin
+         File_Desc := Open_Read ("target.atp", Text);
+
+         if File_Desc = Invalid_FD then
+            Fail ("cannot read target.atp file");
+         end if;
+
+         Buflen := Read (File_Desc, Buffer'Address, Buffer'Length);
+
+         if Buflen = Buffer'Length then
+            Fail ("target.atp file is too long");
+         end if;
+
+         --  Scan through file for properly formatted entries in first section
+
+         N := 1;
+         while N <= Buflen and then Buffer (N) /= ASCII.LF loop
+            Get_Name;
+
+            --  Validate name and get corresponding value pointer
+
+            VP := null;
+
+            for J in DTN'Range loop
+               if DTN (J).all = Nam_Buf (1 .. Nam_Len) then
+                  VP := To_ANat (DTV (J));
+                  DTR (J) := True;
+                  exit;
+               end if;
+            end loop;
+
+            if VP = null then
+               FailN ("unrecognized name");
+            end if;
+
+            --  Scan out value
+
+            VP.all := Get_Nat;
+
+            if N > Buflen or else Buffer (N) /= ASCII.LF then
+               FailN ("misformatted line for");
+            end if;
+
+            N := N + 1; -- skip LF
+         end loop;
+
+         --  Fall through this loop when all lines in first section read.
+         --  Check that values have been supplied for all entries.
+
+         for J in DTR'Range loop
+            if not DTR (J) then
+               Fail ("missing entry in target.atp for " & DTN (J).all);
+            end if;
+         end loop;
+
+         --  Now acquire FPT entries
+
+         if N >= Buflen then
+            Fail ("target.atp is missing entries for FPT modes");
+         end if;
+
+         if Buffer (N) = ASCII.LF then
+            N := N + 1;
+         else
+            Fail ("target.atp is missing blank line");
+         end if;
+
+         Num_FPT_Modes := 0;
+         while N <= Buflen loop
+            Get_Name;
+
+            Num_FPT_Modes := Num_FPT_Modes + 1;
+
+            declare
+               E : FPT_Mode_Entry renames FPT_Mode_Table (Num_FPT_Modes);
+
+            begin
+               E.NAME := new String'(Nam_Buf (1 .. Nam_Len));
+
+               E.DIGS := Get_Nat;
+               Check_Spaces;
+
+               case Buffer (N) is
+                  when 'I'    =>
+                     E.FLOAT_REP := IEEE_Binary;
+                  when 'V'    =>
+                     E.FLOAT_REP := VAX_Native;
+                  when 'A'    =>
+                     E.FLOAT_REP := AAMP;
+                  when others =>
+                     FailN ("bad float rep field for");
+               end case;
+
+               N := N + 1;
+               Check_Spaces;
+
+               E.SIZE := Get_Nat;
+               Check_Spaces;
+
+               E.ALIGNMENT := Get_Nat;
+
+               if Buffer (N) /= ASCII.LF then
+                  FailN ("junk at end of line for");
+               end if;
+
+               N := N + 1;
+            end;
+         end loop;
+      end Read_File;
+   end if;
+end Set_Targ;
diff --git a/gcc/ada/set_targ.ads b/gcc/ada/set_targ.ads
new file mode 100755
index 0000000..5b5820c
--- /dev/null
+++ b/gcc/ada/set_targ.ads
@@ -0,0 +1,144 @@
+------------------------------------------------------------------------------
+--                                                                          --
+--                         GNAT COMPILER COMPONENTS                         --
+--                                                                          --
+--                             S E T _ T A R G                              --
+--                                                                          --
+--                                 S p e c                                  --
+--                                                                          --
+--            Copyright (C) 2013, Free Software Foundation, Inc.            --
+--                                                                          --
+-- GNAT is free software;  you can  redistribute it  and/or modify it under --
+-- terms of the  GNU General Public License as published  by the Free Soft- --
+-- ware  Foundation;  either version 3,  or (at your option) any later ver- --
+-- sion.  GNAT is distributed in the hope that it will be useful, but WITH- --
+-- OUT ANY WARRANTY;  without even the  implied warranty of MERCHANTABILITY --
+-- or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU General Public License --
+-- for  more details.  You should have  received  a copy of the GNU General --
+-- Public License  distributed with GNAT; see file COPYING3.  If not, go to --
+-- http://www.gnu.org/licenses for a complete copy of the license.          --
+--                                                                          --
+-- GNAT was originally developed  by the GNAT team at  New York University. --
+-- Extensive contributions were provided by Ada Core Technologies Inc.      --
+--                                                                          --
+------------------------------------------------------------------------------
+
+--  This package handles setting target dependent parameters. If the -gnatet
+--  switch is not set, then these values are taken from the back end (via the
+--  routines in Get_Targ, and the enumerate_modes routine in misc.c). If the
+--  switch is set, then the values are read from the target.atp file in the
+--  current directory (usually written with the Write_Target_Dependent_Values
+--  procedure defined in this package).
+
+--  Note that all these values return sizes of C types with corresponding
+--  names. This allows GNAT to define the corresponding Ada types to have
+--  the same representation. There is one exception: the representation
+--  of Wide_Character_Type uses twice the size of a C char, instead of the
+--  size of wchar_t, since this corresponds to expected Ada usage.
+
+with Einfo; use Einfo;
+with Types; use Types;
+
+package Set_Targ is
+
+   -----------------------------
+   -- Target-Dependent Values --
+   -----------------------------
+
+   --  The following is a table of target dependent values. In normal operation
+   --  these values are set by calling the appropriate C backend routines that
+   --  interface to back end routines that determine target characteristics.
+
+   --  If the -gnateT switch is used, then any values that are read from the
+   --  file target.atp in the current directory overwrite values set from the
+   --  back end. This is used by tools other than the compiler, e.g. to do
+   --  semantic analysis of programs that will run on some other target than
+   --  the machine on which the tool is run.
+
+   --  Note: fields marked with a question mark are boolean fields, where a
+   --  value of 0 is False, and a value of 1 is True.
+
+   Bits_BE                    : Nat; -- Bits stored big-endian?
+   Bits_Per_Unit              : Pos; -- Bits in a storage unit
+   Bits_Per_Word              : Pos; -- Bits in a word
+   Bytes_BE                   : Nat; -- Bytes stored big-endian?
+   Char_Size                  : Pos; -- Standard.Character'Size
+   Double_Float_Alignment     : Nat; -- Alignment of double float
+   Double_Scalar_Alignment    : Nat; -- Alignment of double length scalar
+   Double_Size                : Pos; -- Standard.Long_Float'Size
+   Float_Size                 : Pos; -- Standard.Float'Size
+   Float_Words_BE             : Nat; -- Float words stored big-endian?
+   Int_Size                   : Pos; -- Standard.Integer'Size
+   Long_Double_Size           : Pos; -- Standard.Long_Long_Float'Size
+   Long_Long_Size             : Pos; -- Standard.Long_Long_Integer'Size
+   Long_Size                  : Pos; -- Standard.Long_Integer'Size
+   Maximum_Alignment          : Pos; -- Maximum permitted alignment
+   Max_Unaligned_Field        : Pos; -- Maximum size for unaligned bit field
+   Pointer_Size               : Pos; -- System.Address'Size
+   Short_Size                 : Pos; -- Standard.Short_Integer'Size
+   Strict_Alignment           : Nat; -- Strict alignment?
+   System_Allocator_Alignment : Nat; -- Alignment for malloc calls
+   Wchar_T_Size               : Pos; -- Interfaces.C.wchar_t'Size
+   Words_BE                   : Nat; -- Words stored big-endian?
+
+   -------------------------------------
+   -- Registered Floating-Point Types --
+   -------------------------------------
+
+   --  This table contains the list of modes supported by the back-end as
+   --  provided by the back end routine enumerate_modes in misc.c. Note that
+   --  we only store floating-point modes (see Register_Float_Type).
+
+   type FPT_Mode_Entry is record
+      NAME      : String_Ptr;     -- Name of mode (no null character at end)
+      DIGS      : Natural;        -- Digits for floating-point type
+      FLOAT_REP : Float_Rep_Kind; -- Float representation
+      SIZE      : Natural;        -- Size in bits
+      ALIGNMENT : Natural;        -- Alignment in bits
+   end record;
+
+   FPT_Mode_Table : array (1 .. 1000) of FPT_Mode_Entry;
+   Num_FPT_Modes  : Natural;
+   --  Table containing the supported modes and number of entries
+
+   -----------------
+   -- Subprograms --
+   -----------------
+
+   procedure Write_Target_Dependent_Values;
+   --  This routine writes the file target.atp in the current directory with
+   --  the values of the global target parameters as listed above, and as set
+   --  by prior calls to Initialize/Read_Target_Dependent_Values. The format
+   --  of the target.atp file is as follows
+   --
+   --    First come the values of the variables defined in this spec:
+   --
+   --      One line per value
+   --
+   --        name  value
+   --
+   --      where name is the name of the parameter, spelled out in full,
+   --      and cased as in the above list, and value is an unsigned decimal
+   --      integer. Two or more blanks separates the name from the value.
+   --
+   --      All the variables must be present, in alphabetical order (i.e. the
+   --      same order as the declarations in this spec).
+   --
+   --   Then there is a blank line to separate the two parts of the file. Then
+   --   come the lines showing the floating-point types to be registered.
+   --
+   --     One line per registered mode
+   --
+   --       name  digs float_rep size alignment
+   --
+   --     where name is the string name of the type (which can have single
+   --     spaces embedded in the name (e.g. long double). The name is followed
+   --     by at least two blanks. The following fields are as described above
+   --     for a Mode_Entry (where float_rep is I/V/A for IEEE-754-Binary,
+   --     Vax_Native, AAMP), fields are separated by at least one blank, and
+   --     a LF character immediately follows the alignment field.
+   --
+   --    It is a fatal error to call this procedure if the target.atp file is
+   --    not found in the current directory.
+
+end Set_Targ;
diff --git a/gcc/ada/xgnatugn.adb b/gcc/ada/xgnatugn.adb
index 6ade074..4706701 100644
--- a/gcc/ada/xgnatugn.adb
+++ b/gcc/ada/xgnatugn.adb
@@ -85,12 +85,6 @@
 --       output. A line containing this escape sequence may not also contain
 --       a ^alpha^beta^ sequence.
 
---       Process @ifset and @ifclear for the target flags (unw, vms);
---       this is because we have menu problems if we let makeinfo handle
---       these ifset/ifclear pairs.
---       Note: @ifset/@ifclear commands for the edition flags (FSFEDITION,
---       PROEDITION, GPLEDITION) are passed through unchanged
-
 with Ada.Command_Line;           use Ada.Command_Line;
 with Ada.Strings;                use Ada.Strings;
 with Ada.Strings.Fixed;          use Ada.Strings.Fixed;