* adabkend.ads, adabkend.adb, aa_util.ads, aa_util.adb: New.

From-SVN: r192913

5 files changed, 939 insertions, 1 deletions

diff --git a/gcc/ada/ChangeLog b/gcc/ada/ChangeLog
index 9058c98..2fb2753 100644
--- a/gcc/ada/ChangeLog
+++ b/gcc/ada/ChangeLog
@@ -1,6 +1,7 @@
 2012-10-29  Arnaud Charlet  <charlet@adacore.com>
 
-	* pprint.ads, pprint.adb: New.
+	* pprint.ads, pprint.adb, adabkend.ads, adabkend.adb,
+	aa_util.ads, aa_util.adb: New.
 
 2012-10-23  Eric Botcazou  <ebotcazou@adacore.com>
 
diff --git a/gcc/ada/aa_util.adb b/gcc/ada/aa_util.adb
new file mode 100644
index 0000000..6ea4421
--- /dev/null
+++ b/gcc/ada/aa_util.adb
@@ -0,0 +1,458 @@
+------------------------------------------------------------------------------
+--                                                                          --
+--                        GNAAMP COMPILER COMPONENTS                        --
+--                                                                          --
+--                              A A _ U T I L                               --
+--                                                                          --
+--                                 B o d y                                  --
+--                                                                          --
+--                     Copyright (C) 2001-2012, AdaCore                     --
+--                                                                          --
+-- 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.          --
+--                                                                          --
+------------------------------------------------------------------------------
+
+with Sem_Aux; use Sem_Aux;
+with Sinput;  use Sinput;
+with Stand;   use Stand;
+with Stringt; use Stringt;
+
+with GNAT.Case_Util;  use GNAT.Case_Util;
+
+package body AA_Util is
+
+   ----------------------
+   -- Is_Global_Entity --
+   ----------------------
+
+   function Is_Global_Entity (E : Entity_Id) return Boolean is
+   begin
+      return Enclosing_Dynamic_Scope (E) = Standard_Standard;
+   end Is_Global_Entity;
+
+   -----------------
+   -- New_Name_Id --
+   -----------------
+
+   function New_Name_Id (Name : String) return Name_Id is
+   begin
+      for J in 1 .. Name'Length loop
+         Name_Buffer (J) := Name (Name'First + (J - 1));
+      end loop;
+
+      Name_Len := Name'Length;
+      return Name_Find;
+   end New_Name_Id;
+
+   -----------------
+   -- Name_String --
+   -----------------
+
+   function Name_String (Name : Name_Id) return String is
+   begin
+      pragma Assert (Name /= No_Name);
+      return Get_Name_String (Name);
+   end Name_String;
+
+   -------------------
+   -- New_String_Id --
+   -------------------
+
+   function New_String_Id (S : String) return String_Id is
+   begin
+      for J in 1 .. S'Length loop
+         Name_Buffer (J) := S (S'First + (J - 1));
+      end loop;
+
+      Name_Len := S'Length;
+      return String_From_Name_Buffer;
+   end New_String_Id;
+
+   ------------------
+   -- String_Value --
+   ------------------
+
+   function String_Value (Str_Id : String_Id) return String is
+   begin
+      --  ??? pragma Assert (Str_Id /= No_String);
+
+      if Str_Id = No_String then
+         return "";
+      end if;
+
+      String_To_Name_Buffer (Str_Id);
+
+      return Name_Buffer (1 .. Name_Len);
+   end String_Value;
+
+   ---------------
+   -- Next_Name --
+   ---------------
+
+   function Next_Name
+     (Name_Seq    : not null access Name_Sequencer;
+      Name_Prefix : String) return Name_Id
+   is
+   begin
+      Name_Seq.Sequence_Number := Name_Seq.Sequence_Number + 1;
+
+      declare
+         Number_Image : constant String := Name_Seq.Sequence_Number'Img;
+      begin
+         return New_Name_Id
+                  (Name_Prefix & "__" & Number_Image (2 .. Number_Image'Last));
+      end;
+   end Next_Name;
+
+   --------------------
+   -- Elab_Spec_Name --
+   --------------------
+
+   function Elab_Spec_Name (Module_Name : Name_Id) return Name_Id is
+   begin
+      return New_Name_Id (Name_String (Module_Name) & "___elabs");
+   end Elab_Spec_Name;
+
+   --------------------
+   -- Elab_Spec_Name --
+   --------------------
+
+   function Elab_Body_Name (Module_Name : Name_Id) return Name_Id is
+   begin
+      return New_Name_Id (Name_String (Module_Name) & "___elabb");
+   end Elab_Body_Name;
+
+   --------------------------------
+   -- Source_Name_Without_Suffix --
+   --------------------------------
+
+   function File_Name_Without_Suffix (File_Name : String) return String is
+      Name_Index : Natural := File_Name'Last;
+
+   begin
+      pragma Assert (File_Name'Length > 0);
+
+      --  We loop in reverse to ensure that file names that follow nonstandard
+      --  naming conventions that include additional dots are handled properly,
+      --  preserving dots in front of the main file suffix (for example,
+      --  main.2.ada => main.2).
+
+      while Name_Index >= File_Name'First
+        and then File_Name (Name_Index) /= '.'
+      loop
+         Name_Index := Name_Index - 1;
+      end loop;
+
+      --  Return the part of the file name up to but not including the last dot
+      --  in the name, or return the whole name as is if no dot character was
+      --  found.
+
+      if Name_Index >= File_Name'First then
+         return File_Name (File_Name'First .. Name_Index - 1);
+
+      else
+         return File_Name;
+      end if;
+   end File_Name_Without_Suffix;
+
+   -----------------
+   -- Source_Name --
+   -----------------
+
+   function Source_Name (Sloc : Source_Ptr) return File_Name_Type is
+   begin
+      if Sloc = No_Location or Sloc = Standard_Location then
+         return No_File;
+      else
+         return File_Name (Get_Source_File_Index (Sloc));
+      end if;
+   end Source_Name;
+
+   --------------------------------
+   -- Source_Name_Without_Suffix --
+   --------------------------------
+
+   function Source_Name_Without_Suffix (Sloc : Source_Ptr) return String is
+      Src_Name  : constant String :=
+        Name_String (Name_Id (Source_Name (Sloc)));
+      Src_Index : Natural         := Src_Name'Last;
+
+   begin
+      pragma Assert (Src_Name'Length > 0);
+
+      --  Treat the presence of a ".dg" suffix specially, stripping it off
+      --  in addition to any suffix preceding it.
+
+      if Src_Name'Length >= 4
+        and then Src_Name (Src_Name'Last - 2 .. Src_Name'Last) = ".dg"
+      then
+         Src_Index := Src_Index - 3;
+      end if;
+
+      return File_Name_Without_Suffix (Src_Name (Src_Name'First .. Src_Index));
+   end Source_Name_Without_Suffix;
+
+   ----------------------
+   -- Source_Id_String --
+   ----------------------
+
+   function Source_Id_String (Unit_Name : Name_Id) return String is
+      Unit_String : String   := Name_String (Unit_Name);
+      Name_Last   : Positive := Unit_String'Last;
+      Name_Index  : Positive := Unit_String'First;
+
+   begin
+      To_Mixed (Unit_String);
+
+      --  Replace any embedded sequences of two or more '_' characters
+      --  with a single '.' character. Note that this will leave any
+      --  leading or trailing single '_' characters untouched, but those
+      --  should normally not occur in compilation unit names (and if
+      --  they do then it's better to leave them as is).
+
+      while Name_Index <= Name_Last loop
+         if Unit_String (Name_Index) = '_'
+           and then Name_Index /= Name_Last
+           and then Unit_String (Name_Index + 1) = '_'
+         then
+            Unit_String (Name_Index) := '.';
+            Name_Index := Name_Index + 1;
+
+            while Unit_String (Name_Index) = '_'
+              and then Name_Index <= Name_Last
+            loop
+               Unit_String (Name_Index .. Name_Last - 1)
+                 := Unit_String (Name_Index + 1 .. Name_Last);
+               Name_Last := Name_Last - 1;
+            end loop;
+
+         else
+            Name_Index := Name_Index + 1;
+         end if;
+      end loop;
+
+      return Unit_String (Unit_String'First .. Name_Last);
+   end Source_Id_String;
+
+   --  This version of Source_Id_String is obsolescent and is being
+   --  replaced with the above function.
+
+   function Source_Id_String (Sloc : Source_Ptr) return String is
+      File_Index : Source_File_Index;
+
+   begin
+      --  Use an arbitrary artificial 22-character value for package Standard,
+      --  since Standard doesn't have an associated source file.
+
+      if Sloc <= Standard_Location then
+         return "20010101010101standard";
+
+      --  Return the concatentation of the source file's timestamp and
+      --  its 8-digit hex checksum.
+
+      else
+         File_Index := Get_Source_File_Index (Sloc);
+
+         return String (Time_Stamp (File_Index))
+                  & Get_Hex_String (Source_Checksum (File_Index));
+      end if;
+   end Source_Id_String;
+
+   ---------------
+   -- Source_Id --
+   ---------------
+
+   function Source_Id (Unit_Name : Name_Id) return String_Id is
+   begin
+      return New_String_Id (Source_Id_String (Unit_Name));
+   end Source_Id;
+
+   --  This version of Source_Id is obsolescent and is being
+   --  replaced with the above function.
+
+   function Source_Id (Sloc : Source_Ptr) return String_Id is
+   begin
+      return New_String_Id (Source_Id_String (Sloc));
+   end Source_Id;
+
+   -----------
+   -- Image --
+   -----------
+
+   function Image (I : Int) return String is
+      Image_String : constant String := Pos'Image (I);
+   begin
+      if Image_String (1) = ' ' then
+         return Image_String (2 .. Image_String'Last);
+      else
+         return Image_String;
+      end if;
+   end Image;
+
+   --------------
+   -- UI_Image --
+   --------------
+
+   function UI_Image (I : Uint; Format : Integer_Image_Format) return String is
+   begin
+      if Format = Decimal then
+         UI_Image (I, Format => Decimal);
+         return UI_Image_Buffer (1 .. UI_Image_Length);
+
+      elsif Format = Ada_Hex then
+         UI_Image (I, Format => Hex);
+         return UI_Image_Buffer (1 .. UI_Image_Length);
+
+      else
+         pragma Assert (I >= Uint_0);
+
+         UI_Image (I, Format => Hex);
+
+         pragma Assert (UI_Image_Buffer (1 .. 3) = "16#"
+                         and then UI_Image_Buffer (UI_Image_Length) = '#');
+
+         --  Declare a string where we will copy the digits from the UI_Image,
+         --  interspersing '_' characters as 4-digit group separators. The
+         --  underscores in UI_Image's result are not always at the places
+         --  where we want them, which is why we do the following copy
+         --  (e.g., we map "16#ABCD_EF#" to "^AB_CDEF^").
+
+         declare
+            Hex_String     : String (1 .. UI_Image_Max);
+            Last_Index     : Natural;
+            Digit_Count    : Natural := 0;
+            UI_Image_Index : Natural := 4; -- Skip past the "16#" bracket
+            Sep_Count      : Natural := 0;
+
+         begin
+            --  Count up the number of non-underscore characters in the
+            --  literal value portion of the UI_Image string.
+
+            while UI_Image_Buffer (UI_Image_Index) /= '#' loop
+               if UI_Image_Buffer (UI_Image_Index) /= '_' then
+                  Digit_Count := Digit_Count + 1;
+               end if;
+
+               UI_Image_Index := UI_Image_Index + 1;
+            end loop;
+
+            UI_Image_Index := 4; -- Reset the index past the "16#" bracket
+
+            Last_Index := 1;
+
+            Hex_String (Last_Index) := '^';
+            Last_Index := Last_Index + 1;
+
+            --  Copy digits from UI_Image_Buffer to Hex_String, adding
+            --  underscore separators as appropriate. The initial value
+            --  of Sep_Count accounts for the leading '^' and being one
+            --  character ahead after inserting a digit.
+
+            Sep_Count := 2;
+
+            while UI_Image_Buffer (UI_Image_Index) /= '#' loop
+               if UI_Image_Buffer (UI_Image_Index) /= '_' then
+                  Hex_String (Last_Index) := UI_Image_Buffer (UI_Image_Index);
+
+                  Last_Index := Last_Index + 1;
+
+                  --  Add '_' characters to separate groups of four hex
+                  --  digits for readability (grouping from right to left).
+
+                  if (Digit_Count - (Last_Index - Sep_Count)) mod 4 = 0 then
+                     Hex_String (Last_Index) := '_';
+                     Last_Index := Last_Index + 1;
+                     Sep_Count := Sep_Count + 1;
+                  end if;
+               end if;
+
+               UI_Image_Index := UI_Image_Index + 1;
+            end loop;
+
+            --  Back up before any trailing underscore
+
+            if Hex_String (Last_Index - 1) = '_' then
+               Last_Index := Last_Index - 1;
+            end if;
+
+            Hex_String (Last_Index) := '^';
+
+            return Hex_String (1 .. Last_Index);
+         end;
+      end if;
+   end UI_Image;
+
+   --------------
+   -- UR_Image --
+   --------------
+
+   --  Shouldn't this be added to Urealp???
+
+   function UR_Image (R : Ureal) return String is
+
+      --  The algorithm used here for conversion of Ureal values
+      --  is taken from the JGNAT back end.
+
+      Num    : Long_Long_Float := 0.0;
+      Den    : Long_Long_Float := 0.0;
+      Sign   : Long_Long_Float := 1.0;
+      Result : Long_Long_Float;
+      Tmp    : Uint;
+      Index  : Integer;
+
+   begin
+      if UR_Is_Negative (R) then
+         Sign := -1.0;
+      end if;
+
+      --  In the following calculus, we consider numbers modulo 2 ** 31,
+      --  so that we don't have problems with signed Int...
+
+      Tmp := abs (Numerator (R));
+      Index := 0;
+      while Tmp > 0 loop
+         Num := Num
+           + Long_Long_Float (UI_To_Int (Tmp mod (Uint_2 ** 31)))
+           * (2.0 ** Index);
+         Tmp := Tmp / Uint_2 ** 31;
+         Index := Index + 31;
+      end loop;
+
+      Tmp := abs (Denominator (R));
+      if Rbase (R) /= 0 then
+         Tmp := Rbase (R) ** Tmp;
+      end if;
+
+      Index := 0;
+      while Tmp > 0 loop
+         Den := Den
+           + Long_Long_Float (UI_To_Int (Tmp mod (Uint_2 ** 31)))
+           * (2.0 ** Index);
+         Tmp := Tmp / Uint_2 ** 31;
+         Index := Index + 31;
+      end loop;
+
+      --  If the denominator denotes a negative power of Rbase,
+      --  then multiply by the denominator.
+
+      if Rbase (R) /= 0 and then Denominator (R) < 0 then
+         Result := Sign * Num * Den;
+
+      --  Otherwise compute the quotient
+
+      else
+         Result := Sign * Num / Den;
+      end if;
+
+      return Long_Long_Float'Image (Result);
+   end UR_Image;
+
+end AA_Util;
diff --git a/gcc/ada/aa_util.ads b/gcc/ada/aa_util.ads
new file mode 100644
index 0000000..27b6183
--- /dev/null
+++ b/gcc/ada/aa_util.ads
@@ -0,0 +1,145 @@
+------------------------------------------------------------------------------
+--                                                                          --
+--                        GNAAMP COMPILER COMPONENTS                        --
+--                                                                          --
+--                              A A _ U T I L                               --
+--                                                                          --
+--                                 S p e c                                  --
+--                                                                          --
+--                     Copyright (C) 2001-2011, AdaCore                     --
+--                                                                          --
+-- 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.          --
+--                                                                          --
+------------------------------------------------------------------------------
+
+--  This package provides various utility operations used by GNAT back-ends
+--  (e.g. AAMP).
+
+--  This package is a messy grab bag of stuff. These routines should be moved
+--  to appropriate units (sem_util,sem_aux,exp_util,namet,uintp,urealp). ???
+
+with Namet;  use Namet;
+with Types;  use Types;
+with Uintp;  use Uintp;
+with Urealp; use Urealp;
+
+package AA_Util is
+
+   function Is_Global_Entity (E : Entity_Id) return Boolean;
+   --  Returns true if and only if E is a library-level entity (excludes
+   --  entities declared within blocks at the outer level of library packages).
+
+   function New_Name_Id (Name : String) return Name_Id;
+   --  Returns a Name_Id corresponding to the given name string
+
+   function Name_String (Name : Name_Id) return String;
+   --  Returns the name string associated with Name
+
+   function New_String_Id (S : String) return String_Id;
+   --  Returns a String_Id corresponding to the given string
+
+   function String_Value (Str_Id : String_Id) return String;
+   --  Returns the string associated with Str_Id
+
+   --  Name-generation utilities
+
+   type Name_Sequencer is private;
+   --  This type is used to support back-end generation of unique symbol
+   --  (e.g., for string literal objects or labels). By declaring an
+   --  aliased object of type Name_Sequence and passing that object
+   --  to the function Next_Name, a series of names with suffixes
+   --  of the form "__n" will be produced, where n is a string denoting
+   --  a positive integer.  The sequence starts with "__1", and increases
+   --  by one on each successive call to Next_Name for a given Name_Sequencer.
+
+   function Next_Name
+     (Name_Seq    : not null access Name_Sequencer;
+      Name_Prefix : String) return Name_Id;
+   --  Returns the Name_Id for a name composed of the given Name_Prefix
+   --  concatentated with a unique number suffix of the form "__n",
+   --  as detemined by the current state of Name_Seq.
+
+   function Elab_Spec_Name (Module_Name : Name_Id) return Name_Id;
+   --  Returns a name id for the elaboration subprogram to be associated with
+   --  the specification of the named module. The denoted name is of the form
+   --  "modulename___elabs".
+
+   function Elab_Body_Name (Module_Name : Name_Id) return Name_Id;
+   --  Returns a name id for the elaboration subprogram to be associated
+   --  with the body of the named module. The denoted name is of the form
+   --  "modulename___elabb".
+
+   function File_Name_Without_Suffix (File_Name : String) return String;
+   --  Removes the suffix ('.' followed by other characters), if present, from
+   --  the end of File_Name and returns the shortened name (otherwise simply
+   --  returns File_Name).
+
+   function Source_Name (Sloc : Source_Ptr) return File_Name_Type;
+   --  Returns file name corresponding to the source file name associated with
+   --  the given source position Sloc.
+
+   function Source_Name_Without_Suffix (Sloc : Source_Ptr) return String;
+   --  Returns a string corresponding to the source file name associated with
+   --  the given source position Sloc, with its dot-preceded suffix, if any,
+   --  removed. As examples, the name "main.adb" is mapped to "main" and the
+   --  name "main.2.ada" is mapped to "main.2". As a special case, file names
+   --  with a ".dg" suffix will also strip off the ".dg", so "main.adb.dg"
+   --  becomes simply "main".
+
+   function Source_Id_String (Unit_Name : Name_Id) return String;
+   --  Returns a string that uniquely identifies the unit with the given
+   --  Unit_Name. This string is derived from Unit_Name by replacing any
+   --  multiple underscores with dot ('.') characters and normalizing the
+   --  casing to mixed case (e.g., "ada__strings" is mapped to ("Ada.Strings").
+
+   function Source_Id (Unit_Name : Name_Id) return String_Id;
+   --  Returns a String_Id reference to a string that uniquely identifies
+   --  the program unit having the given name (as defined for function
+   --  Source_Id_String).
+
+   function Source_Id_String (Sloc : Source_Ptr) return String;
+   --  Returns a string that uniquely identifies the source file containing
+   --  the given source location.  This string is constructed from the
+   --  concatentation of the date and time stamp of the file with a
+   --  hexadecimal check sum (e.g., "020425143059ABCDEF01").
+
+   function Source_Id (Sloc : Source_Ptr) return String_Id;
+   --  Returns a String_Id reference to a string that uniquely identifies the
+   --  source file containing the given source location (as defined for
+   --  function Source_Id_String).
+
+   function Image (I : Int) return String;
+   --  Returns Int'Image (I), but without a leading space in the case where
+   --  I is nonnegative. Useful for concatenating integers onto other names.
+
+   type Integer_Image_Format is (Decimal, Ada_Hex, AAMP_Hex);
+
+   function UI_Image (I : Uint; Format : Integer_Image_Format) return String;
+   --  Returns the image of the universal integer I, with no leading spaces
+   --  and in the format specified. The Format parameter specifies whether
+   --  the integer representation should be decimal (the default), or Ada
+   --  hexadecimal (Ada_Hex => "16#xxxxx#" format), or AAMP hexadecimal.
+   --  In the latter case, the integer will have the form of a sequence of
+   --  hexadecimal digits bracketed by '^' characters, and will contain '_'
+   --  characters as separators for groups of four hexadecimal digits
+   --  (e.g., ^1C_A3CD^). If the format AAMP_Hex is selected, the universal
+   --  integer must have a nonnegative value.
+
+   function UR_Image (R : Ureal) return String;
+   --  Returns a decimal image of the universal real value R
+
+private
+
+   type Name_Sequencer is record
+      Sequence_Number : Natural := 0;
+   end record;
+
+end AA_Util;
diff --git a/gcc/ada/adabkend.adb b/gcc/ada/adabkend.adb
new file mode 100644
index 0000000..96bd00d
--- /dev/null
+++ b/gcc/ada/adabkend.adb
@@ -0,0 +1,282 @@
+------------------------------------------------------------------------------
+--                                                                          --
+--                        GNAAMP COMPILER COMPONENTS                        --
+--                                                                          --
+--                             A D A B K E N D                              --
+--                                                                          --
+--                                 B o d y                                  --
+--                                                                          --
+--                     Copyright (C) 2001-2011, AdaCore                     --
+--                                                                          --
+-- 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.          --
+--                                                                          --
+------------------------------------------------------------------------------
+
+--  This is the version of the Back_End package for back ends written in Ada
+
+with Debug;
+with Lib;
+with Opt;      use Opt;
+with Output;   use Output;
+with Osint;    use Osint;
+with Osint.C;  use Osint.C;
+with Switch.C; use Switch.C;
+with Types;    use Types;
+
+with System.OS_Lib; use System.OS_Lib;
+
+package body Adabkend is
+
+   use Switch;
+
+   -------------------
+   -- Call_Back_End --
+   -------------------
+
+   procedure Call_Back_End is
+   begin
+      if (Opt.Verbose_Mode or Opt.Full_List)
+        and then not Debug.Debug_Flag_7
+      then
+         Write_Eol;
+         Write_Str (Product_Name);
+         Write_Str (", Copyright ");
+         Write_Str (Copyright_Years);
+         Write_Str (" Ada Core Technologies, Inc.");
+         Write_Str (" (http://www.adacore.com)");
+         Write_Eol;
+         Write_Eol;
+      end if;
+
+      Driver (Lib.Cunit (Types.Main_Unit));
+   end Call_Back_End;
+
+   ------------------------
+   -- Scan_Compiler_Args --
+   ------------------------
+
+   procedure Scan_Compiler_Arguments is
+      Output_File_Name_Seen : Boolean := False;
+      --  Set to True after having scanned the file_name for switch
+      --  "-gnatO file_name"
+
+      Argument_Count : constant Integer := Arg_Count - 1;
+      --  Number of arguments (excluding program name)
+
+      Args     : Argument_List (1 .. Argument_Count);
+      Next_Arg : Positive := 1;
+
+      procedure Scan_Back_End_Switches (Switch_Chars : String);
+      --  Procedure to scan out switches stored in Switch_Chars. The first
+      --  character is known to be a valid switch character, and there are no
+      --  blanks or other switch terminator characters in the string, so the
+      --  entire string should consist of valid switch characters, except that
+      --  an optional terminating NUL character is allowed.
+      --
+      --  If the switch is not valid, control will not return. The switches
+      --  must still be scanned to skip the "-o" arguments, or internal GCC
+      --  switches, which may be safely ignored by other back-ends.
+
+      ----------------------------
+      -- Scan_Back_End_Switches --
+      ----------------------------
+
+      procedure Scan_Back_End_Switches (Switch_Chars : String) is
+         First : constant Positive := Switch_Chars'First + 1;
+         Last  : constant Natural  := Switch_Last (Switch_Chars);
+
+      begin
+         --  Process any back end switches, returning if the switch does not
+         --  affect code generation or falling through if it does, so the
+         --  switch will get stored.
+
+         if Is_Internal_GCC_Switch (Switch_Chars) then
+            Next_Arg := Next_Arg + 1;
+            return; -- ignore this switch
+
+         --  Record that an object file name has been specified. The actual
+         --  file name argument is picked up and saved below by the main body
+         --  of Scan_Compiler_Arguments.
+
+         elsif Switch_Chars (First .. Last) = "o" then
+            if First = Last then
+               Opt.Output_File_Name_Present := True;
+               return;
+            else
+               Fail ("invalid switch: " & Switch_Chars);
+            end if;
+
+         --  Set optimization indicators appropriately. In gcc-based GNAT this
+         --  is picked up from imported variables set by the gcc driver, but
+         --  for compilers with non-gcc back ends we do it here to allow use
+         --  of these switches by the front end. Allowed optimization switches
+         --  are -Os (optimize for size), -O[0123], and -O (same as -O1).
+
+         elsif Switch_Chars (First) = 'O' then
+            if First = Last then
+               Optimization_Level := 1;
+
+            elsif Last - First = 1 then
+               if Switch_Chars (Last) = 's' then
+                  Optimize_Size := 1;
+                  Optimization_Level := 2;  -- Consistent with gcc setting
+
+               elsif Switch_Chars (Last) in '0' .. '3' then
+                  Optimization_Level :=
+                    Character'Pos (Switch_Chars (Last)) - Character'Pos ('0');
+
+               else
+                  Fail ("invalid switch: " & Switch_Chars);
+               end if;
+
+            else
+               Fail ("invalid switch: " & Switch_Chars);
+            end if;
+
+         elsif Switch_Chars (First .. Last) = "quiet" then
+            return; -- ignore this switch
+
+         elsif Switch_Chars (First .. Last) = "c" then
+            return; -- ignore this switch
+
+         --  The -x switch and its language name argument will generally be
+         --  ignored by non-gcc back ends (e.g. the GNAAMP back end). In any
+         --  case, we save the switch and argument in the compilation switches.
+
+         elsif Switch_Chars (First .. Last) = "x" then
+            Lib.Store_Compilation_Switch (Switch_Chars);
+            Next_Arg := Next_Arg + 1;
+
+            declare
+               Argv : constant String := Args (Next_Arg).all;
+
+            begin
+               if Is_Switch (Argv) then
+                  Fail ("language name missing after -x");
+               else
+                  Lib.Store_Compilation_Switch (Argv);
+               end if;
+            end;
+
+            return;
+
+         --  Special check, the back end switch -fno-inline also sets the
+         --  front end flag to entirely inhibit all inlining. So we store it
+         --  and set the appropriate flag.
+
+         elsif Switch_Chars (First .. Last) = "fno-inline" then
+            Lib.Store_Compilation_Switch (Switch_Chars);
+            Opt.Suppress_All_Inlining := True;
+            return;
+
+         --  Similar processing for -fpreserve-control-flow
+
+         elsif Switch_Chars (First .. Last) = "fpreserve-control-flow" then
+            Lib.Store_Compilation_Switch (Switch_Chars);
+            Opt.Suppress_Control_Flow_Optimizations := True;
+            return;
+
+         --  Ignore all other back end switches
+
+         elsif Is_Back_End_Switch (Switch_Chars) then
+            null;
+
+         --  Give error for junk switch
+
+         else
+            Fail ("invalid switch: " & Switch_Chars);
+         end if;
+
+         --  Store any other GCC switches
+
+         Lib.Store_Compilation_Switch (Switch_Chars);
+      end Scan_Back_End_Switches;
+
+   --  Start of processing for Scan_Compiler_Args
+
+   begin
+      --  Put all the arguments in argument list Args
+
+      for Arg in 1 .. Argument_Count loop
+         declare
+            Argv : String (1 .. Len_Arg (Arg));
+         begin
+            Fill_Arg (Argv'Address, Arg);
+            Args (Arg) := new String'(Argv);
+         end;
+      end loop;
+
+      --  Loop through command line arguments, storing them for later access
+
+      while Next_Arg <= Argument_Count loop
+         Look_At_Arg : declare
+            Argv : constant String := Args (Next_Arg).all;
+
+         begin
+            if Argv'Length = 0 then
+               Fail ("Empty argument");
+            end if;
+
+            --  If the previous switch has set the Output_File_Name_Present
+            --  flag (that is we have seen a -gnatO), then the next argument
+            --  is the name of the output object file.
+
+            if Opt.Output_File_Name_Present
+              and then not Output_File_Name_Seen
+            then
+               if Is_Switch (Argv) then
+                  Fail ("Object file name missing after -gnatO");
+               else
+                  Set_Output_Object_File_Name (Argv);
+                  Output_File_Name_Seen := True;
+               end if;
+
+               --  If the previous switch has set the Search_Directory_Present
+               --  flag (that is if we have just seen -I), then the next
+               --  argument is a search directory path.
+
+            elsif Search_Directory_Present then
+               if Is_Switch (Argv) then
+                  Fail ("search directory missing after -I");
+               else
+                  Add_Src_Search_Dir (Argv);
+
+                  --  Add directory to lib search so that back-end can take as
+                  --  input ALI files if needed. Otherwise this won't have any
+                  --  impact on the compiler.
+
+                  Add_Lib_Search_Dir (Argv);
+
+                  Search_Directory_Present := False;
+               end if;
+
+            --  If not a switch, must be a file name
+
+            elsif not Is_Switch (Argv) then
+               Add_File (Argv);
+
+            --  Front end switch
+
+            elsif Is_Front_End_Switch (Argv) then
+               Scan_Front_End_Switches (Argv, Args, Next_Arg);
+
+            --  All non-front-end switches are back-end switches
+
+            else
+               Scan_Back_End_Switches (Argv);
+            end if;
+         end Look_At_Arg;
+
+         Next_Arg := Next_Arg + 1;
+      end loop;
+   end Scan_Compiler_Arguments;
+
+end Adabkend;
diff --git a/gcc/ada/adabkend.ads b/gcc/ada/adabkend.ads
new file mode 100644
index 0000000..877422c
--- /dev/null
+++ b/gcc/ada/adabkend.ads
@@ -0,0 +1,52 @@
+------------------------------------------------------------------------------
+--                                                                          --
+--                         GNAT COMPILER COMPONENTS                         --
+--                                                                          --
+--                              A D A B K E N D                             --
+--                                                                          --
+--                                 S p e c                                  --
+--                                                                          --
+--          Copyright (C) 1992-2012, 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.      --
+--                                                                          --
+------------------------------------------------------------------------------
+
+--  Generic package implementing the common parts of back_end.adb for back ends
+--  written in Ada, thereby reducing code duplication.
+
+with Types;
+
+generic
+   Product_Name    : String;
+   Copyright_Years : String;
+
+   with procedure Driver (Root : Types.Node_Id);
+   --  Main driver procedure for back end
+
+   with function Is_Back_End_Switch (Switch : String) return Boolean;
+   --  Back-end specific function to determine validity of switches
+
+package Adabkend is
+
+   procedure Call_Back_End;
+   --  Call back end, i.e. make call to the Driver passing the root
+   --  node for this compilation unit.
+
+   procedure Scan_Compiler_Arguments;
+   --  Acquires command-line parameters passed to the compiler and processes
+   --  them. Calls Scan_Front_End_Switches for any front-end switches
+   --  encountered. See spec of Back_End for more details.
+
+end Adabkend;