New Language: Ada

From-SVN: r45954

gcc/ada/back_end.ads

+------------------------------------------------------------------------------
+--                                                                          --
+--                         GNAT COMPILER COMPONENTS                         --
+--                                                                          --
+--                             B A C K _ E N D                              --
+--                                                                          --
+--                                 S p e c                                  --
+--                                                                          --
+--                            $Revision: 1.7 $
+--                                                                          --
+--          Copyright (C) 1992-2001 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 2,  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 COPYING.  If not, write --
+-- to  the Free Software Foundation,  59 Temple Place - Suite 330,  Boston, --
+-- MA 02111-1307, USA.                                                      --
+--                                                                          --
+-- GNAT was originally developed  by the GNAT team at  New York University. --
+-- It is now maintained by Ada Core Technologies Inc (http://www.gnat.com). --
+--                                                                          --
+------------------------------------------------------------------------------
+
+--  Call the back end with all the information needed. Also contains other
+--  back-end specific interfaces required by the front end.
+
+package Back_End is
+
+   type Back_End_Mode_Type is (
+      Generate_Object,
+      --  Full back end operation with object file generation
+
+      Declarations_Only,
+      --  Partial back end operation with no object file generation. In this
+      --  mode the only useful action performed by gigi is to process all
+      --  declarations issuing any error messages (in partcicular those to
+      --  do with rep clauses), and to back annotate representation info.
+
+      Skip);
+      --  Back end call is skipped (syntax only, or errors found)
+
+   pragma Convention (C, Back_End_Mode_Type);
+   for Back_End_Mode_Type use (0, 1, 2);
+
+   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.
+
+   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.
+   --
+   --  The processing of arguments is private to the back end, since
+   --  the way of acquiring the arguments as well as the set of allowable
+   --  back end switches is different depending on the particular back end
+   --  being used.
+   --
+   --  Any processed switches that influence the result of a compilation
+   --  must be added to the Compilation_Arguments table.
+
+end Back_End;

gcc/ada/bcheck.ads

+------------------------------------------------------------------------------
+--                                                                          --
+--                         GNAT COMPILER COMPONENTS                         --
+--                                                                          --
+--                               B C H E C K                                --
+--                                                                          --
+--                                 S p e c                                  --
+--                                                                          --
+--                            $Revision: 1.7 $
+--                                                                          --
+--          Copyright (C) 1992-1999 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 2,  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 COPYING.  If not, write --
+-- to  the Free Software Foundation,  59 Temple Place - Suite 330,  Boston, --
+-- MA 02111-1307, USA.                                                      --
+--                                                                          --
+-- GNAT was originally developed  by the GNAT team at  New York University. --
+-- It is now maintained by Ada Core Technologies Inc (http://www.gnat.com). --
+--                                                                          --
+------------------------------------------------------------------------------
+
+package Bcheck is
+
+--  This package contains the routines to perform binder consistency checks
+
+   procedure Check_Duplicated_Subunits;
+   --  Check that no subunit names duplicate names of other packages in
+   --  the partition (check required by RM 10.2(19)).
+
+   procedure Check_Versions;
+   --  Check correct library and standard versions used
+
+   procedure Check_Consistency;
+   --  This procedure performs checks that the ALI files are consistent
+   --  with the corresponding source files and with one another. At the
+   --  time this is called, the Source table has been completely built and
+   --  contains either the time stamp from the actual source file if the
+   --  Check_Source_Files mode is set, or the latest stamp found in any of
+   --  the ALI files in the program.
+
+   procedure Check_Configuration_Consistency;
+   --  This procedure performs a similar check that configuration pragma
+   --  set items that are required to be consistent are in fact consistent
+
+end Bcheck;

gcc/ada/binde.ads

+------------------------------------------------------------------------------
+--                                                                          --
+--                         GNAT COMPILER COMPONENTS                         --
+--                                                                          --
+--                                B I N D E                                 --
+--                                                                          --
+--                                 S p e c                                  --
+--                                                                          --
+--                            $Revision: 1.9 $                              --
+--                                                                          --
+--          Copyright (C) 1992-1997 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 2,  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 COPYING.  If not, write --
+-- to  the Free Software Foundation,  59 Temple Place - Suite 330,  Boston, --
+-- MA 02111-1307, USA.                                                      --
+--                                                                          --
+-- GNAT was originally developed  by the GNAT team at  New York University. --
+-- It is now maintained by Ada Core Technologies Inc (http://www.gnat.com). --
+--                                                                          --
+------------------------------------------------------------------------------
+
+--  This package contains the routines to determine elaboration order
+
+with ALI;   use ALI;
+with Table;
+with Types; use Types;
+
+package Binde is
+
+   --  The following table records the chosen elaboration order. It is used
+   --  by Gen_Elab_Call to generate the sequence of elaboration calls. Note
+   --  that units are included in this table even if they have no elaboration
+   --  routine, since the table is also used to drive the generation of object
+   --  files in the binder output. Gen_Elab_Call skips any units that have no
+   --  elaboration routine.
+
+   package Elab_Order is new Table.Table (
+     Table_Component_Type => Unit_Id,
+     Table_Index_Type     => Nat,
+     Table_Low_Bound      => 1,
+     Table_Initial        => 500,
+     Table_Increment      => 200,
+     Table_Name           => "Elab_Order");
+
+   procedure Find_Elab_Order;
+   --  Determine elaboration order
+
+end Binde;

gcc/ada/binderr.adb

+------------------------------------------------------------------------------
+--                                                                          --
+--                         GNAT COMPILER COMPONENTS                         --
+--                                                                          --
+--                              B I N D E R R                               --
+--                                                                          --
+--                                 B o d y                                  --
+--                                                                          --
+--                            $Revision: 1.22 $
+--                                                                          --
+--          Copyright (C) 1992-2000 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 2,  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 COPYING.  If not, write --
+-- to  the Free Software Foundation,  59 Temple Place - Suite 330,  Boston, --
+-- MA 02111-1307, USA.                                                      --
+--                                                                          --
+-- GNAT was originally developed  by the GNAT team at  New York University. --
+-- It is now maintained by Ada Core Technologies Inc (http://www.gnat.com). --
+--                                                                          --
+------------------------------------------------------------------------------
+
+with Butil;   use Butil;
+with Namet;   use Namet;
+with Opt;     use Opt;
+with Output;  use Output;
+
+package body Binderr is
+
+   ---------------
+   -- Error_Msg --
+   ---------------
+
+   procedure Error_Msg (Msg : String) is
+   begin
+      if Msg (Msg'First) = '?' then
+         if Warning_Mode = Suppress then
+            return;
+         end if;
+
+         if Warning_Mode = Treat_As_Error then
+            Errors_Detected := Errors_Detected + 1;
+         else
+            Warnings_Detected := Warnings_Detected + 1;
+         end if;
+
+      else
+         Errors_Detected := Errors_Detected + 1;
+      end if;
+
+      if Brief_Output or else (not Verbose_Mode) then
+         Set_Standard_Error;
+         Error_Msg_Output (Msg, Info => False);
+         Set_Standard_Output;
+      end if;
+
+      if Verbose_Mode then
+         if Errors_Detected + Warnings_Detected = 0 then
+            Write_Eol;
+         end if;
+
+         Error_Msg_Output (Msg, Info => False);
+      end if;
+
+      if Warnings_Detected + Errors_Detected > Maximum_Errors then
+         raise Unrecoverable_Error;
+      end if;
+
+   end Error_Msg;
+
+   --------------------
+   -- Error_Msg_Info --
+   --------------------
+
+   procedure Error_Msg_Info (Msg : String) is
+   begin
+      if Brief_Output or else (not Verbose_Mode) then
+         Set_Standard_Error;
+         Error_Msg_Output (Msg, Info => True);
+         Set_Standard_Output;
+      end if;
+
+      if Verbose_Mode then
+         Error_Msg_Output (Msg, Info => True);
+      end if;
+
+   end Error_Msg_Info;
+
+   ----------------------
+   -- Error_Msg_Output --
+   ----------------------
+
+   procedure Error_Msg_Output (Msg : String; Info : Boolean) is
+      Use_Second_Name : Boolean := False;
+
+   begin
+      if Warnings_Detected + Errors_Detected > Maximum_Errors then
+         Write_Str ("error: maximum errors exceeded");
+         Write_Eol;
+         return;
+      end if;
+
+      if Msg (Msg'First) = '?' then
+         Write_Str ("warning: ");
+      elsif Info then
+         if not Info_Prefix_Suppress then
+            Write_Str ("info:  ");
+         end if;
+      else
+         Write_Str ("error: ");
+      end if;
+
+      for I in Msg'Range loop
+         if Msg (I) = '%' then
+
+            if Use_Second_Name then
+               Get_Name_String (Error_Msg_Name_2);
+            else
+               Use_Second_Name := True;
+               Get_Name_String (Error_Msg_Name_1);
+            end if;
+
+            Write_Char ('"');
+            Write_Str (Name_Buffer (1 .. Name_Len));
+            Write_Char ('"');
+
+         elsif Msg (I) = '&' then
+            Write_Char ('"');
+
+            if Use_Second_Name then
+               Write_Unit_Name (Error_Msg_Name_2);
+            else
+               Use_Second_Name := True;
+               Write_Unit_Name (Error_Msg_Name_1);
+            end if;
+
+            Write_Char ('"');
+
+         elsif Msg (I) /= '?' then
+            Write_Char (Msg (I));
+         end if;
+      end loop;
+
+      Write_Eol;
+   end Error_Msg_Output;
+
+   ----------------------
+   -- Finalize_Binderr --
+   ----------------------
+
+   procedure Finalize_Binderr is
+   begin
+      --  Message giving number of errors detected (verbose mode only)
+
+      if Verbose_Mode then
+         Write_Eol;
+
+         if Errors_Detected = 0 then
+            Write_Str ("No errors");
+
+         elsif Errors_Detected = 1 then
+            Write_Str ("1 error");
+
+         else
+            Write_Int (Errors_Detected);
+            Write_Str (" errors");
+         end if;
+
+         if Warnings_Detected = 1 then
+            Write_Str (", 1 warning");
+
+         elsif Warnings_Detected > 1 then
+            Write_Str (", ");
+            Write_Int (Warnings_Detected);
+            Write_Str (" warnings");
+         end if;
+
+         Write_Eol;
+      end if;
+   end Finalize_Binderr;
+
+   ------------------------
+   -- Initialize_Binderr --
+   ------------------------
+
+   procedure Initialize_Binderr is
+   begin
+      Errors_Detected := 0;
+      Warnings_Detected := 0;
+   end Initialize_Binderr;
+
+end Binderr;

gcc/ada/binderr.ads

+------------------------------------------------------------------------------
+--                                                                          --
+--                         GNAT COMPILER COMPONENTS                         --
+--                                                                          --
+--                              B I N D E R R                               --
+--                                                                          --
+--                                 S p e c                                  --
+--                                                                          --
+--                            $Revision: 1.13 $
+--                                                                          --
+--          Copyright (C) 1992-2000 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 2,  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 COPYING.  If not, write --
+-- to  the Free Software Foundation,  59 Temple Place - Suite 330,  Boston, --
+-- MA 02111-1307, USA.                                                      --
+--                                                                          --
+-- GNAT was originally developed  by the GNAT team at  New York University. --
+-- It is now maintained by Ada Core Technologies Inc (http://www.gnat.com). --
+--                                                                          --
+------------------------------------------------------------------------------
+
+--  This package contains the routines to output error messages for the binder
+--  and also the routines for handling fatal error conditions in the binder.
+
+with Types; use Types;
+
+package Binderr is
+
+   Errors_Detected : Int;
+   --  Number of errors detected so far
+
+   Warnings_Detected : Int;
+   --  Number of warnings detected
+
+   Info_Prefix_Suppress : Boolean := False;
+   --  If set to True, the normal "info: " header before messages generated
+   --  by Error_Msg_Info will be omitted.
+
+   ---------------------------------------------------------
+   -- Error Message Text and Message Insertion Characters --
+   ---------------------------------------------------------
+
+   --  Error message text strings are composed of letters, digits and the
+   --  special characters space, comma, period, colon and semicolon,
+   --  apostrophe and parentheses. Special insertion characters can also
+   --  appear which cause the error message circuit to modify the given
+   --  string as follows:
+
+   --    Insertion character % (Percent: insert file name from Names table)
+   --      The character % is replaced by the text for the file name specified
+   --      by the Name_Id value stored in Error_Msg_Name_1. The name is always
+   --      enclosed in quotes. A second % may appear in a single message in
+   --      which case it is similarly replaced by the name which is specified
+   --      by the Name_Id value stored in Error_Msg_Name_2.
+
+   --    Insertion character & (Ampersand: insert unit name from Names table)
+   --      The character & is replaced by the text for the unit name specified
+   --      by the Name_Id value stored in Error_Msg_Name_1. The name is always
+   --      enclosed in quotes. A second & may appear in a single message in
+   --      which case it is similarly replaced by the name which is specified
+   --      by the Name_Id value stored in Error_Msg_Name_2.
+
+   --    Insertion character ? (Question mark: warning message)
+   --      The character ?, which must be the first character in the message
+   --      string, signals a warning message instead of an error message.
+
+   -----------------------------------------------------
+   -- Global Values Used for Error Message Insertions --
+   -----------------------------------------------------
+
+   --  The following global variables are essentially additional parameters
+   --  passed to the error message routine for insertion sequences described
+   --  above. The reason these are passed globally is that the insertion
+   --  mechanism is essentially an untyped one in which the appropriate
+   --  variables are set dependingon the specific insertion characters used.
+
+   Error_Msg_Name_1 : Name_Id;
+   Error_Msg_Name_2 : Name_Id;
+   --  Name_Id values for % insertion characters in message
+
+   ------------------------------
+   -- Error Output Subprograms --
+   ------------------------------
+
+   procedure Error_Msg (Msg : String);
+   --  Output specified error message to standard error or standard output
+   --  as governed by the brief and verbose switches, and update error
+   --  counts appropriately
+
+   procedure Error_Msg_Info (Msg : String);
+   --  Output information line. Indentical in effect to Error_Msg, except
+   --  that the prefix is info: instead of error: and the error count is
+   --  not incremented. The prefix may be suppressed by setting the global
+   --  variable Info_Prefix_Suppress to True.
+
+   procedure Error_Msg_Output (Msg : String; Info : Boolean);
+   --  Output given message, with insertions, to current message output file.
+   --  The second argument is True for an info message, false for a normal
+   --  warning or error message. Normally this is not called directly, but
+   --  rather only by Error_Msg or Error_Msg_Info. It is called directly
+   --  when the caller must control whether the output goes to stderr or
+   --  stdout (Error_Msg_Output always goes to the current output file).
+
+   procedure Finalize_Binderr;
+   --  Finalize error output for one file
+
+   procedure Initialize_Binderr;
+   --  Initialize error output for one file
+
+end Binderr;

gcc/ada/bindgen.ads

+------------------------------------------------------------------------------
+--                                                                          --
+--                         GNAT COMPILER COMPONENTS                         --
+--                                                                          --
+--                              B I N D G E N                               --
+--                                                                          --
+--                                 S p e c                                  --
+--                                                                          --
+--                            $Revision: 1.7 $                              --
+--                                                                          --
+--   Copyright (C) 1992,1993,1994,1995,1996 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 2,  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 COPYING.  If not, write --
+-- to  the Free Software Foundation,  59 Temple Place - Suite 330,  Boston, --
+-- MA 02111-1307, USA.                                                      --
+--                                                                          --
+-- GNAT was originally developed  by the GNAT team at  New York University. --
+-- It is now maintained by Ada Core Technologies Inc (http://www.gnat.com). --
+--                                                                          --
+------------------------------------------------------------------------------
+
+--  This package contains the routines to output the binder file. This is
+--  a C program which contains the following:
+
+--     initialization for main program case
+--     sequence of calls to elaboration routines in appropriate order
+--     call to main program for main program case
+
+--  See the body for exact details of the file that is generated
+
+package Bindgen is
+
+   ------------------
+   --  Subprograms --
+   ------------------
+
+   procedure Gen_Output_File (Filename : String);
+   --  Filename is the full path name of the binder output file
+
+end Bindgen;

gcc/ada/bindusg.adb

+------------------------------------------------------------------------------
+--                                                                          --
+--                        GBIND BINDER COMPONENTS                           --
+--                                                                          --
+--                             B I N D U S G                                --
+--                                                                          --
+--                                B o d y                                   --
+--                                                                          --
+--                            $Revision: 1.52 $
+--                                                                          --
+--          Copyright (C) 1992-2001 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 2,  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 COPYING.  If not, write --
+-- to  the Free Software Foundation,  59 Temple Place - Suite 330,  Boston, --
+-- MA 02111-1307, USA.                                                      --
+--                                                                          --
+-- GNAT was originally developed  by the GNAT team at  New York University. --
+-- It is now maintained by Ada Core Technologies Inc (http://www.gnat.com). --
+--                                                                          --
+------------------------------------------------------------------------------
+
+with Osint;  use Osint;
+with Output; use Output;
+
+procedure Bindusg is
+
+   procedure Write_Switch_Char;
+   --  Write two spaces followed by appropriate switch character
+
+   procedure Write_Switch_Char is
+   begin
+      Write_Str ("  ");
+      Write_Char (Switch_Character);
+   end Write_Switch_Char;
+
+--  Start of processing for Bindusg
+
+begin
+   --  Usage line
+
+   Write_Str ("Usage: ");
+   Write_Program_Name;
+   Write_Char (' ');
+   Write_Str ("switches lfile");
+   Write_Eol;
+   Write_Eol;
+
+   --  Line for -aO switch
+
+   Write_Switch_Char;
+   Write_Str ("aOdir    Specify library files search path");
+   Write_Eol;
+
+   --  Line for -aI switch
+
+   Write_Switch_Char;
+   Write_Str ("aIdir    Specify source files search path");
+   Write_Eol;
+
+   --  Line for A switch
+
+   Write_Switch_Char;
+   Write_Str ("A        Generate binder program in Ada (default)");
+   Write_Eol;
+
+   --  Line for -b switch
+
+   Write_Switch_Char;
+   Write_Str ("b        Generate brief messages to std");
+   Write_Str ("err even if verbose mode set");
+   Write_Eol;
+
+   --  Line for -c switch
+
+   Write_Switch_Char;
+   Write_Str ("c        Check only, no generation of b");
+   Write_Str ("inder output file");
+   Write_Eol;
+
+   --  Line for C switch
+
+   Write_Switch_Char;
+   Write_Str ("C        Generate binder program in C");
+   Write_Eol;
+
+   --  Line for -e switch
+
+   Write_Switch_Char;
+   Write_Str ("e        Output complete list of elabor");
+   Write_Str ("ation order dependencies");
+   Write_Eol;
+
+   --  Line for -E switch
+
+   Write_Switch_Char;
+   Write_Str ("E        Store tracebacks in Exception occurrences");
+   Write_Eol;
+
+   --  Line for -f switch
+
+   Write_Switch_Char;
+   Write_Str ("f        Force RM elaboration ordering rules");
+   Write_Eol;
+
+   --  Line for -h switch
+
+   Write_Switch_Char;
+   Write_Str ("h        Output this usage (help) infor");
+   Write_Str ("mation");
+   Write_Eol;
+
+   --  Line for -I switch
+
+   Write_Switch_Char;
+   Write_Str ("Idir     Specify library and source files search path");
+   Write_Eol;
+
+   --  Line for -I- switch
+
+   Write_Switch_Char;
+   Write_Str ("I-       Don't look for sources & library files");
+   Write_Str (" in default directory");
+   Write_Eol;
+
+   --  Line for -K switch
+
+   Write_Switch_Char;
+   Write_Str ("K        Give list of linker options specified for link");
+   Write_Eol;
+
+   --  Line for -l switch
+
+   Write_Switch_Char;
+   Write_Str ("l        Output chosen elaboration order");
+   Write_Eol;
+
+   --  Line of -L switch
+
+   Write_Switch_Char;
+   Write_Str ("Lxyz     Library build: adainit/final ");
+   Write_Str ("renamed to xyzinit/final, implies -n");
+   Write_Eol;
+
+   --  Line for -M switch
+
+   Write_Switch_Char;
+   Write_Str ("Mxyz     Rename generated main program from main to xyz");
+   Write_Eol;
+
+   --  Line for -m switch
+
+   Write_Switch_Char;
+   Write_Str ("mnnn     Limit number of detected error");
+   Write_Str ("s to nnn (1-999)");
+   Write_Eol;
+
+   --  Line for -n switch
+
+   Write_Switch_Char;
+   Write_Str ("n        No Ada main program (foreign main routine)");
+   Write_Eol;
+
+   --  Line for -nostdinc
+
+   Write_Switch_Char;
+   Write_Str ("nostdinc Don't look for source files");
+   Write_Str (" in the system default directory");
+   Write_Eol;
+
+   --  Line for -nostdlib
+
+   Write_Switch_Char;
+   Write_Str ("nostdlib Don't look for library files");
+   Write_Str (" in the system default directory");
+   Write_Eol;
+
+   --  Line for -o switch
+
+   Write_Switch_Char;
+   Write_Str ("o file   Give the output file name (default is b~xxx.adb) ");
+   Write_Eol;
+
+   --  Line for -O switch
+
+   Write_Switch_Char;
+   Write_Str ("O        Give list of objects required for link");
+   Write_Eol;
+
+   --  Line for -p switch
+
+   Write_Switch_Char;
+   Write_Str ("p        Pessimistic (worst-case) elaborat");
+   Write_Str ("ion order");
+   Write_Eol;
+
+   --  Line for -s switch
+
+   Write_Switch_Char;
+   Write_Str ("s        Require all source files to be");
+   Write_Str (" present");
+   Write_Eol;
+
+   --  Line for -Sxx switch
+
+   Write_Switch_Char;
+   Write_Str ("S??      Sin/lo/hi/xx for Initialize_Scalars");
+   Write_Str (" invalid/low/high/hex");
+   Write_Eol;
+
+   --  Line for -static
+
+   Write_Switch_Char;
+   Write_Str ("static   Link against a static GNAT run time");
+   Write_Eol;
+
+   --  Line for -shared
+
+   Write_Switch_Char;
+   Write_Str ("shared   Link against a shared GNAT run time");
+   Write_Eol;
+
+   --  Line for -t switch
+
+   Write_Switch_Char;
+   Write_Str ("t        Tolerate time stamp and other consistency errors");
+   Write_Eol;
+
+   --  Line for -T switch
+
+   Write_Switch_Char;
+   Write_Str ("Tn       Set time slice value to n microseconds (n >= 0)");
+   Write_Eol;
+
+   --  Line for -v switch
+
+   Write_Switch_Char;
+   Write_Str ("v        Verbose mode. Error messages, ");
+   Write_Str ("header, summary output to stdout");
+   Write_Eol;
+
+   --  Lines for -w switch
+
+   Write_Switch_Char;
+   Write_Str ("wx       Warning mode. (x=s/e for supp");
+   Write_Str ("ress/treat as error)");
+   Write_Eol;
+
+   --  Line for -x switch
+
+   Write_Switch_Char;
+   Write_Str ("x        Exclude source files (check ob");
+   Write_Str ("ject consistency only)");
+   Write_Eol;
+
+   --  Line for -z switch
+
+   Write_Switch_Char;
+   Write_Str ("z        No main subprogram (zero main)");
+   Write_Eol;
+
+   --  Line for sfile
+
+   Write_Str ("  lfile     Library file names");
+   Write_Eol;
+
+end Bindusg;

gcc/ada/bindusg.ads

+------------------------------------------------------------------------------
+--                                                                          --
+--                         GNAT COMPILER COMPONENTS                         --
+--                                                                          --
+--                              B I N D U S G                               --
+--                                                                          --
+--                                 S p e c                                  --
+--                                                                          --
+--                            $Revision: 1.3 $                              --
+--                                                                          --
+--        Copyright (C) 1992,1993,1994 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 2,  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 COPYING.  If not, write --
+-- to  the Free Software Foundation,  59 Temple Place - Suite 330,  Boston, --
+-- MA 02111-1307, USA.                                                      --
+--                                                                          --
+-- GNAT was originally developed  by the GNAT team at  New York University. --
+-- It is now maintained by Ada Core Technologies Inc (http://www.gnat.com). --
+--                                                                          --
+------------------------------------------------------------------------------
+
+--  Procedure to generate screen of usage information if no file name present
+
+procedure Bindusg;

gcc/ada/butil.adb

+------------------------------------------------------------------------------
+--                                                                          --
+--                         GNAT COMPILER COMPONENTS                         --
+--                                                                          --
+--                                B U T I L                                 --
+--                                                                          --
+--                                 B o d y                                  --
+--                                                                          --
+--                            $Revision: 1.16 $
+--                                                                          --
+--          Copyright (C) 1992-2001 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 2,  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 COPYING.  If not, write --
+-- to  the Free Software Foundation,  59 Temple Place - Suite 330,  Boston, --
+-- MA 02111-1307, USA.                                                      --
+--                                                                          --
+-- GNAT was originally developed  by the GNAT team at  New York University. --
+-- It is now maintained by Ada Core Technologies Inc (http://www.gnat.com). --
+--                                                                          --
+------------------------------------------------------------------------------
+
+with Hostparm; use Hostparm;
+with Namet;    use Namet;
+with Output;   use Output;
+
+package body Butil is
+
+   --------------------------
+   -- Get_Unit_Name_String --
+   --------------------------
+
+   procedure Get_Unit_Name_String (U : Unit_Name_Type) is
+   begin
+      Get_Name_String (U);
+
+      if Name_Buffer (Name_Len) = 's' then
+         Name_Buffer (Name_Len - 1 .. Name_Len + 5) := " (spec)";
+      else
+         Name_Buffer (Name_Len - 1 .. Name_Len + 5) := " (body)";
+      end if;
+
+      Name_Len := Name_Len + 5;
+   end Get_Unit_Name_String;
+
+   ----------------------
+   -- Is_Internal_Unit --
+   ----------------------
+
+   --  Note: the reason we do not use the Fname package for this function
+   --  is that it would drag too much junk into the binder.
+
+   function Is_Internal_Unit return Boolean is
+   begin
+      return Is_Predefined_Unit
+        or else (Name_Len > 4
+                   and then (Name_Buffer (1 .. 5) = "gnat%"
+                               or else
+                             Name_Buffer (1 .. 5) = "gnat."))
+        or else
+          (OpenVMS
+             and then Name_Len > 3
+             and then (Name_Buffer (1 .. 4) = "dec%"
+                         or else
+                       Name_Buffer (1 .. 4) = "dec."));
+
+   end Is_Internal_Unit;
+
+   ------------------------
+   -- Is_Predefined_Unit --
+   ------------------------
+
+   --  Note: the reason we do not use the Fname package for this function
+   --  is that it would drag too much junk into the binder.
+
+   function Is_Predefined_Unit return Boolean is
+   begin
+      return    (Name_Len >  3
+                  and then Name_Buffer (1 ..  4) = "ada.")
+
+        or else (Name_Len >  6
+                  and then Name_Buffer (1 ..  7) = "system.")
+
+        or else (Name_Len > 10
+                   and then Name_Buffer (1 .. 11) = "interfaces.")
+
+        or else (Name_Len >  3
+                   and then Name_Buffer (1 ..  4) = "ada%")
+
+        or else (Name_Len >  8
+                   and then Name_Buffer (1 ..  9) = "calendar%")
+
+        or else (Name_Len >  9
+                   and then Name_Buffer (1 .. 10) = "direct_io%")
+
+        or else (Name_Len > 10
+                   and then Name_Buffer (1 .. 11) = "interfaces%")
+
+        or else (Name_Len > 13
+                   and then Name_Buffer (1 .. 14) = "io_exceptions%")
+
+        or else (Name_Len > 12
+                   and then Name_Buffer (1 .. 13) = "machine_code%")
+
+        or else (Name_Len > 13
+                   and then Name_Buffer (1 .. 14) = "sequential_io%")
+
+        or else (Name_Len >  6
+                   and then Name_Buffer (1 ..  7) = "system%")
+
+        or else (Name_Len >  7
+                   and then Name_Buffer (1 ..  8) = "text_io%")
+
+        or else (Name_Len > 20
+                   and then Name_Buffer (1 .. 21) = "unchecked_conversion%")
+
+        or else (Name_Len > 22
+                   and then Name_Buffer (1 .. 23) = "unchecked_deallocation%")
+
+        or else (Name_Len > 4
+                   and then Name_Buffer (1 .. 5) = "gnat%")
+
+        or else (Name_Len > 4
+                   and then Name_Buffer (1 .. 5) = "gnat.");
+   end Is_Predefined_Unit;
+
+   ----------------
+   -- Uname_Less --
+   ----------------
+
+   function Uname_Less (U1, U2 : Unit_Name_Type) return Boolean is
+   begin
+      Get_Name_String (U1);
+
+      declare
+         U1_Name : constant String (1 .. Name_Len) :=
+                                           Name_Buffer (1 .. Name_Len);
+         Min_Length : Natural;
+
+      begin
+         Get_Name_String (U2);
+
+         if Name_Len < U1_Name'Last then
+            Min_Length := Name_Len;
+         else
+            Min_Length := U1_Name'Last;
+         end if;
+
+         for I in 1 .. Min_Length loop
+            if U1_Name (I) > Name_Buffer (I) then
+               return False;
+            elsif U1_Name (I) < Name_Buffer (I) then
+               return True;
+            end if;
+         end loop;
+
+         return U1_Name'Last < Name_Len;
+      end;
+   end Uname_Less;
+
+   ---------------------
+   -- Write_Unit_Name --
+   ---------------------
+
+   procedure Write_Unit_Name (U : Unit_Name_Type) is
+   begin
+      Get_Name_String (U);
+      Write_Str (Name_Buffer (1 .. Name_Len - 2));
+
+      if Name_Buffer (Name_Len) = 's' then
+         Write_Str (" (spec)");
+      else
+         Write_Str (" (body)");
+      end if;
+
+      Name_Len := Name_Len + 5;
+   end Write_Unit_Name;
+
+end Butil;

gcc/ada/butil.ads

+------------------------------------------------------------------------------
+--                                                                          --
+--                         GNAT COMPILER COMPONENTS                         --
+--                                                                          --
+--                                B U T I L                                 --
+--                                                                          --
+--                                 S p e c                                  --
+--                                                                          --
+--                            $Revision: 1.9 $
+--                                                                          --
+--          Copyright (C) 1992-2001 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 2,  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 COPYING.  If not, write --
+-- to  the Free Software Foundation,  59 Temple Place - Suite 330,  Boston, --
+-- MA 02111-1307, USA.                                                      --
+--                                                                          --
+-- GNAT was originally developed  by the GNAT team at  New York University. --
+-- It is now maintained by Ada Core Technologies Inc (http://www.gnat.com). --
+--                                                                          --
+------------------------------------------------------------------------------
+
+with Types; use Types;
+
+package Butil is
+
+--  This package contains utility routines for the binder
+
+   function Is_Predefined_Unit return Boolean;
+   --  Given a unit name stored in Name_Buffer with length in Name_Len,
+   --  returns True if this is the name of a predefined unit or a child of
+   --  a predefined unit (including the obsolescent renamings). This is used
+   --  in the preference selection (see Better_Choice in body of Binde).
+
+   function Is_Internal_Unit return Boolean;
+   --  Given a unit name stored in Name_Buffer with length in Name_Len,
+   --  returns True if this is the name of an internal unit or a child of
+   --  an internal. Similar in usage to Is_Predefined_Unit.
+
+   --  Note: the following functions duplicate functionality in Uname, but
+   --  we want to avoid bringing Uname into the binder since it generates
+   --  to many unnecessary dependencies, and makes the binder too large.
+
+   function Uname_Less (U1, U2 : Unit_Name_Type) return Boolean;
+   --  Determines if the unit name U1 is alphabetically before U2
+
+   procedure Get_Unit_Name_String (U : Unit_Name_Type);
+   --  Compute unit name with (body) or (spec) after as required. On return
+   --  the result is stored in Name_Buffer and Name_Len is the length.
+
+   procedure Write_Unit_Name (U : Unit_Name_Type);
+   --  Output unit name with (body) or (spec) after as required. On return
+   --  Name_Len is set to the number of characters which were output.
+
+end Butil;

gcc/ada/cal.c

+/****************************************************************************
+ *                                                                          *
+ *                         GNAT COMPILER COMPONENTS                         *
+ *                                                                          *
+ *                                   C A L                                  *
+ *                                                                          *
+ *                          C Implementation File                           *
+ *                                                                          *
+ *                            $Revision: 1.1 $
+ *                                                                          *
+ *          Copyright (C) 1992-2001, 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 2,  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 COPYING.  If not, write *
+ * to  the Free Software Foundation,  59 Temple Place - Suite 330,  Boston, *
+ * MA 02111-1307, USA.                                                      *
+ *                                                                          *
+ * As a  special  exception,  if you  link  this file  with other  files to *
+ * produce an executable,  this file does not by itself cause the resulting *
+ * executable to be covered by the GNU General Public License. This except- *
+ * ion does not  however invalidate  any other reasons  why the  executable *
+ * file might be covered by the  GNU Public License.                        *
+ *                                                                          *
+ * GNAT was originally developed  by the GNAT team at  New York University. *
+ * It is now maintained by Ada Core Technologies Inc (http://www.gnat.com). *
+ *                                                                          *
+ ****************************************************************************/
+
+/*  This file contains those routines named by Import pragmas in package    */
+/*  GNAT.Calendar. It is used to to Duration to timeval convertion.         */
+/*  These are simple wrappers function to abstarct the fact that the C      */
+/*  struct timeval fields type are not normalized (they are generaly        */
+/*  defined as int or long values).                                         */
+
+#if defined(VMS)
+
+/* this is temporary code to avoid build failure under VMS */
+
+void
+__gnat_timeval_to_duration (void *t, long *sec, long *usec)
+{
+}
+
+void
+__gnat_duration_to_timeval (long sec, long usec, void *t)
+{
+}
+
+#else
+
+#if defined (__vxworks)
+#include <sys/times.h>
+#else
+#include <sys/time.h>
+#endif
+
+void
+__gnat_timeval_to_duration (struct timeval *t, long *sec, long *usec)
+{
+  *sec  = (long) t->tv_sec;
+  *usec = (long) t->tv_usec;
+}
+
+void
+__gnat_duration_to_timeval (long sec, long usec, struct timeval *t)
+{
+  /* here we are doing implicit convertion from a long to the struct timeval
+     fields types. */
+
+  t->tv_sec = sec;
+  t->tv_usec = usec;
+}
+#endif
+
+#ifdef __alpha_vxworks
+#include "vxWorks.h"
+#elif defined (__vxworks)
+#include <types/vxTypesOld.h>
+#endif
+
+/* Return the value of the "time" C library function.  We always return
+   a long and do it this way to avoid problems with not knowing
+   what time_t is on the target.  */
+
+long
+gnat_time ()
+{
+  return time (0);
+}

gcc/ada/calendar.ads

+------------------------------------------------------------------------------
+--                                                                          --
+--                         GNAT RUNTIME COMPONENTS                          --
+--                                                                          --
+--                             C A L E N D A R                              --
+--                                                                          --
+--                                 S p e c                                  --
+--                                                                          --
+--                            $Revision: 1.6 $                              --
+--                                                                          --
+-- This specification is adapted from the Ada Reference Manual for use with --
+-- GNAT.  In accordance with the copyright of that document, you can freely --
+-- copy and modify this specification,  provided that if you redistribute a --
+-- modified version,  any changes that you have made are clearly indicated. --
+--                                                                          --
+------------------------------------------------------------------------------
+
+with Ada.Calendar;
+
+package Calendar renames Ada.Calendar;

gcc/ada/casing.adb

+------------------------------------------------------------------------------
+--                                                                          --
+--                         GNAT COMPILER COMPONENTS                         --
+--                                                                          --
+--                               C A S I N G                                --
+--                                                                          --
+--                                 B o d y                                  --
+--                                                                          --
+--                            $Revision: 1.23 $
+--                                                                          --
+--          Copyright (C) 1992-2001 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 2,  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 COPYING.  If not, write --
+-- to  the Free Software Foundation,  59 Temple Place - Suite 330,  Boston, --
+-- MA 02111-1307, USA.                                                      --
+--                                                                          --
+-- As a special exception,  if other files  instantiate  generics from this --
+-- unit, or you link  this unit with other files  to produce an executable, --
+-- this  unit  does not  by itself cause  the resulting  executable  to  be --
+-- covered  by the  GNU  General  Public  License.  This exception does not --
+-- however invalidate  any other reasons why  the executable file  might be --
+-- covered by the  GNU Public License.                                      --
+--                                                                          --
+-- GNAT was originally developed  by the GNAT team at  New York University. --
+-- It is now maintained by Ada Core Technologies Inc (http://www.gnat.com). --
+--                                                                          --
+------------------------------------------------------------------------------
+
+with Csets;    use Csets;
+with Namet;    use Namet;
+with Opt;      use Opt;
+with Types;    use Types;
+with Widechar; use Widechar;
+
+package body Casing is
+
+   ----------------------
+   -- Determine_Casing --
+   ----------------------
+
+   function Determine_Casing (Ident : Text_Buffer) return Casing_Type is
+
+      All_Lower : Boolean := True;
+      --  Set False if upper case letter found
+
+      All_Upper : Boolean := True;
+      --  Set False if lower case letter found
+
+      Mixed : Boolean := True;
+      --  Set False if exception to mixed case rule found (lower case letter
+      --  at start or after underline, or upper case letter elsewhere).
+
+      Decisive : Boolean := False;
+      --  Set True if at least one instance of letter not after underline
+
+      After_Und : Boolean := True;
+      --  True at start of string, and after an underline character
+
+   begin
+      for S in Ident'Range loop
+         if Ident (S) = '_' or else Ident (S) = '.' then
+            After_Und := True;
+
+         elsif Is_Lower_Case_Letter (Ident (S)) then
+            All_Upper := False;
+
+            if not After_Und then
+               Decisive := True;
+            else
+               After_Und := False;
+               Mixed := False;
+            end if;
+
+         elsif Is_Upper_Case_Letter (Ident (S)) then
+            All_Lower := False;
+
+            if not After_Und then
+               Decisive := True;
+               Mixed := False;
+            else
+               After_Und := False;
+            end if;
+         end if;
+      end loop;
+
+      --  Now we can figure out the result from the flags we set in that loop
+
+      if All_Lower then
+         return All_Lower_Case;
+
+      elsif not Decisive then
+         return Unknown;
+
+      elsif All_Upper then
+         return All_Upper_Case;
+
+      elsif Mixed then
+         return Mixed_Case;
+
+      else
+         return Unknown;
+      end if;
+   end Determine_Casing;
+
+   ------------------------
+   -- Set_All_Upper_Case --
+   ------------------------
+
+   procedure Set_All_Upper_Case is
+   begin
+      Set_Casing (All_Upper_Case);
+   end Set_All_Upper_Case;
+
+   ----------------
+   -- Set_Casing --
+   ----------------
+
+   procedure Set_Casing (C : Casing_Type; D : Casing_Type := Mixed_Case) is
+      Ptr : Natural;
+
+      Actual_Casing : Casing_Type;
+      --  Set from C or D as appropriate
+
+      After_Und : Boolean := True;
+      --  True at start of string, and after an underline character or after
+      --  any other special character that is not a normal identifier char).
+
+   begin
+      if C /= Unknown then
+         Actual_Casing := C;
+      else
+         Actual_Casing := D;
+      end if;
+
+      Ptr := 1;
+
+      while Ptr <= Name_Len loop
+         if Name_Buffer (Ptr) = ASCII.ESC
+           or else Name_Buffer (Ptr) = '['
+           or else (Upper_Half_Encoding
+                     and then Name_Buffer (Ptr) in Upper_Half_Character)
+         then
+            Skip_Wide (Name_Buffer, Ptr);
+            After_Und := False;
+
+         elsif Name_Buffer (Ptr) = '_'
+            or else not Identifier_Char (Name_Buffer (Ptr))
+         then
+            After_Und := True;
+            Ptr := Ptr + 1;
+
+         elsif Is_Lower_Case_Letter (Name_Buffer (Ptr)) then
+            if Actual_Casing = All_Upper_Case
+              or else (After_Und and then Actual_Casing = Mixed_Case)
+            then
+               Name_Buffer (Ptr) := Fold_Upper (Name_Buffer (Ptr));
+            end if;
+
+            After_Und := False;
+            Ptr := Ptr + 1;
+
+         elsif Is_Upper_Case_Letter (Name_Buffer (Ptr)) then
+            if Actual_Casing = All_Lower_Case
+              or else (not After_Und and then Actual_Casing = Mixed_Case)
+            then
+               Name_Buffer (Ptr) := Fold_Lower (Name_Buffer (Ptr));
+            end if;
+
+            After_Und := False;
+            Ptr := Ptr + 1;
+
+         else  --  all other characters
+            After_Und := False;
+            Ptr := Ptr + 1;
+         end if;
+      end loop;
+   end Set_Casing;
+
+end Casing;

gcc/ada/casing.ads

+------------------------------------------------------------------------------
+--                                                                          --
+--                         GNAT COMPILER COMPONENTS                         --
+--                                                                          --
+--                               C A S I N G                                --
+--                                                                          --
+--                                 S p e c                                  --
+--                                                                          --
+--                            $Revision: 1.12 $
+--                                                                          --
+--          Copyright (C) 1992-2000 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 2,  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 COPYING.  If not, write --
+-- to  the Free Software Foundation,  59 Temple Place - Suite 330,  Boston, --
+-- MA 02111-1307, USA.                                                      --
+--                                                                          --
+-- As a special exception,  if other files  instantiate  generics from this --
+-- unit, or you link  this unit with other files  to produce an executable, --
+-- this  unit  does not  by itself cause  the resulting  executable  to  be --
+-- covered  by the  GNU  General  Public  License.  This exception does not --
+-- however invalidate  any other reasons why  the executable file  might be --
+-- covered by the  GNU Public License.                                      --
+--                                                                          --
+-- GNAT was originally developed  by the GNAT team at  New York University. --
+-- It is now maintained by Ada Core Technologies Inc (http://www.gnat.com). --
+--                                                                          --
+------------------------------------------------------------------------------
+
+with Types; use Types;
+
+package Casing is
+
+   --  This package contains data and subprograms to support the feature that
+   --  recognizes the letter case styles used in the source program being
+   --  compiled, and uses this information for error message formatting, and
+   --  for recognizing reserved words that are misused as identifiers.
+
+   -------------------------------
+   -- Case Control Declarations --
+   -------------------------------
+
+   --  Declaration of type for describing casing convention
+
+   type Casing_Type is (
+
+      All_Upper_Case,
+      --  All letters are upper case
+
+      All_Lower_Case,
+      --  All letters are lower case
+
+      Mixed_Case,
+      --  The initial letter, and any letters after underlines are upper case.
+      --  All other letters are lower case
+
+      Unknown
+      --  Used if an identifier does not distinguish between the above cases,
+      --  (e.g. X, Y_3, M4, A_B, or if it is inconsistent ABC_def).
+   );
+
+   ------------------------------
+   -- Case Control Subprograms --
+   ------------------------------
+
+   procedure Set_Casing (C : Casing_Type; D : Casing_Type := Mixed_Case);
+   --  Takes the name stored in the first Name_Len positions of Name_Buffer
+   --  and modifies it to be consistent with the casing given by C, or if
+   --  C = Unknown, then with the casing given by D. The name is basically
+   --  treated as an identifier, except that special separator characters
+   --  other than underline are permitted and treated like underlines (this
+   --  handles cases like minus and period in unit names, apostrophes in error
+   --  messages, angle brackets in names like <any_type>, etc).
+
+   procedure Set_All_Upper_Case;
+   pragma Inline (Set_All_Upper_Case);
+   --  This procedure is called with an identifier name stored in Name_Buffer.
+   --  On return, the identifier is converted to all upper case. The call is
+   --  equivalent to Set_Casing (All_Upper_Case).
+
+   function Determine_Casing (Ident : Text_Buffer) return Casing_Type;
+   --  Determines the casing of the identifier/keyword string Ident
+
+end Casing;

gcc/ada/cio.c

+/****************************************************************************
+ *                                                                          *
+ *                         GNAT COMPILER COMPONENTS                         *
+ *                                                                          *
+ *                                  C I O                                   *
+ *                                                                          *
+ *                          C Implementation File                           *
+ *                                                                          *
+ *                            $Revision: 1.2 $
+ *                                                                          *
+ *          Copyright (C) 1992-2001 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 2,  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 COPYING.  If not, write *
+ * to  the Free Software Foundation,  59 Temple Place - Suite 330,  Boston, *
+ * MA 02111-1307, USA.                                                      *
+ *                                                                          *
+ * As a  special  exception,  if you  link  this file  with other  files to *
+ * produce an executable,  this file does not by itself cause the resulting *
+ * executable to be covered by the GNU General Public License. This except- *
+ * ion does not  however invalidate  any other reasons  why the  executable *
+ * file might be covered by the  GNU Public License.                        *
+ *                                                                          *
+ * GNAT was originally developed  by the GNAT team at  New York University. *
+ * It is now maintained by Ada Core Technologies Inc (http://www.gnat.com). *
+ *                                                                          *
+ ****************************************************************************/
+
+#ifdef IN_RTS
+#include "tconfig.h"
+#include "tsystem.h"
+#include <sys/stat.h>
+#else
+#include "config.h"
+#include "system.h"
+#endif
+
+#include "adaint.h"
+
+#ifdef __RT__
+
+/* Linux kernel modules don't have inputs, so don't define get_int.
+   Simple output can be done via printk. */
+
+void
+put_char (c)
+     int c;
+{
+  printk ("%c", c);
+}
+
+void
+put_char_stderr (c)
+     int c;
+{
+  put_char (c);
+}
+
+void
+put_int (x)
+     int x;
+{
+  printk ("%d", x);
+}
+
+void
+put_int_stderr (int x)
+{
+  put_int (x);
+}
+
+#else
+
+/* Don't use macros on linux since they cause incompatible changes between
+   glibc 2.0 and 2.1 */
+#ifdef linux
+#undef putchar
+#undef getchar
+#undef fputc
+#undef stderr
+#endif
+
+int
+get_char ()
+{
+#ifdef VMS
+  return decc$getchar();
+#else
+  return getchar ();
+#endif
+}
+
+int
+get_int ()
+{
+  int x;
+
+  scanf (" %d", &x);
+  return x;
+}
+
+void
+put_int (x)
+     int x;
+{
+  printf ("%d", x);
+}
+
+void
+put_int_stderr (x)
+   int x;
+{
+  fprintf (stderr, "%d", x);
+}
+
+void
+put_char (c)
+     int c;
+{
+  putchar (c);
+}
+
+void
+put_char_stderr (c)
+     int c;
+{
+  fputc (c, stderr);
+}
+#endif
+
+#ifdef __vxworks
+
+char *
+mktemp (template)
+     char *template;
+{
+  return tmpnam (NULL);
+}
+#endif

gcc/ada/comperr.ads

+------------------------------------------------------------------------------
+--                                                                          --
+--                         GNAT COMPILER COMPONENTS                         --
+--                                                                          --
+--                              C O M P E R R                               --
+--                                                                          --
+--                                 S p e c                                  --
+--                                                                          --
+--                            $Revision: 1.18 $
+--                                                                          --
+--          Copyright (C) 1992-2000 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 2,  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 COPYING.  If not, write --
+-- to  the Free Software Foundation,  59 Temple Place - Suite 330,  Boston, --
+-- MA 02111-1307, USA.                                                      --
+--                                                                          --
+-- GNAT was originally developed  by the GNAT team at  New York University. --
+-- It is now maintained by Ada Core Technologies Inc (http://www.gnat.com). --
+--                                                                          --
+------------------------------------------------------------------------------
+
+--  This package contains the routine called when a fatal internal compiler
+--  error is detected. Calls to this routines cause termination of the
+--  current compilation with appropriate error output.
+
+package Comperr is
+
+   procedure Compiler_Abort
+     (X    : String;
+      Code : Integer := 0);
+   --  Signals an internal compiler error. Never returns control. Depending
+   --  on processing may end up raising Unrecoverable_Error, or exiting
+   --  directly. The message output is a "bug box" containing the
+   --  string passed as an argument. The node in Current_Error_Node is used
+   --  to provide the location where the error should be signalled. The
+   --  message includes the node id, and the code parameter if it is positive.
+   --  Note that this is only used at the outer level (to handle constraint
+   --  errors or assert errors etc.) In the normal logic of the compiler we
+   --  always use pragma Assert to check for errors, and if necessary an
+   --  explicit abort is achieved by pragma Assert (False). Code is positive
+   --  for a gigi abort (giving the gigi abort code), zero for a front
+   --  end exception (with possible message stored in TSD.Current_Excep,
+   --  and negative (an unused value) for a GCC abort.
+
+   ------------------------------
+   -- Use of gnat_bug.box File --
+   ------------------------------
+
+   --  When comperr generates the "bug box". The first two lines contain
+   --  information on the version number, type of abort, and source location.
+
+   --  Normally the remaining text is one of the following two forms
+   --  depending on the version number (p identifies public versions):
+
+   --    Please submit bug report by email to report@gnat.com.
+   --    Use a subject line meaningful to you and us to track the bug.
+   --    (include your customer number #nnn in the subject line).
+   --    Include the entire contents of this bug box in the report.
+   --    Include the exact gcc or gnatmake command that you entered.
+   --    Also include sources listed below in gnatchop format
+   --    (concatenated together with no headers between files).
+   --    (use plain ASCII or MIME attachment,
+   --    or FTP to your customer directory).
+   --    See README.GNATPRO for full info on procedure for submitting bugs.
+
+   --  or (public version case)
+
+   --    Please submit bug report by email to report@gnat.com.
+   --    Use a subject line meaningful to you and us to track the bug.
+   --    (include your customer number #nnn in the subject line).
+   --    Include the entire contents of this bug box in the report.
+   --    Include the exact gcc or gnatmake command that you entered.
+   --    Also include sources listed below in gnatchop format
+   --    (concatenated together with no headers between files).
+   --    See gnatinfo.txt for full info on procedure for submitting bugs.
+
+   --  However, an alternative mechanism exists for easily substituting
+   --  different text for this message. Compiler_Abort checks for the
+   --  existence of the file "gnat_bug.box" in the current source path.
+   --  Most typically this file, if present, will be in the directory
+   --  containing the run-time sources.
+
+   --  If this file is present, then it is a plain ASCII file, whose
+   --  contents replace the above quoted paragraphs. The lines in this
+   --  file should be 72 characters or less to avoid misformatting the
+   --  right boundary of the box. Note that the file does not contain
+   --  the vertical bar characters or any leading spaces in lines.
+
+end Comperr;

gcc/ada/config-lang.in

+# Top level configure fragment for GNU Ada (GNAT).
+#   Copyright (C) 1994 Free Software Foundation, Inc.
+
+#This file is part of GNU CC.
+
+#GNU CC is free software; you can redistribute it and/or modify
+#it under the terms of the GNU General Public License as published by
+#the Free Software Foundation; either version 2, or (at your option)
+#any later version.
+
+#GNU CC is distributed in the hope that it will be useful,
+#but WITHOUT 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
+#along with GNU CC; see the file COPYING.  If not, write to
+#the Free Software Foundation, 675 Mass Ave, Cambridge, MA 02139, USA.
+
+# Configure looks for the existence of this file to auto-config each language.
+# We define several parameters used by configure:
+#
+# language	- name of language as it would appear in $(LANGUAGES)
+# boot_language - "yes" if we need to build this language in stage1
+# compilers	- value to add to $(COMPILERS)
+# stagestuff	- files to add to $(STAGESTUFF)
+# diff_excludes	- files to ignore when building diffs between two versions.
+
+language="ada"
+boot_language=yes
+boot_language_boot_flags='ADAFLAGS="$(BOOT_ADAFLAGS)"'
+
+compilers="gnat1\$(exeext)"
+
+stagestuff="gnatbind\$(exeext) gnat1\$(exeext)"
+
+diff_excludes="-x ada/a-einfo.h -x ada/a-sinfo.h -x ada/nmake.adb -x ada/nmake.ads -x ada/treeprs.ads -x ada/sysid.ads"
+
+outputs=ada/Makefile

gcc/ada/csets.ads

+------------------------------------------------------------------------------
+--                                                                          --
+--                         GNAT COMPILER COMPONENTS                         --
+--                                                                          --
+--                                C S E T S                                 --
+--                                                                          --
+--                                 S p e c                                  --
+--                                                                          --
+--                            $Revision: 1.16 $                             --
+--                                                                          --
+--          Copyright (C) 1992-1997 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 2,  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 COPYING.  If not, write --
+-- to  the Free Software Foundation,  59 Temple Place - Suite 330,  Boston, --
+-- MA 02111-1307, USA.                                                      --
+--                                                                          --
+-- As a special exception,  if other files  instantiate  generics from this --
+-- unit, or you link  this unit with other files  to produce an executable, --
+-- this  unit  does not  by itself cause  the resulting  executable  to  be --
+-- covered  by the  GNU  General  Public  License.  This exception does not --
+-- however invalidate  any other reasons why  the executable file  might be --
+-- covered by the  GNU Public License.                                      --
+--                                                                          --
+-- GNAT was originally developed  by the GNAT team at  New York University. --
+-- It is now maintained by Ada Core Technologies Inc (http://www.gnat.com). --
+--                                                                          --
+------------------------------------------------------------------------------
+
+package Csets is
+pragma Elaborate_Body (Csets);
+
+   --  This package contains character tables for the various character
+   --  sets that are supported for source representation. Character and
+   --  string literals are not affected, only identifiers. For each set,
+   --  the table in this package gives the mapping of letters to their
+   --  upper case equivalent. Each table thus provides the information
+   --  for building the table used to fold lower case to upper case, and
+   --  also the table of flags showing which characters are allowed in
+   --  identifiers.
+
+   type Translate_Table is array (Character) of Character;
+   --  Type used to describe translate tables
+
+   type Char_Array_Flags is array (Character) of Boolean;
+   --  Type used for character attribute arrays. Note that we deliberately
+   --  do NOT pack this table, since we don't want the extra overhead of
+   --  accessing a packed bit string.
+
+   -----------------------------------------------
+   --  Character Tables For Current Compilation --
+   -----------------------------------------------
+
+   procedure Initialize;
+   --  Routine to initialize following character tables, whose content depends
+   --  on the character code being used to represent the source program. In
+   --  particular, the use of the upper half of the 8-bit code set varies.
+   --  The character set in use is specified by the value stored in
+   --  Opt.Identifier_Character_Set, which has the following settings:
+
+   --    '1'  Latin-1
+   --    '2'  Latin-2
+   --    '3'  Latin-3
+   --    '4'  Latin-4
+   --    'p'  IBM PC (code page 437)
+   --    '8'  IBM PC (code page 850)
+   --    'f'  Full upper set (all distinct)
+   --    'n'  No upper characters (Ada/83 rules)
+   --    'w'  Latin-1 plus wide characters also allowed
+
+   function Is_Upper_Case_Letter (C : Character) return Boolean;
+   pragma Inline (Is_Upper_Case_Letter);
+   --  Determine if character is upper case letter
+
+   function Is_Lower_Case_Letter (C : Character) return Boolean;
+   pragma Inline (Is_Lower_Case_Letter);
+   --  Determine if character is lower case letter
+
+   Fold_Upper : Translate_Table;
+   --  Table to fold lower case identifier letters to upper case
+
+   Fold_Lower : Translate_Table;
+   --  Table to fold upper case identifier letters to lower case
+
+   Identifier_Char : Char_Array_Flags;
+   --  This table has True entries for all characters that can legally appear
+   --  in identifiers, including digits, the underline character, all letters
+   --  including upper and lower case and extended letters (as controlled by
+   --  the setting of Opt.Identifier_Character_Set, left bracket for brackets
+   --  notation wide characters and also ESC if wide characters are permitted
+   --  in identifiers using escape sequences starting with ESC.
+
+end Csets;

gcc/ada/cstand.ads

+------------------------------------------------------------------------------
+--                                                                          --
+--                         GNAT COMPILER COMPONENTS                         --
+--                                                                          --
+--                               C S T A N D                                --
+--                                                                          --
+--                                 S p e c                                  --
+--                                                                          --
+--                            $Revision: 1.4 $
+--                                                                          --
+--          Copyright (C) 1992-2000 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 2,  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 COPYING.  If not, write --
+-- to  the Free Software Foundation,  59 Temple Place - Suite 330,  Boston, --
+-- MA 02111-1307, USA.                                                      --
+--                                                                          --
+-- GNAT was originally developed  by the GNAT team at  New York University. --
+-- It is now maintained by Ada Core Technologies Inc (http://www.gnat.com). --
+--                                                                          --
+------------------------------------------------------------------------------
+
+--  This package contains the procedure that is used to create the tree for
+--  package Standard and initialize the entities in package Stand.
+
+with Types; use Types;
+
+package CStand is
+
+   procedure Create_Standard;
+   --  This procedure creates the tree for package standard, and initializes
+   --  the Standard_Entities array and Standard_Package_Node. First the
+   --  syntactic representation is created (as though the parser had parsed
+   --  a copy of the source of Standard) and then semantic information is
+   --  added as it would be by the semantic phases of the compiler. The
+   --  tree is in the standard format defined by Syntax_Info, except that
+   --  all Sloc values are set to Standard_Location except for nodes that
+   --  are part of package ASCII, which have Sloc = Standard_ASCII_Location.
+   --  The semantics info is in the format given by Entity_Info. The global
+   --  variables Last_Standard_Node_Id and Last_Standard_List_Id are also set.
+
+   procedure Set_Float_Bounds (Id  : Entity_Id);
+   --  Procedure to set bounds for float type or subtype. Id is the entity
+   --  whose bounds and type are to be set (a floating-point type).
+
+end CStand;

gcc/ada/cstreams.c

+/****************************************************************************
+ *                                                                          *
+ *                          GNAT RUN-TIME COMPONENTS                        *
+ *                                                                          *
+ *                              C S T R E A M S                             *
+ *                                                                          *
+ *              Auxiliary C functions for Interfaces.C.Streams              *
+ *                                                                          *
+ *                              $Revision: 1.1 $
+ *                                                                          *
+ *          Copyright (C) 1992-2001 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 2,  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 COPYING.  If not, write *
+ * to  the Free Software Foundation,  59 Temple Place - Suite 330,  Boston, *
+ * MA 02111-1307, USA.                                                      *
+ *                                                                          *
+ * As a  special  exception,  if you  link  this file  with other  files to *
+ * produce an executable,  this file does not by itself cause the resulting *
+ * executable to be covered by the GNU General Public License. This except- *
+ * ion does not  however invalidate  any other reasons  why the  executable *
+ * file might be covered by the  GNU Public License.                        *
+ *                                                                          *
+ * GNAT was originally developed  by the GNAT team at  New York University. *
+ * It is now maintained by Ada Core Technologies Inc (http://www.gnat.com). *
+ *                                                                          *
+ ****************************************************************************/
+
+/* Routines required for implementing routines in Interfaces.C.Streams */
+
+#ifdef __vxworks
+#include "vxWorks.h"
+#endif
+
+#ifdef IN_RTS
+#include "tconfig.h"
+#include "tsystem.h"
+#include <sys/stat.h>
+#else
+#include "config.h"
+#include "system.h"
+#endif
+
+#include "adaint.h"
+
+#ifdef __EMX__
+int max_path_len = _MAX_PATH;
+#elif defined (VMS)
+#include <unixlib.h>
+int max_path_len = 255; /* PATH_MAX */
+
+#elif defined (__vxworks) || defined (__OPENNT)
+
+int max_path_len = PATH_MAX;
+
+#else
+
+#ifdef linux
+
+/* Don't use macros on linux since they cause incompatible changes between
+   glibc 2.0 and 2.1 */
+
+#ifdef stderr
+#  undef stderr
+#endif
+#ifdef stdin
+#  undef stdin
+#endif
+#ifdef stdout
+#  undef stdout
+#endif
+
+#endif
+
+#include <sys/param.h>
+
+int max_path_len = MAXPATHLEN;
+#endif
+
+/* The _IONBF value in CYGNUS or MINGW32 stdio.h is wrong.  */
+#if defined (WINNT) || defined (_WINNT)
+#undef _IONBF
+#define _IONBF 0004
+#endif
+
+
+int
+__gnat_feof (stream)
+     FILE *stream;
+{
+  return (feof (stream));
+}
+
+int
+__gnat_ferror (stream)
+     FILE *stream;
+{
+   return (ferror (stream));
+}
+
+int
+__gnat_fileno (stream)
+     FILE *stream;
+{
+   return (fileno (stream));
+}
+
+int
+__gnat_is_regular_file_fd (fd)
+     int fd;
+{
+  int ret;
+  struct stat statbuf;
+
+#ifdef __EMX__
+  /* Programs using screen I/O may need to reset the FPU after
+     initialization of screen-handling related DLL's, so force
+     DLL initialization by doing a null-write and then reset the FPU */
+
+  DosWrite (0, &ret, 0, &ret);
+  __gnat_init_float();
+#endif
+
+  ret = fstat (fd, &statbuf);
+  return (!ret && S_ISREG (statbuf.st_mode));
+}
+
+/* on some systems, the constants for seek are not defined, if so, then
+   provide the conventional definitions */
+
+#ifndef SEEK_SET
+#define SEEK_SET 0  /* Set file pointer to offset                           */
+#define SEEK_CUR 1  /* Set file pointer to its current value plus offset    */
+#define SEEK_END 2  /* Set file pointer to the size of the file plus offset */
+#endif
+
+/* if L_tmpnam is not set, use a large number that should be safe */
+#ifndef L_tmpnam
+#define L_tmpnam 256
+#endif
+
+int    __gnat_constant_eof      = EOF;
+int    __gnat_constant_iofbf    = _IOFBF;
+int    __gnat_constant_iolbf    = _IOLBF;
+int    __gnat_constant_ionbf    = _IONBF;
+int    __gnat_constant_l_tmpnam = L_tmpnam;
+int    __gnat_constant_seek_cur = SEEK_CUR;
+int    __gnat_constant_seek_end = SEEK_END;
+int    __gnat_constant_seek_set = SEEK_SET;
+
+FILE *
+__gnat_constant_stderr ()
+{
+  return stderr;
+}
+
+FILE *
+__gnat_constant_stdin ()
+{
+  return stdin;
+}
+
+FILE *
+__gnat_constant_stdout ()
+{
+  return stdout;
+}
+
+char *
+__gnat_full_name (nam, buffer)
+     char *nam;
+     char *buffer;
+{
+  char *p;
+
+#if defined(__EMX__) || defined (__MINGW32__)
+  /* If this is a device file return it as is; under Windows NT and
+     OS/2 a device file end with ":".  */
+  if (nam [strlen (nam) - 1] == ':')
+    strcpy (buffer, nam);
+  else
+    {
+      _fullpath (buffer, nam, max_path_len);
+
+      for (p = buffer; *p; p++)
+	if (*p == '/')
+	  *p = '\\';
+    }
+
+#elif defined (MSDOS)
+  _fixpath (nam, buffer);
+
+#elif defined (sgi)
+
+  /* Use realpath function which resolves links and references to .. and ..
+     on those Unix systems that support it. Note that linux provides it but
+     cannot handle more than 5 symbolic links in a full name, so we use the
+     getcwd approach instead. */
+  realpath (nam, buffer);
+
+#elif defined (VMS)
+  strcpy (buffer, __gnat_to_canonical_file_spec (nam));
+
+  if (buffer[0] == '/')
+    strcpy (buffer, __gnat_to_host_file_spec (buffer));
+  else
+    {
+      char nambuffer [MAXPATHLEN];
+
+      strcpy (nambuffer, buffer);
+      strcpy (buffer, getcwd (buffer, max_path_len, 0));
+      strcat (buffer, "/");
+      strcat (buffer, nambuffer);
+      strcpy (buffer, __gnat_to_host_file_spec (buffer));
+    }
+
+  return buffer;
+
+#else
+  if (nam[0] != '/')
+    {
+      p = getcwd (buffer, max_path_len);
+      if (p == 0)
+	{
+	  buffer[0] = '\0';
+	  return 0;
+	}
+
+      /* If the name returned is an absolute path, it is safe to append '/'
+	 to the path and concatenate the name of the file. */
+      if (buffer[0] == '/')
+	strcat (buffer, "/");
+
+      strcat (buffer, nam);
+    }
+  else
+    strcpy (buffer, nam);
+
+  return buffer;
+#endif
+}

gcc/ada/cuintp.c

+/****************************************************************************
+ *                                                                          *
+ *                        GNAT COMPILER COMPONENTS                          *
+ *                                                                          *
+ *                               C U I N T P                                *
+ *                                                                          *
+ *                          C Implementation File                           *
+ *                                                                          *
+ *                            $Revision: 1.1 $
+ *                                                                          *
+ *          Copyright (C) 1992-2001 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 2,  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 COPYING.  If not, write *
+ * to  the Free Software Foundation,  59 Temple Place - Suite 330,  Boston, *
+ * MA 02111-1307, USA.                                                      *
+ *                                                                          *
+ * GNAT was originally developed  by the GNAT team at  New York University. *
+ * It is now maintained by Ada Core Technologies Inc (http://www.gnat.com). *
+ *                                                                          *
+ ****************************************************************************/
+
+/* This file corresponds to the Ada package body Uintp. It was created
+   manually from the files uintp.ads and uintp.adb. */
+
+#include "config.h"
+#include "system.h"
+#include "tree.h"
+#include "ada.h"
+#include "types.h"
+#include "uintp.h"
+#include "atree.h"
+#include "elists.h"
+#include "nlists.h"
+#include "stringt.h"
+#include "fe.h"
+#include "gigi.h"
+
+/* Universal integers are represented by the Uint type which is an index into
+   the Uints_Ptr table containing Uint_Entry values.  A Uint_Entry contains an
+   index and length for getting the "digits" of the universal integer from the
+   Udigits_Ptr table.
+
+   For efficiency, this method is used only for integer values larger than the
+   constant Uint_Bias.  If a Uint is less than this constant, then it contains
+   the integer value itself.  The origin of the Uints_Ptr table is adjusted so
+   that a Uint value of Uint_Bias indexes the first element.  */
+
+/* Similarly to UI_To_Int, but return a GCC INTEGER_CST.  Overflow is tested
+   by the constant-folding used to build the node.  TYPE is the GCC type of the
+   resulting node.  */
+
+tree
+UI_To_gnu (Input, type)
+     Uint Input;
+     tree type;
+{
+  tree gnu_ret;
+
+  if (Input <= Uint_Direct_Last)
+    gnu_ret = convert (type, build_int_2 (Input - Uint_Direct_Bias, 
+					  Input < Uint_Direct_Bias ? -1 : 0));
+  else
+    {
+      Int Idx =    Uints_Ptr[Input].Loc;
+      Pos Length = Uints_Ptr[Input].Length;
+      Int First = Udigits_Ptr[Idx];
+      /* Do computations in integer type or TYPE whichever is wider, then
+	 convert later.  This avoid overflow if type is short integer.  */
+      tree comp_type
+	= (TYPE_PRECISION (type) >= TYPE_PRECISION (integer_type_node)
+	   ? type : integer_type_node);
+      tree gnu_base = convert (comp_type, build_int_2 (Base, 0));
+
+      if (Length <= 0)
+	gigi_abort (601);
+
+      gnu_ret = convert (comp_type, build_int_2 (First, First < 0 ? -1 : 0));
+      if (First < 0)
+	for (Idx++, Length--; Length; Idx++, Length--)
+	  gnu_ret = fold (build (MINUS_EXPR, comp_type,
+				 fold (build (MULT_EXPR, comp_type,
+					      gnu_ret, gnu_base)),
+				 convert (comp_type,
+					  build_int_2 (Udigits_Ptr[Idx], 0))));
+      else
+	for (Idx++, Length--; Length; Idx++, Length--)
+	  gnu_ret = fold (build (PLUS_EXPR, comp_type,
+				 fold (build (MULT_EXPR, comp_type,
+					      gnu_ret, gnu_base)),
+				 convert (comp_type,
+					  build_int_2 (Udigits_Ptr[Idx], 0))));
+    }
+
+  gnu_ret = convert (type, gnu_ret);
+
+  /* We don't need any NOP_EXPR or NON_LVALUE_EXPR on GNU_RET.  */
+  while ((TREE_CODE (gnu_ret) == NOP_EXPR
+	  || TREE_CODE (gnu_ret) == NON_LVALUE_EXPR)
+	 && TREE_TYPE (TREE_OPERAND (gnu_ret, 0)) == TREE_TYPE (gnu_ret))
+    gnu_ret = TREE_OPERAND (gnu_ret, 0);
+
+  return gnu_ret;
+}

gcc/ada/debug.ads

+------------------------------------------------------------------------------
+--                                                                          --
+--                         GNAT COMPILER COMPONENTS                         --
+--                                                                          --
+--                                D E B U G                                 --
+--                                                                          --
+--                                 S p e c                                  --
+--                                                                          --
+--                            $Revision: 1.31 $
+--                                                                          --
+--          Copyright (C) 1992-1999 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 2,  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 COPYING.  If not, write --
+-- to  the Free Software Foundation,  59 Temple Place - Suite 330,  Boston, --
+-- MA 02111-1307, USA.                                                      --
+--                                                                          --
+-- As a special exception,  if other files  instantiate  generics from this --
+-- unit, or you link  this unit with other files  to produce an executable, --
+-- this  unit  does not  by itself cause  the resulting  executable  to  be --
+-- covered  by the  GNU  General  Public  License.  This exception does not --
+-- however invalidate  any other reasons why  the executable file  might be --
+-- covered by the  GNU Public License.                                      --
+--                                                                          --
+-- GNAT was originally developed  by the GNAT team at  New York University. --
+-- It is now maintained by Ada Core Technologies Inc (http://www.gnat.com). --
+--                                                                          --
+------------------------------------------------------------------------------
+
+package Debug is
+pragma Preelaborate (Debug);
+
+--  This package contains global flags used to control the inclusion
+--  of debugging code in various phases of the compiler.
+
+   -------------------------
+   -- Dynamic Debug Flags --
+   -------------------------
+
+   --  Thirty six flags that can be used to active various specialized
+   --  debugging output information. The flags are preset to False, which
+   --  corresponds to the given output being suppressed. The individual
+   --  flags can be turned on using the undocumented switch /dxxx where
+   --  xxx is a string of letters for flags to be turned on. Documentation
+   --  on the current usage of these flags is contained in the body of Debug
+   --  rather than the spec, so that we don't have to recompile the world
+   --  when a new debug flag is added
+
+   Debug_Flag_A : Boolean := False;
+   Debug_Flag_B : Boolean := False;
+   Debug_Flag_C : Boolean := False;
+   Debug_Flag_D : Boolean := False;
+   Debug_Flag_E : Boolean := False;
+   Debug_Flag_F : Boolean := False;
+   Debug_Flag_G : Boolean := False;
+   Debug_Flag_H : Boolean := False;
+   Debug_Flag_I : Boolean := False;
+   Debug_Flag_J : Boolean := False;
+   Debug_Flag_K : Boolean := False;
+   Debug_Flag_L : Boolean := False;
+   Debug_Flag_M : Boolean := False;
+   Debug_Flag_N : Boolean := False;
+   Debug_Flag_O : Boolean := False;
+   Debug_Flag_P : Boolean := False;
+   Debug_Flag_Q : Boolean := False;
+   Debug_Flag_R : Boolean := False;
+   Debug_Flag_S : Boolean := False;
+   Debug_Flag_T : Boolean := False;
+   Debug_Flag_U : Boolean := False;
+   Debug_Flag_V : Boolean := False;
+   Debug_Flag_W : Boolean := False;
+   Debug_Flag_X : Boolean := False;
+   Debug_Flag_Y : Boolean := False;
+   Debug_Flag_Z : Boolean := False;
+
+   Debug_Flag_AA : Boolean := False;
+   Debug_Flag_BB : Boolean := False;
+   Debug_Flag_CC : Boolean := False;
+   Debug_Flag_DD : Boolean := False;
+   Debug_Flag_EE : Boolean := False;
+   Debug_Flag_FF : Boolean := False;
+   Debug_Flag_GG : Boolean := False;
+   Debug_Flag_HH : Boolean := False;
+   Debug_Flag_II : Boolean := False;
+   Debug_Flag_JJ : Boolean := False;
+   Debug_Flag_KK : Boolean := False;
+   Debug_Flag_LL : Boolean := False;
+   Debug_Flag_MM : Boolean := False;
+   Debug_Flag_NN : Boolean := False;
+   Debug_Flag_OO : Boolean := False;
+   Debug_Flag_PP : Boolean := False;
+   Debug_Flag_QQ : Boolean := False;
+   Debug_Flag_RR : Boolean := False;
+   Debug_Flag_SS : Boolean := False;
+   Debug_Flag_TT : Boolean := False;
+   Debug_Flag_UU : Boolean := False;
+   Debug_Flag_VV : Boolean := False;
+   Debug_Flag_WW : Boolean := False;
+   Debug_Flag_XX : Boolean := False;
+   Debug_Flag_YY : Boolean := False;
+   Debug_Flag_ZZ : Boolean := False;
+
+   Debug_Flag_1 : Boolean := False;
+   Debug_Flag_2 : Boolean := False;
+   Debug_Flag_3 : Boolean := False;
+   Debug_Flag_4 : Boolean := False;
+   Debug_Flag_5 : Boolean := False;
+   Debug_Flag_6 : Boolean := False;
+   Debug_Flag_7 : Boolean := False;
+   Debug_Flag_8 : Boolean := False;
+   Debug_Flag_9 : Boolean := False;
+
+   function Get_Debug_Flag_K return Boolean;
+   --  This function is called from C code to get the setting of the K flag
+   --  (it does not work to try to access a constant object directly).
+
+   procedure Set_Debug_Flag (C : Character; Val : Boolean := True);
+   --  Where C is 0-9, A-Z, or a-z, sets the corresponding debug flag to
+   --  the given value. In the checks off version of debug, the call to
+   --  Set_Debug_Flag is always a null operation.
+
+end Debug;

gcc/ada/debug_a.adb

+------------------------------------------------------------------------------
+--                                                                          --
+--                         GNAT COMPILER COMPONENTS                         --
+--                                                                          --
+--                              D E B U G _ A                               --
+--                                                                          --
+--                                 B o d y                                  --
+--                                                                          --
+--                            $Revision: 1.11 $                             --
+--                                                                          --
+--          Copyright (C) 1992-1998 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 2,  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 COPYING.  If not, write --
+-- to  the Free Software Foundation,  59 Temple Place - Suite 330,  Boston, --
+-- MA 02111-1307, USA.                                                      --
+--                                                                          --
+-- GNAT was originally developed  by the GNAT team at  New York University. --
+-- It is now maintained by Ada Core Technologies Inc (http://www.gnat.com). --
+--                                                                          --
+------------------------------------------------------------------------------
+
+with Atree;   use Atree;
+with Debug;   use Debug;
+with Sinfo;   use Sinfo;
+with Sinput;  use Sinput;
+with Output;  use Output;
+
+package body Debug_A is
+
+   Debug_A_Depth : Natural := 0;
+   --  Output for the debug A flag is preceded by a sequence of vertical bar
+   --  characters corresponding to the recursion depth of the actions being
+   --  recorded (analysis, expansion, resolution and evaluation of nodes)
+   --  This variable records the depth.
+
+   Max_Node_Ids : constant := 200;
+   --  Maximum number of Node_Id values that get stacked
+
+   Node_Ids : array (1 .. Max_Node_Ids) of Node_Id;
+   --  A stack used to keep track of Node_Id values for setting the value of
+   --  Current_Error_Node correctly. Note that if we have more than 200
+   --  recursion levels, we just don't reset the right value on exit, which
+   --  is not crucial, since this is only for debugging!
+
+   -----------------------
+   -- Local Subprograms --
+   -----------------------
+
+   procedure Debug_Output_Astring;
+   --  Outputs Debug_A_Depth number of vertical bars, used to preface messages
+
+   -------------------
+   -- Debug_A_Entry --
+   -------------------
+
+   procedure Debug_A_Entry (S : String; N : Node_Id) is
+   begin
+      if Debug_Flag_A then
+         Debug_Output_Astring;
+         Write_Str (S);
+         Write_Str ("Node_Id = ");
+         Write_Int (Int (N));
+         Write_Str ("  ");
+         Write_Location (Sloc (N));
+         Write_Str ("  ");
+         Write_Str (Node_Kind'Image (Nkind (N)));
+         Write_Eol;
+      end if;
+
+      Debug_A_Depth := Debug_A_Depth + 1;
+      Current_Error_Node := N;
+
+      if Debug_A_Depth <= Max_Node_Ids then
+         Node_Ids (Debug_A_Depth) := N;
+      end if;
+   end Debug_A_Entry;
+
+   ------------------
+   -- Debug_A_Exit --
+   ------------------
+
+   procedure Debug_A_Exit (S : String; N : Node_Id; Comment : String) is
+   begin
+      Debug_A_Depth := Debug_A_Depth - 1;
+
+      if Debug_A_Depth in 1 .. Max_Node_Ids then
+         Current_Error_Node := Node_Ids (Debug_A_Depth);
+      end if;
+
+      if Debug_Flag_A then
+         Debug_Output_Astring;
+         Write_Str (S);
+         Write_Str ("Node_Id = ");
+         Write_Int (Int (N));
+         Write_Str (Comment);
+         Write_Eol;
+      end if;
+   end Debug_A_Exit;
+
+   --------------------------
+   -- Debug_Output_Astring --
+   --------------------------
+
+   procedure Debug_Output_Astring is
+      Vbars : String := "|||||||||||||||||||||||||";
+      --  Should be constant, removed because of GNAT 1.78 bug ???
+
+   begin
+      if Debug_A_Depth > Vbars'Length then
+         for I in Vbars'Length .. Debug_A_Depth loop
+            Write_Char ('|');
+         end loop;
+
+         Write_Str (Vbars);
+
+      else
+         Write_Str (Vbars (1 .. Debug_A_Depth));
+      end if;
+   end Debug_Output_Astring;
+
+end Debug_A;

gcc/ada/debug_a.ads

+------------------------------------------------------------------------------
+--                                                                          --
+--                         GNAT COMPILER COMPONENTS                         --
+--                                                                          --
+--                              D E B U G _ A                               --
+--                                                                          --
+--                                 S p e c                                  --
+--                                                                          --
+--                            $Revision: 1.8 $                              --
+--                                                                          --
+--          Copyright (C) 1992-1998 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 2,  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 COPYING.  If not, write --
+-- to  the Free Software Foundation,  59 Temple Place - Suite 330,  Boston, --
+-- MA 02111-1307, USA.                                                      --
+--                                                                          --
+-- GNAT was originally developed  by the GNAT team at  New York University. --
+-- It is now maintained by Ada Core Technologies Inc (http://www.gnat.com). --
+--                                                                          --
+------------------------------------------------------------------------------
+
+--  This package contains data and subprograms to support the A debug switch
+--  that is used to generate output showing what node is being analyzed,
+--  resolved, evaluated, or expanded.
+
+with Types; use Types;
+
+package Debug_A is
+
+   --  Note: the following subprograms are used in a stack like manner, with
+   --  an exit call matching each entry call. This means that they can keep
+   --  track of the current node being worked on, with the entry call setting
+   --  a new value, by pushing the Node_Id value on a stack, and the exit call
+   --  popping this value off. Comperr.Current_Error_Node is set by both the
+   --  entry and exit routines to point to the current node so that an abort
+   --  message indicates the node involved as accurately as possible.
+
+   procedure Debug_A_Entry (S : String; N : Node_Id);
+   pragma Inline (Debug_A_Entry);
+   --  Generates a message prefixed by a sequence of bars showing the nesting
+   --  depth (depth increases by 1 for a Debug_A_Entry call and is decreased
+   --  by the corresponding Debug_A_Exit call). Then the string is output
+   --  (analyzing, expanding etc), followed by the node number and its kind.
+   --  This output is generated only if the debug A flag is set. If the debug
+   --  A flag is not set, then no output is generated. This call also sets the
+   --  Node_Id value in Comperr.Current_Error_Node in case a bomb occurs. This
+   --  is done unconditionally, whether or not the debug A flag is set.
+
+   procedure Debug_A_Exit (S : String; N : Node_Id; Comment : String);
+   pragma Inline (Debug_A_Exit);
+   --  Generates the corresponding termination message. The message is preceded
+   --  by a sequence of bars, followed by the string S, the node number, and
+   --  a trailing comment (e.g. " (already evaluated)"). This output is
+   --  generated only if the debug A flag is set. If the debug A flag is not
+   --  set, then no output is generated. This call also resets the value in
+   --  Comperr.Current_Error_Node to what it was before the corresponding call
+   --  to Debug_A_Entry.
+
+end Debug_A;

gcc/ada/dec-io.adb

+------------------------------------------------------------------------------
+--                                                                          --
+--                         GNAT RUNTIME COMPONENTS                          --
+--                                                                          --
+--                               D E C . I O                                --
+--                                                                          --
+--                                 B o d y                                  --
+--                                                                          --
+--                            $Revision: 1.2 $
+--                                                                          --
+--            Copyright (C) 2001 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 2,  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 COPYING.  If not, write --
+-- to  the Free Software Foundation,  59 Temple Place - Suite 330,  Boston, --
+-- MA 02111-1307, USA.                                                      --
+--                                                                          --
+-- As a special exception,  if other files  instantiate  generics from this --
+-- unit, or you link  this unit with other files  to produce an executable, --
+-- this  unit  does not  by itself cause  the resulting  executable  to  be --
+-- covered  by the  GNU  General  Public  License.  This exception does not --
+-- however invalidate  any other reasons why  the executable file  might be --
+-- covered by the  GNU Public License.                                      --
+--                                                                          --
+-- GNAT was originally developed  by the GNAT team at  New York University. --
+-- It is now maintained by Ada Core Technologies Inc (http://www.gnat.com). --
+--                                                                          --
+------------------------------------------------------------------------------
+
+--  This is an AlphaVMS package that provides the interface between
+--  GNAT, DECLib IO packages and the DECLib Bliss library.
+
+pragma Extend_System (Aux_DEC);
+
+with System;                            use  System;
+with System.Task_Primitives;            use  System.Task_Primitives;
+with System.Task_Primitives.Operations; use  System.Task_Primitives.Operations;
+with IO_Exceptions;                     use  IO_Exceptions;
+with Aux_IO_Exceptions;                 use  Aux_IO_Exceptions;
+
+package body DEC.IO is
+
+   type File_Type is record
+      FCB : Integer   := 0;   -- Temporary
+      SEQ : Integer   := 0;
+   end record;
+
+   for File_Type'Size use 64;
+   for File_Type'Alignment use 8;
+
+   for File_Type use record
+      FCB at 0 range 0 .. 31;
+      SEQ at 4 range 0 .. 31;
+   end record;
+
+   -----------------------
+   -- Local Subprograms --
+   -----------------------
+
+   function GNAT_Name_64 (File : File_Type) return String;
+   pragma Export_Function (GNAT_Name_64, "GNAT$NAME_64");
+   --  ??? comment
+
+   function GNAT_Form_64 (File : File_Type) return String;
+   pragma Export_Function (GNAT_Form_64, "GNAT$FORM_64");
+   --  ??? comment
+
+   procedure Init_IO;
+   pragma Interface (C, Init_IO);
+   pragma Import_Procedure (Init_IO, "GNAT$$INIT_IO");
+   --  ??? comment
+
+   ----------------
+   -- IO_Locking --
+   ----------------
+
+   package body IO_Locking is
+
+      ------------------
+      -- Create_Mutex --
+      ------------------
+
+      function Create_Mutex return Access_Mutex is
+         M : constant Access_Mutex := new RTS_Lock;
+
+      begin
+         Initialize_Lock (M, Global_Task_Level);
+         return M;
+      end Create_Mutex;
+
+      -------------
+      -- Acquire --
+      -------------
+
+      procedure Acquire (M : Access_Mutex) is
+      begin
+         Write_Lock (M);
+      end Acquire;
+
+      -------------
+      -- Release --
+      -------------
+
+      procedure Release (M : Access_Mutex) is
+      begin
+         Unlock (M);
+      end Release;
+
+   end IO_Locking;
+
+   ------------------
+   -- GNAT_Name_64 --
+   ------------------
+
+   function GNAT_Name_64 (File : File_Type) return String is
+      subtype Buffer_Subtype is String (1 .. 8192);
+
+      Buffer : Buffer_Subtype;
+      Length : System.Integer_32;
+
+      procedure Get_Name
+        (File    : System.Address;
+         MaxLen  : System.Integer_32;
+         Buffer  : out Buffer_Subtype;
+         Length  : out System.Integer_32);
+      pragma Interface (C, Get_Name);
+      pragma Import_Procedure
+        (Get_Name, "GNAT$FILE_NAME",
+         Mechanism => (Value, Value, Reference, Reference));
+
+   begin
+      Get_Name (File'Address, Buffer'Length, Buffer, Length);
+      return Buffer (1 .. Integer (Length));
+   end GNAT_Name_64;
+
+   ------------------
+   -- GNAT_Form_64 --
+   ------------------
+
+   function GNAT_Form_64 (File : File_Type) return String is
+      subtype Buffer_Subtype is String (1 .. 8192);
+
+      Buffer : Buffer_Subtype;
+      Length : System.Integer_32;
+
+      procedure Get_Form
+        (File    : System.Address;
+         MaxLen  : System.Integer_32;
+         Buffer  : out Buffer_Subtype;
+         Length  : out System.Integer_32);
+      pragma Interface (C, Get_Form);
+      pragma Import_Procedure
+        (Get_Form, "GNAT$FILE_FORM",
+         Mechanism => (Value, Value, Reference, Reference));
+
+   begin
+      Get_Form (File'Address, Buffer'Length, Buffer, Length);
+      return Buffer (1 .. Integer (Length));
+   end GNAT_Form_64;
+
+   ------------------------
+   -- Raise_IO_Exception --
+   ------------------------
+
+   procedure Raise_IO_Exception (EN : Exception_Number) is
+   begin
+      case EN is
+         when GNAT_EN_LOCK_ERROR =>      raise LOCK_ERROR;
+         when GNAT_EN_EXISTENCE_ERROR => raise EXISTENCE_ERROR;
+         when GNAT_EN_KEY_ERROR =>       raise KEY_ERROR;
+         when GNAT_EN_KEYSIZERR =>       raise PROGRAM_ERROR; -- KEYSIZERR;
+         when GNAT_EN_STAOVF =>          raise STORAGE_ERROR; -- STAOVF;
+         when GNAT_EN_CONSTRAINT_ERRO => raise CONSTRAINT_ERROR;
+         when GNAT_EN_IOSYSFAILED =>     raise DEVICE_ERROR;  -- IOSYSFAILED;
+         when GNAT_EN_LAYOUT_ERROR =>    raise LAYOUT_ERROR;
+         when GNAT_EN_STORAGE_ERROR =>   raise STORAGE_ERROR;
+         when GNAT_EN_DATA_ERROR =>      raise DATA_ERROR;
+         when GNAT_EN_DEVICE_ERROR =>    raise DEVICE_ERROR;
+         when GNAT_EN_END_ERROR =>       raise END_ERROR;
+         when GNAT_EN_MODE_ERROR =>      raise MODE_ERROR;
+         when GNAT_EN_NAME_ERROR =>      raise NAME_ERROR;
+         when GNAT_EN_STATUS_ERROR =>    raise STATUS_ERROR;
+         when GNAT_EN_NOT_OPEN =>        raise USE_ERROR;   -- NOT_OPEN;
+         when GNAT_EN_ALREADY_OPEN =>    raise USE_ERROR;   -- ALREADY_OPEN;
+         when GNAT_EN_USE_ERROR =>       raise USE_ERROR;
+         when GNAT_EN_UNSUPPORTED =>     raise USE_ERROR;   -- UNSUPPORTED;
+         when GNAT_EN_FAC_MODE_MISMAT => raise USE_ERROR;   -- FAC_MODE_MISMAT;
+         when GNAT_EN_ORG_MISMATCH =>    raise USE_ERROR;   -- ORG_MISMATCH;
+         when GNAT_EN_RFM_MISMATCH =>    raise USE_ERROR;   -- RFM_MISMATCH;
+         when GNAT_EN_RAT_MISMATCH =>    raise USE_ERROR;   -- RAT_MISMATCH;
+         when GNAT_EN_MRS_MISMATCH =>    raise USE_ERROR;   -- MRS_MISMATCH;
+         when GNAT_EN_MRN_MISMATCH =>    raise USE_ERROR;   -- MRN_MISMATCH;
+         when GNAT_EN_KEY_MISMATCH =>    raise USE_ERROR;   -- KEY_MISMATCH;
+         when GNAT_EN_MAXLINEXC =>       raise CONSTRAINT_ERROR; -- MAXLINEXC;
+         when GNAT_EN_LINEXCMRS =>       raise CONSTRAINT_ERROR; -- LINEXCMRS;
+      end case;
+   end Raise_IO_Exception;
+
+-------------------------
+-- Package Elaboration --
+-------------------------
+
+begin
+   Init_IO;
+end DEC.IO;

gcc/ada/dec-io.ads

+------------------------------------------------------------------------------
+--                                                                          --
+--                         GNAT RUNTIME COMPONENTS                          --
+--                                                                          --
+--                               D E C . I O                                --
+--                                                                          --
+--                                 S p e c                                  --
+--                                                                          --
+--                            $Revision: 1.2 $
+--                                                                          --
+--          Copyright (C) 1996-2001 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 2,  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 COPYING.  If not, write --
+-- to  the Free Software Foundation,  59 Temple Place - Suite 330,  Boston, --
+-- MA 02111-1307, USA.                                                      --
+--                                                                          --
+-- As a special exception,  if other files  instantiate  generics from this --
+-- unit, or you link  this unit with other files  to produce an executable, --
+-- this  unit  does not  by itself cause  the resulting  executable  to  be --
+-- covered  by the  GNU  General  Public  License.  This exception does not --
+-- however invalidate  any other reasons why  the executable file  might be --
+-- covered by the  GNU Public License.                                      --
+--                                                                          --
+-- GNAT was originally developed  by the GNAT team at  New York University. --
+-- It is now maintained by Ada Core Technologies Inc (http://www.gnat.com). --
+--                                                                          --
+------------------------------------------------------------------------------
+
+--  This is an AlphaVMS package that contains the declarations and
+--  function specifications needed by the DECLib IO packages.
+
+with System.Task_Primitives;
+package DEC.IO is
+private
+
+   type Exception_Number is (
+     GNAT_EN_LOCK_ERROR,
+     GNAT_EN_EXISTENCE_ERROR,
+     GNAT_EN_KEY_ERROR,
+     GNAT_EN_KEYSIZERR,
+     GNAT_EN_STAOVF,
+     GNAT_EN_CONSTRAINT_ERRO,
+     GNAT_EN_IOSYSFAILED,
+     GNAT_EN_LAYOUT_ERROR,
+     GNAT_EN_STORAGE_ERROR,
+     GNAT_EN_DATA_ERROR,
+     GNAT_EN_DEVICE_ERROR,
+     GNAT_EN_END_ERROR,
+     GNAT_EN_MODE_ERROR,
+     GNAT_EN_NAME_ERROR,
+     GNAT_EN_STATUS_ERROR,
+     GNAT_EN_NOT_OPEN,
+     GNAT_EN_ALREADY_OPEN,
+     GNAT_EN_USE_ERROR,
+     GNAT_EN_UNSUPPORTED,
+     GNAT_EN_FAC_MODE_MISMAT,
+     GNAT_EN_ORG_MISMATCH,
+     GNAT_EN_RFM_MISMATCH,
+     GNAT_EN_RAT_MISMATCH,
+     GNAT_EN_MRS_MISMATCH,
+     GNAT_EN_MRN_MISMATCH,
+     GNAT_EN_KEY_MISMATCH,
+     GNAT_EN_MAXLINEXC,
+     GNAT_EN_LINEXCMRS);
+
+   for Exception_Number'Size use 32;
+
+   for Exception_Number use (
+     GNAT_EN_LOCK_ERROR => 1,
+     GNAT_EN_EXISTENCE_ERROR => 2,
+     GNAT_EN_KEY_ERROR => 3,
+     GNAT_EN_KEYSIZERR => 4,
+     GNAT_EN_STAOVF => 5,
+     GNAT_EN_CONSTRAINT_ERRO => 6,
+     GNAT_EN_IOSYSFAILED => 7,
+     GNAT_EN_LAYOUT_ERROR => 8,
+     GNAT_EN_STORAGE_ERROR => 9,
+     GNAT_EN_DATA_ERROR => 10,
+     GNAT_EN_DEVICE_ERROR => 11,
+     GNAT_EN_END_ERROR => 12,
+     GNAT_EN_MODE_ERROR => 13,
+     GNAT_EN_NAME_ERROR => 14,
+     GNAT_EN_STATUS_ERROR => 15,
+     GNAT_EN_NOT_OPEN => 16,
+     GNAT_EN_ALREADY_OPEN => 17,
+     GNAT_EN_USE_ERROR => 18,
+     GNAT_EN_UNSUPPORTED => 19,
+     GNAT_EN_FAC_MODE_MISMAT => 20,
+     GNAT_EN_ORG_MISMATCH => 21,
+     GNAT_EN_RFM_MISMATCH => 22,
+     GNAT_EN_RAT_MISMATCH => 23,
+     GNAT_EN_MRS_MISMATCH => 24,
+     GNAT_EN_MRN_MISMATCH => 25,
+     GNAT_EN_KEY_MISMATCH => 26,
+     GNAT_EN_MAXLINEXC => 27,
+     GNAT_EN_LINEXCMRS => 28);
+
+   procedure Raise_IO_Exception (EN : Exception_Number);
+   pragma Export_Procedure (Raise_IO_Exception, "GNAT$RAISE_IO_EXCEPTION",
+      Mechanism => Value);
+
+   package IO_Locking is
+      type Access_Mutex is private;
+      function Create_Mutex return Access_Mutex;
+      procedure Acquire (M : Access_Mutex);
+      procedure Release (M : Access_Mutex);
+
+   private
+      type Access_Mutex is access System.Task_Primitives.RTS_Lock;
+      pragma Export_Function (Create_Mutex, "GNAT$CREATE_MUTEX",
+          Mechanism => Value);
+      pragma Export_Procedure (Acquire, "GNAT$ACQUIRE_MUTEX",
+          Mechanism => Value);
+      pragma Export_Procedure (Release, "GNAT$RELEASE_MUTEX",
+          Mechanism => Value);
+   end IO_Locking;
+
+end DEC.IO;

gcc/ada/dec.ads

+------------------------------------------------------------------------------
+--                                                                          --
+--                         GNAT RUNTIME COMPONENTS                          --
+--                                                                          --
+--                                  D E C                                   --
+--                                                                          --
+--                                 S p e c                                  --
+--                                                                          --
+--                            $Revision: 1.5 $
+--                                                                          --
+--          Copyright (C) 1996-2001  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 2,  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 COPYING.  If not, write --
+-- to  the Free Software Foundation,  59 Temple Place - Suite 330,  Boston, --
+-- MA 02111-1307, USA.                                                      --
+--                                                                          --
+-- As a special exception,  if other files  instantiate  generics from this --
+-- unit, or you link  this unit with other files  to produce an executable, --
+-- this  unit  does not  by itself cause  the resulting  executable  to  be --
+-- covered  by the  GNU  General  Public  License.  This exception does not --
+-- however invalidate  any other reasons why  the executable file  might be --
+-- covered by the  GNU Public License.                                      --
+--                                                                          --
+-- GNAT was originally developed  by the GNAT team at  New York University. --
+-- It is now maintained by Ada Core Technologies Inc (http://www.gnat.com). --
+--                                                                          --
+------------------------------------------------------------------------------
+
+--  This is an AlphaVMS package, which is imported by every package in
+--  DECLib and tested for in gnatbind, in order to add "-ldecgnat" to
+--  the bind. It is also a convenient parent for all DEC IO child packages.
+
+package DEC is
+pragma Pure (DEC);
+end DEC;

gcc/ada/deftarg.c

+/****************************************************************************
+ *                                                                          *
+ *                         GNAT COMPILER COMPONENTS                         *
+ *                                                                          *
+ *                             D E F T A R G                                *
+ *                                                                          *
+ *                                  Body                                    *
+ *                                                                          *
+ *                             $Revision: 1.1 $
+ *                                                                          *
+ *          Copyright (C) 1992-2001 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 2,  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 COPYING.  If not, write *
+ * to  the Free Software Foundation,  59 Temple Place - Suite 330,  Boston, *
+ * MA 02111-1307, USA.                                                      *
+ *                                                                          *
+ * As a  special  exception,  if you  link  this file  with other  files to *
+ * produce an executable,  this file does not by itself cause the resulting *
+ * executable to be covered by the GNU General Public License. This except- *
+ * ion does not  however invalidate  any other reasons  why the  executable *
+ * file might be covered by the  GNU Public License.                        *
+ *                                                                          *
+ * GNAT was originally developed  by the GNAT team at  New York University. *
+ * It is now maintained by Ada Core Technologies Inc (http://www.gnat.com). *
+ *                                                                          *
+ ****************************************************************************/
+
+/* Include a default definition for TARGET_FLAGS for gnatpsta.  */
+
+#include "config.h"
+#define MIN(X,Y) ((X) < (Y) ? (X) : (Y))
+
+int target_flags = TARGET_DEFAULT;

gcc/ada/directio.ads

+------------------------------------------------------------------------------
+--                                                                          --
+--                         GNAT RUNTIME COMPONENTS                          --
+--                                                                          --
+--                            D I R E C T _ I O                             --
+--                                                                          --
+--                                 S p e c                                  --
+--                                                                          --
+--                            $Revision: 1.8 $                              --
+--                                                                          --
+-- This specification is adapted from the Ada Reference Manual for use with --
+-- GNAT.  In accordance with the copyright of that document, you can freely --
+-- copy and modify this specification,  provided that if you redistribute a --
+-- modified version,  any changes that you have made are clearly indicated. --
+--                                                                          --
+------------------------------------------------------------------------------
+
+pragma Ada_95;
+with Ada.Direct_IO;
+
+generic package Direct_IO renames Ada.Direct_IO;

gcc/ada/elists.ads

+------------------------------------------------------------------------------
+--                                                                          --
+--                         GNAT COMPILER COMPONENTS                         --
+--                                                                          --
+--                               E L I S T S                                --
+--                                                                          --
+--                                 S p e c                                  --
+--                                                                          --
+--                            $Revision: 1.14 $                             --
+--                                                                          --
+--          Copyright (C) 1992-1998 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 2,  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 COPYING.  If not, write --
+-- to  the Free Software Foundation,  59 Temple Place - Suite 330,  Boston, --
+-- MA 02111-1307, USA.                                                      --
+--                                                                          --
+-- As a special exception,  if other files  instantiate  generics from this --
+-- unit, or you link  this unit with other files  to produce an executable, --
+-- this  unit  does not  by itself cause  the resulting  executable  to  be --
+-- covered  by the  GNU  General  Public  License.  This exception does not --
+-- however invalidate  any other reasons why  the executable file  might be --
+-- covered by the  GNU Public License.                                      --
+--                                                                          --
+-- GNAT was originally developed  by the GNAT team at  New York University. --
+-- It is now maintained by Ada Core Technologies Inc (http://www.gnat.com). --
+--                                                                          --
+------------------------------------------------------------------------------
+
+--  This package provides facilities for manipulating lists of nodes (see
+--  package Atree for format and implementation of tree nodes). Separate list
+--  elements are allocated to represent elements of these lists, so it is
+--  possible for a given node to be on more than one element list at a time.
+--  See also package Nlists, which provides another form that is threaded
+--  through the nodes themselves (using the Link field), which is more time
+--  and space efficient, but a node can be only one such list.
+
+with Types;  use Types;
+with System;
+
+package Elists is
+
+   --  An element list is represented by a header that is allocated in the
+   --  Elist header table. This header contains pointers to the first and
+   --  last elements in the list, or to No_Elmt if the list is empty.
+
+   --  The elements in the list each contain a pointer to the next element
+   --  and a pointer to the referenced node. Putting a node into an element
+   --  list causes no change at all to the node itself, so a node may be
+   --  included in multiple element lists, and the nodes thus included may
+   --  or may not be elements of node lists (see package Nlists).
+
+   procedure Initialize;
+   --  Initialize allocation of element list tables. Called at the start of
+   --  compiling each new main source file. Note that Initialize must not be
+   --  called if Tree_Read is used.
+
+   procedure Lock;
+   --  Lock tables used for element lists before calling backend
+
+   procedure Tree_Read;
+   --  Initializes internal tables from current tree file using Tree_Read.
+   --  Note that Initialize should not be called if Tree_Read is used.
+   --  Tree_Read includes all necessary initialization.
+
+   procedure Tree_Write;
+   --  Writes out internal tables to current tree file using Tree_Write
+
+   function Last_Elist_Id return Elist_Id;
+   --  Returns Id of last allocated element list header
+
+   function Elists_Address return System.Address;
+   --  Return address of Elists table (used in Back_End for Gigi call)
+
+   function Num_Elists return Nat;
+   --  Number of currently allocated element lists
+
+   function Last_Elmt_Id return Elmt_Id;
+   --  Returns Id of last allocated list element
+
+   function Elmts_Address return System.Address;
+   --  Return address of Elmts table (used in Back_End for Gigi call)
+
+   function Node (Elmt : Elmt_Id) return Node_Id;
+   pragma Inline (Node);
+   --  Returns the value of a given list element. Returns Empty if Elmt
+   --  is set to No_Elmt.
+
+   function New_Elmt_List return Elist_Id;
+   --  Creates a new empty element list. Typically this is used to initialize
+   --  a field in some other node which points to an element list where the
+   --  list is then subsequently filled in using Append calls.
+
+   function First_Elmt (List : Elist_Id) return Elmt_Id;
+   pragma Inline (First_Elmt);
+   --  Obtains the first element of the given element list or, if the
+   --  list has no items, then No_Elmt is returned.
+
+   function Last_Elmt (List : Elist_Id) return Elmt_Id;
+   pragma Inline (Last_Elmt);
+   --  Obtains the last element of the given element list or, if the
+   --  list has no items, then No_Elmt is returned.
+
+   function Next_Elmt (Elmt : Elmt_Id) return Elmt_Id;
+   pragma Inline (Next_Elmt);
+   --  This function returns the next element on an element list. The argument
+   --  must be a list element other than No_Elmt. Returns No_Elmt if the given
+   --  element is the last element of the list.
+
+   procedure Next_Elmt (Elmt : in out Elmt_Id);
+   pragma Inline (Next_Elmt);
+   --  Next_Elmt (Elmt) is equivalent to Elmt := Next_Elmt (Elmt)
+
+   function Is_Empty_Elmt_List (List : Elist_Id) return Boolean;
+   pragma Inline (Is_Empty_Elmt_List);
+   --  This function determines if a given tree id references an element list
+   --  that contains no items.
+
+   procedure Append_Elmt (Node : Node_Id; To : Elist_Id);
+   --  Appends Node at the end of To, allocating a new element.
+
+   procedure Prepend_Elmt (Node : Node_Id; To : Elist_Id);
+   --  Appends Node at the beginning of To, allocating a new element.
+
+   procedure Insert_Elmt_After (Node : Node_Id; Elmt : Elmt_Id);
+   --  Add a new element (Node) right after the pre-existing element Elmt
+   --  It is invalid to call this subprogram with Elmt = No_Elmt.
+
+   procedure Replace_Elmt (Elmt : Elmt_Id; New_Node : Node_Id);
+   pragma Inline (Replace_Elmt);
+   --  Causes the given element of the list to refer to New_Node, the node
+   --  which was previously referred to by Elmt is effectively removed from
+   --  the list and replaced by New_Node.
+
+   procedure Remove_Elmt (List : Elist_Id; Elmt : Elmt_Id);
+   --  Removes Elmt from the given list. The node itself is not affected,
+   --  but the space used by the list element may be (but is not required
+   --  to be) freed for reuse in a subsequent Append_Elmt call.
+
+   procedure Remove_Last_Elmt (List : Elist_Id);
+   --  Removes the last element of the given list. The node itself is not
+   --  affected, but the space used by the list element may be (but is not
+   --  required to be) freed for reuse in a subsequent Append_Elmt call.
+
+   function No (List : Elist_Id) return Boolean;
+   pragma Inline (No);
+   --  Tests given Id for equality with No_Elist. This allows notations like
+   --  "if No (Statements)" as opposed to "if Statements = No_Elist".
+
+   function Present (List : Elist_Id) return Boolean;
+   pragma Inline (Present);
+   --  Tests given Id for inequality with No_Elist. This allows notations like
+   --  "if Present (Statements)" as opposed to "if Statements /= No_Elist".
+
+   function No (Elmt : Elmt_Id) return Boolean;
+   pragma Inline (No);
+   --  Tests given Id for equality with No_Elmt. This allows notations like
+   --  "if No (Operation)" as opposed to "if Operation = No_Elmt".
+
+   function Present (Elmt : Elmt_Id) return Boolean;
+   pragma Inline (Present);
+   --  Tests given Id for inequality with No_Elmt. This allows notations like
+   --  "if Present (Operation)" as opposed to "if Operation /= No_Elmt".
+
+end Elists;

gcc/ada/elists.h

+/****************************************************************************
+ *                                                                          *
+ *                         GNAT COMPILER COMPONENTS                         *
+ *                                                                          *
+ *                               E L I S T S                                *
+ *                                                                          *
+ *                              C Header File                               *
+ *                                                                          *
+ *                            $Revision: 1.1 $
+ *                                                                          *
+ *          Copyright (C) 1992-2001 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 2,  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 COPYING.  If not, write *
+ * to  the Free Software Foundation,  59 Temple Place - Suite 330,  Boston, *
+ * MA 02111-1307, USA.                                                      *
+ *                                                                          *
+ * GNAT was originally developed  by the GNAT team at  New York University. *
+ * It is now maintained by Ada Core Technologies Inc (http://www.gnat.com). *
+ *                                                                          *
+ ****************************************************************************/
+
+/* This is the C header corresponding to the Ada package specification for
+   Elists. It also contains the implementations of inlined functions from the
+   package body for Elists.  It was generated manually from elists.ads and
+   elists.adb and must be kept synchronized with changes in these files.
+
+   Note that only routines for reading the tree are included, since the
+   tree transformer is not supposed to modify the tree in any way. */
+
+/*  The following are the structures used to hold element lists */
+
+struct Elist_Header
+{
+  Elmt_Id first;
+  Elmt_Id last;
+};
+
+struct Elmt_Item
+{
+  Node_Id node;
+  Int next;
+};
+
+/* The element list headers and element descriptors themselves are stored in
+   two arrays. The pointers to these arrays are passed as a parameter to the
+   tree transformer procedure and stored in the global variables Elists_Ptr
+   and Elmts_Ptr after adjusting them by subtracting Elist_First_Entry and
+   Elmt_First_Entry, so that Elist_Id and Elmt_Id values can be used as
+   subscripts into these arrays */
+
+extern struct Elist_Header *Elists_Ptr;
+extern struct Elmt_Item *Elmts_Ptr;
+
+/* Element List Access Functions:  */
+
+static Node_Id Node		PARAMS ((Elmt_Id));
+static Elmt_Id First_Elmt	PARAMS ((Elist_Id));
+static Elmt_Id Last_Elmt	PARAMS ((Elist_Id));
+static Elmt_Id Next_Elmt	PARAMS ((Elmt_Id));
+static Boolean Is_Empty_Elmt_List PARAMS ((Elist_Id));
+
+INLINE Node_Id
+Node (Elmt)
+     Elmt_Id Elmt;
+{
+  return Elmts_Ptr [Elmt].node;
+}
+
+INLINE Elmt_Id
+First_Elmt (List)
+     Elist_Id List;
+{
+  return Elists_Ptr [List].first;
+}
+
+INLINE Elmt_Id
+Last_Elmt (List)
+     Elist_Id List;
+{
+  return Elists_Ptr [List].last;
+}
+
+INLINE Elmt_Id
+Next_Elmt (Node)
+     Elmt_Id Node;
+{
+  Int N = Elmts_Ptr [Node].next;
+
+  if (IN (N, Elist_Range))
+    return No_Elmt;
+  else
+    return N;
+}
+
+INLINE Boolean
+Is_Empty_Elmt_List (Id)
+     Elist_Id Id;
+{
+  return Elists_Ptr [Id].first == No_Elmt;
+}

gcc/ada/errno.c

+/****************************************************************************
+ *                                                                          *
+ *                GNU ADA RUN-TIME LIBRARY (GNARL) COMPONENTS               *
+ *                                                                          *
+ *                                E R R N O                                 *
+ *                                                                          *
+ *                          C Implementation File                           *
+ *                                                                          *
+ *                             $Revision: 1.1 $
+ *                                                                          *
+ *           Copyright (C) 1992-2001 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 2,  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 COPYING.  If not, write *
+ * to  the Free Software Foundation,  59 Temple Place - Suite 330,  Boston, *
+ * MA 02111-1307, USA.                                                      *
+ *                                                                          *
+ * As a  special  exception,  if you  link  this file  with other  files to *
+ * produce an executable,  this file does not by itself cause the resulting *
+ * executable to be covered by the GNU General Public License. This except- *
+ * ion does not  however invalidate  any other reasons  why the  executable *
+ * file might be covered by the  GNU Public License.                        *
+ *                                                                          *
+ * GNAT was originally developed  by the GNAT team at  New York University. *
+ * It is now maintained by Ada Core Technologies Inc (http://www.gnat.com). *
+ *                                                                          *
+ ****************************************************************************/
+
+/* This file provides access to the C-language errno to the Ada interface
+   for POSIX.  It is not possible in general to import errno, even in
+   Ada compilers that allow (as GNAT does) the importation of variables,
+   as it may be defined using a macro.
+*/
+
+
+#define _REENTRANT
+#define _THREAD_SAFE
+
+#include <errno.h>
+int
+__get_errno()
+{
+  return errno;
+}
+
+void
+__set_errno(err)
+     int err;
+{
+  errno = err;
+}

gcc/ada/eval_fat.ads

+------------------------------------------------------------------------------
+--                                                                          --
+--                         GNAT COMPILER COMPONENTS                         --
+--                                                                          --
+--                             E V A L _ F A T                              --
+--                                                                          --
+--                                 S p e c                                  --
+--                                                                          --
+--                            $Revision: 1.4 $                              --
+--                                                                          --
+--          Copyright (C) 1992-2000 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 2,  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 COPYING.  If not, write --
+-- to  the Free Software Foundation,  59 Temple Place - Suite 330,  Boston, --
+-- MA 02111-1307, USA.                                                      --
+--                                                                          --
+-- GNAT was originally developed  by the GNAT team at  New York University. --
+-- It is now maintained by Ada Core Technologies Inc (http://www.gnat.com). --
+--                                                                          --
+------------------------------------------------------------------------------
+
+--  This package provides for compile-time evaluation of static calls to the
+--  floating-point attribute functions. It is the compile-time equivalent of
+--  the System.Fat_Gen runtime package. The coding is quite similar, as are
+--  the subprogram specs, except that the type is passed as an explicit
+--  first parameter (and used via ttypes, to obtain the necessary information
+--  about the characteristics of the type for computing the results.
+
+with Types;  use Types;
+with Uintp;  use Uintp;
+with Urealp; use Urealp;
+
+package Eval_Fat is
+
+   subtype UI is Uint;
+   --  The compile time representation of universal integer
+
+   subtype T is Ureal;
+   --  The compile time representation of floating-point values
+
+   subtype R is Entity_Id;
+   --  The compile time representation of the floating-point root type
+
+   type Rounding_Mode is (Floor, Ceiling, Round, Round_Even);
+   --  Used to indicate rounding mode for Machine attribute
+
+   Rounding_Was_Biased : Boolean;
+   --  Set if last use of Machine rounded a halfway case away from zero
+
+   function Adjacent          (RT : R; X, Towards : T)              return T;
+
+   function Ceiling           (RT : R; X : T)                       return T;
+
+   function Compose           (RT : R; Fraction : T; Exponent : UI) return T;
+
+   function Copy_Sign         (RT : R; Value, Sign : T)             return T;
+
+   function Exponent          (RT : R; X : T)                       return UI;
+
+   function Floor             (RT : R; X : T)                       return T;
+
+   function Fraction          (RT : R; X : T)                       return T;
+
+   function Leading_Part      (RT : R; X : T; Radix_Digits : UI)    return T;
+
+   function Machine           (RT : R; X : T; Mode : Rounding_Mode) return T;
+
+   function Model             (RT : R; X : T)                       return T;
+
+   function Pred              (RT : R; X : T)                       return T;
+
+   function Remainder         (RT : R; X, Y : T)                    return T;
+
+   function Rounding          (RT : R; X : T)                       return T;
+
+   function Scaling           (RT : R; X : T; Adjustment : UI)      return T;
+
+   function Succ              (RT : R; X : T)                       return T;
+
+   function Truncation        (RT : R; X : T)                       return T;
+
+   function Unbiased_Rounding (RT : R; X : T)                       return T;
+
+end Eval_Fat;

gcc/ada/exit.c

+/****************************************************************************
+ *                                                                          *
+ *                         GNAT COMPILER COMPONENTS                         *
+ *                                                                          *
+ *                                E X I T                                   *
+ *                                                                          *
+ *                          C Implementation File                           *
+ *                                                                          *
+ *                            $Revision: 1.1 $
+ *                                                                          *
+ *          Copyright (C) 1992-2001 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 2,  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 COPYING.  If not, write *
+ * to  the Free Software Foundation,  59 Temple Place - Suite 330,  Boston, *
+ * MA 02111-1307, USA.                                                      *
+ *                                                                          *
+ * As a  special  exception,  if you  link  this file  with other  files to *
+ * produce an executable,  this file does not by itself cause the resulting *
+ * executable to be covered by the GNU General Public License. This except- *
+ * ion does not  however invalidate  any other reasons  why the  executable *
+ * file might be covered by the  GNU Public License.                        *
+ *                                                                          *
+ * GNAT was originally developed  by the GNAT team at  New York University. *
+ * It is now maintained by Ada Core Technologies Inc (http://www.gnat.com). *
+ *                                                                          *
+ ****************************************************************************/
+
+#ifdef __alpha_vxworks
+#include "vxWorks.h"
+#endif
+
+#ifdef IN_RTS
+#include "tconfig.h"
+#include "tsystem.h"
+#include <sys/stat.h>
+#else
+#include "config.h"
+#include "system.h"
+#endif
+
+#include "adaint.h"
+
+/* Routine used by Ada.Command_Line.Set_Exit_Status */
+
+int gnat_exit_status = 0;
+
+void
+__gnat_set_exit_status (i)
+     int i;
+{
+  gnat_exit_status = i;
+}

gcc/ada/exp_aggr.ads

+------------------------------------------------------------------------------
+--                                                                          --
+--                         GNAT COMPILER COMPONENTS                         --
+--                                                                          --
+--                             E X P _ A G G R                              --
+--                                                                          --
+--                                 S p e c                                  --
+--                                                                          --
+--                            $Revision: 1.6 $
+--                                                                          --
+--          Copyright (C) 1992-2000 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 2,  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 COPYING.  If not, write --
+-- to  the Free Software Foundation,  59 Temple Place - Suite 330,  Boston, --
+-- MA 02111-1307, USA.                                                      --
+--                                                                          --
+-- GNAT was originally developed  by the GNAT team at  New York University. --
+-- It is now maintained by Ada Core Technologies Inc (http://www.gnat.com). --
+--                                                                          --
+------------------------------------------------------------------------------
+
+with Types; use Types;
+
+package Exp_Aggr is
+
+   procedure Expand_N_Aggregate           (N : Node_Id);
+   procedure Expand_N_Extension_Aggregate (N : Node_Id);
+
+   function Is_Delayed_Aggregate (N : Node_Id) return Boolean;
+   --  returns True if N is a delayed aggregate of some kind
+
+   procedure Convert_Aggr_In_Object_Decl  (N : Node_Id);
+   --  N is a N_Object_Declaration with an expression which must be
+   --  an N_Aggregate or N_Extension_Aggregate with Expansion_Delayed
+   --  This procedure performs in-place aggregate assignment.
+
+   procedure Convert_Aggr_In_Allocator (Decl, Aggr : Node_Id);
+   --  Decl is an access N_Object_Declaration (produced during
+   --  allocator expansion), Aggr is the initial expression aggregate
+   --  of an allocator. This procedure perform in-place aggregate
+   --  assignent in the newly allocated object.
+
+   procedure Convert_Aggr_In_Assignment (N : Node_Id);
+   --  Decl is an access N_Object_Declaration (produced during
+   --  allocator expansion), Aggr is the initial expression aggregate
+   --  of an allocator. This procedure perform in-place aggregate
+   --  assignent in the newly allocated object.
+
+
+end Exp_Aggr;

gcc/ada/exp_attr.ads

+------------------------------------------------------------------------------
+--                                                                          --
+--                         GNAT COMPILER COMPONENTS                         --
+--                                                                          --
+--                             E X P _ A T T R                              --
+--                                                                          --
+--                                 S p e c                                  --
+--                                                                          --
+--                            $Revision: 1.3 $                              --
+--                                                                          --
+--        Copyright (C) 1992,1993,1994 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 2,  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 COPYING.  If not, write --
+-- to  the Free Software Foundation,  59 Temple Place - Suite 330,  Boston, --
+-- MA 02111-1307, USA.                                                      --
+--                                                                          --
+-- GNAT was originally developed  by the GNAT team at  New York University. --
+-- It is now maintained by Ada Core Technologies Inc (http://www.gnat.com). --
+--                                                                          --
+------------------------------------------------------------------------------
+
+--  Expand routines for attribute references
+
+with Types; use Types;
+
+package Exp_Attr is
+   procedure Expand_N_Attribute_Reference       (N : Node_Id);
+end Exp_Attr;

gcc/ada/exp_ch10.ads

+------------------------------------------------------------------------------
+--                                                                          --
+--                         GNAT COMPILER COMPONENTS                         --
+--                                                                          --
+--                             E X P _ C H 1 0                              --
+--                                                                          --
+--                                 S p e c                                  --
+--                                                                          --
+--                            $Revision: 1.3 $                              --
+--                                                                          --
+--        Copyright (C) 1992,1993,1994 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 2,  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 COPYING.  If not, write --
+-- to  the Free Software Foundation,  59 Temple Place - Suite 330,  Boston, --
+-- MA 02111-1307, USA.                                                      --
+--                                                                          --
+-- GNAT was originally developed  by the GNAT team at  New York University. --
+-- It is now maintained by Ada Core Technologies Inc (http://www.gnat.com). --
+--                                                                          --
+------------------------------------------------------------------------------
+
+--  Expand routines for chapter 10 constructs
+
+package Exp_Ch10 is
+end Exp_Ch10;

gcc/ada/exp_ch11.ads

+------------------------------------------------------------------------------
+--                                                                          --
+--                         GNAT COMPILER COMPONENTS                         --
+--                                                                          --
+--                             E X P _ C H 1 1                              --
+--                                                                          --
+--                                 S p e c                                  --
+--                                                                          --
+--                            $Revision: 1.25 $
+--                                                                          --
+--          Copyright (C) 1992-2000 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 2,  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 COPYING.  If not, write --
+-- to  the Free Software Foundation,  59 Temple Place - Suite 330,  Boston, --
+-- MA 02111-1307, USA.                                                      --
+--                                                                          --
+-- GNAT was originally developed  by the GNAT team at  New York University. --
+-- It is now maintained by Ada Core Technologies Inc (http://www.gnat.com). --
+--                                                                          --
+------------------------------------------------------------------------------
+
+--  Expand routines for chapter 11 constructs
+
+with Types; use Types;
+
+package Exp_Ch11 is
+   procedure Expand_N_Exception_Declaration          (N : Node_Id);
+   procedure Expand_N_Handled_Sequence_Of_Statements (N : Node_Id);
+   procedure Expand_N_Raise_Constraint_Error         (N : Node_Id);
+   procedure Expand_N_Raise_Program_Error            (N : Node_Id);
+   procedure Expand_N_Raise_Statement                (N : Node_Id);
+   procedure Expand_N_Raise_Storage_Error            (N : Node_Id);
+   procedure Expand_N_Subprogram_Info                (N : Node_Id);
+
+   --  Data structures for gathering information to build exception tables
+   --  See runtime routine Ada.Exceptions for full details on the format and
+   --  content of these tables.
+
+   procedure Initialize;
+   --  Initializes these data structures for a new main unit file
+
+   procedure Expand_At_End_Handler (HSS : Node_Id; Block : Node_Id);
+   --  Given a handled statement sequence, HSS, for which the At_End_Proc
+   --  field is set, and which currently has no exception handlers, this
+   --  procedure expands the special exception handler required.
+   --  This procedure also create a new scope for the given Block, if
+   --  Block is not Empty.
+
+   procedure Expand_Exception_Handlers (HSS : Node_Id);
+   --  This procedure expands exception handlers, and is called as part
+   --  of the processing for Expand_N_Handled_Sequence_Of_Statements and
+   --  is also called from Expand_At_End_Handler. N is the handled sequence
+   --  of statements that has the exception handler(s) to be expanded. This
+   --  is also called to expand the special exception handler built for
+   --  accept bodies (see Exp_Ch9.Build_Accept_Body).
+
+   procedure Generate_Unit_Exception_Table;
+   --  Procedure called by main driver to generate unit exception table if
+   --  zero cost exceptions are enabled. See System.Exceptions for details.
+
+   function Is_Non_Ada_Error (E : Entity_Id) return Boolean;
+   --  This function is provided for Gigi use. It returns True if operating on
+   --  VMS, and the argument E is the entity for System.Aux_Dec.Non_Ada_Error.
+   --  This is used to generate the special matching code for this exception.
+
+   procedure Remove_Handler_Entries (N : Node_Id);
+   --  This procedure is called when optimization circuits determine that
+   --  an entire subtree can be removed. If the subtree contains handler
+   --  entries in zero cost exception mode, then such removal can lead to
+   --  dangling references to non-existent handlers in the handler table.
+   --  This procedure removes such references.
+
+   --------------------------------------
+   -- Subprogram_Descriptor Generation --
+   --------------------------------------
+
+   --  Subprogram descriptors are required for all subprograms, including
+   --  explicit subprograms defined in the program, subprograms that are
+   --  imported via pragma Import, and also for the implicit elaboration
+   --  subprograms used to elaborate package specs and bodies.
+
+   procedure Generate_Subprogram_Descriptor_For_Package
+     (N    : Node_Id;
+      Spec : Entity_Id);
+   --  This is used to create a descriptor for the implicit elaboration
+   --  procedure for a package spec of body. The compiler only generates
+   --  such descriptors if the package spec or body contains exception
+   --  handlers (either explicitly in the case of a body, or from generic
+   --  package instantiations). N is the node for the package body or
+   --  spec, and Spec is the package body or package entity respectively.
+   --  N must be a compilation unit, and the descriptor is placed at
+   --  the end of the actions for the auxiliary compilation unit node.
+
+   procedure Generate_Subprogram_Descriptor_For_Subprogram
+     (N    : Node_Id;
+      Spec : Entity_Id);
+   --  This is used to create a desriptor for a subprogram, both those
+   --  present in the source, and those implicitly generated by code
+   --  expansion. N is the subprogram body node, and Spec is the entity
+   --  for the subprogram. The descriptor is placed at the end of the
+   --  Last exception handler, or, if there are no handlers, at the end
+   --  of the statement sequence.
+
+   procedure Generate_Subprogram_Descriptor_For_Imported_Subprogram
+     (Spec  : Entity_Id;
+      Slist : List_Id);
+   --  This is used to create a descriptor for an imported subprogram.
+   --  Such descriptors are needed for propagation of exceptions through
+   --  such subprograms. The descriptor never references any handlers,
+   --  and is appended to the given Slist.
+
+end Exp_Ch11;

gcc/ada/exp_ch12.adb

+------------------------------------------------------------------------------
+--                                                                          --
+--                         GNAT COMPILER COMPONENTS                         --
+--                                                                          --
+--                             E X P _ C H 1 2                              --
+--                                                                          --
+--                                 B o d y                                  --
+--                                                                          --
+--                            $Revision: 1.7 $
+--                                                                          --
+--          Copyright (C) 1997-2001 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 2,  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 COPYING.  If not, write --
+-- to  the Free Software Foundation,  59 Temple Place - Suite 330,  Boston, --
+-- MA 02111-1307, USA.                                                      --
+--                                                                          --
+-- GNAT was originally developed  by the GNAT team at  New York University. --
+-- It is now maintained by Ada Core Technologies Inc (http://www.gnat.com). --
+--                                                                          --
+------------------------------------------------------------------------------
+
+with Atree;    use Atree;
+with Checks;   use Checks;
+with Einfo;    use Einfo;
+with Exp_Util; use Exp_Util;
+with Nmake;    use Nmake;
+with Sinfo;    use Sinfo;
+with Stand;    use Stand;
+with Tbuild;   use Tbuild;
+
+package body Exp_Ch12 is
+
+   ------------------------------------
+   -- Expand_N_Generic_Instantiation --
+   ------------------------------------
+
+   --  If elaboration entity is defined and this is not an outer level entity,
+   --  we need to generate a check for it here.
+
+   procedure Expand_N_Generic_Instantiation (N : Node_Id) is
+      Loc : constant Source_Ptr := Sloc (N);
+      Ent : constant Entity_Id  := Entity (Name (N));
+
+   begin
+      if Etype (Name (N)) = Any_Type then
+         return;
+      end if;
+
+      if Present (Elaboration_Entity (Ent))
+        and then not Is_Compilation_Unit (Ent)
+        and then not Elaboration_Checks_Suppressed (Ent)
+      then
+         Insert_Action (Instance_Spec (N),
+           Make_Raise_Program_Error (Loc,
+             Condition =>
+               Make_Op_Not (Loc,
+                 Right_Opnd =>
+                   New_Occurrence_Of (Elaboration_Entity (Ent), Loc))));
+      end if;
+   end Expand_N_Generic_Instantiation;
+
+end Exp_Ch12;

gcc/ada/exp_ch12.ads

+------------------------------------------------------------------------------
+--                                                                          --
+--                         GNAT COMPILER COMPONENTS                         --
+--                                                                          --
+--                             E X P _ C H 1 2                              --
+--                                                                          --
+--                                 S p e c                                  --
+--                                                                          --
+--                            $Revision: 1.4 $                              --
+--                                                                          --
+--          Copyright (C) 1992-1997 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 2,  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 COPYING.  If not, write --
+-- to  the Free Software Foundation,  59 Temple Place - Suite 330,  Boston, --
+-- MA 02111-1307, USA.                                                      --
+--                                                                          --
+-- GNAT was originally developed  by the GNAT team at  New York University. --
+-- It is now maintained by Ada Core Technologies Inc (http://www.gnat.com). --
+--                                                                          --
+------------------------------------------------------------------------------
+
+--  Expand routines for chapter 12 constructs
+
+with Types; use Types;
+
+package Exp_Ch12 is
+   procedure Expand_N_Generic_Instantiation (N : Node_Id);
+end Exp_Ch12;

gcc/ada/exp_ch13.ads

+------------------------------------------------------------------------------
+--                                                                          --
+--                         GNAT COMPILER COMPONENTS                         --
+--                                                                          --
+--                             E X P _ C H 1 3                              --
+--                                                                          --
+--                                 S p e c                                  --
+--                                                                          --
+--                            $Revision: 1.6 $                              --
+--                                                                          --
+--        Copyright (C) 1992,1993,1994 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 2,  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 COPYING.  If not, write --
+-- to  the Free Software Foundation,  59 Temple Place - Suite 330,  Boston, --
+-- MA 02111-1307, USA.                                                      --
+--                                                                          --
+-- GNAT was originally developed  by the GNAT team at  New York University. --
+-- It is now maintained by Ada Core Technologies Inc (http://www.gnat.com). --
+--                                                                          --
+------------------------------------------------------------------------------
+
+--  Expand routines for chapter 13 constructs
+
+with Types; use Types;
+
+package Exp_Ch13 is
+
+   procedure Expand_N_Attribute_Definition_Clause  (N : Node_Id);
+   procedure Expand_N_Freeze_Entity                (N : Node_Id);
+   procedure Expand_N_Record_Representation_Clause (N : Node_Id);
+
+end Exp_Ch13;

gcc/ada/exp_ch2.ads

+------------------------------------------------------------------------------
+--                                                                          --
+--                         GNAT COMPILER COMPONENTS                         --
+--                                                                          --
+--                              E X P _ C H 2                               --
+--                                                                          --
+--                                 S p e c                                  --
+--                                                                          --
+--                            $Revision: 1.7 $                              --
+--                                                                          --
+--          Copyright (C) 1992-1997 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 2,  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 COPYING.  If not, write --
+-- to  the Free Software Foundation,  59 Temple Place - Suite 330,  Boston, --
+-- MA 02111-1307, USA.                                                      --
+--                                                                          --
+-- GNAT was originally developed  by the GNAT team at  New York University. --
+-- It is now maintained by Ada Core Technologies Inc (http://www.gnat.com). --
+--                                                                          --
+------------------------------------------------------------------------------
+
+--  Expand routines for chapter 2 constructs
+
+with Types; use Types;
+package Exp_Ch2 is
+
+   procedure Expand_N_Expanded_Name  (N : Node_Id);
+   procedure Expand_N_Identifier     (N : Node_Id);
+   procedure Expand_N_Real_Literal   (N : Node_Id);
+
+   function Param_Entity (N : Node_Id) return Entity_Id;
+   --  Given an expression N, determines if the expression is a reference
+   --  to a formal (of a subprogram or entry), and if so returns the Id
+   --  of the corresponding formal entity, otherwise returns Empty. The
+   --  reason that this is in Exp_Ch2 is that it has to deal with the
+   --  case where the reference is to an entry formal, and has been
+   --  expanded already. Since Exp_Ch2 is in charge of the expansion, it
+   --  is best suited to knowing how to detect this case.
+
+end Exp_Ch2;

gcc/ada/exp_ch3.ads

+------------------------------------------------------------------------------
+--                                                                          --
+--                         GNAT COMPILER COMPONENTS                         --
+--                                                                          --
+--                              E X P _ C H 3                               --
+--                                                                          --
+--                                 S p e c                                  --
+--                                                                          --
+--                            $Revision: 1.36 $
+--                                                                          --
+--           Copyright (C) 1992-2001 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 2,  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 COPYING.  If not, write --
+-- to  the Free Software Foundation,  59 Temple Place - Suite 330,  Boston, --
+-- MA 02111-1307, USA.                                                      --
+--                                                                          --
+-- GNAT was originally developed  by the GNAT team at  New York University. --
+-- It is now maintained by Ada Core Technologies Inc (http://www.gnat.com). --
+--                                                                          --
+------------------------------------------------------------------------------
+
+--  Expand routines for chapter 3 constructs
+
+with Types; use Types;
+with Elists; use Elists;
+
+package Exp_Ch3 is
+
+   procedure Expand_N_Object_Declaration         (N : Node_Id);
+   procedure Expand_N_Subtype_Indication         (N : Node_Id);
+   procedure Expand_N_Variant_Part               (N : Node_Id);
+   procedure Expand_N_Full_Type_Declaration      (N : Node_Id);
+
+   procedure Expand_Previous_Access_Type (N : Node_Id; Def_Id : Entity_Id);
+   --  For a full type declaration that contains tasks,  or that is a task,
+   --  check whether there exists an access type whose designated type is an
+   --  incomplete declarations for the current composite type. If so, build
+   --  the master for that access type, now that it is known to denote an
+   --  object with tasks.
+
+   procedure Expand_Derived_Record (T : Entity_Id; Def : Node_Id);
+   --  Add a field _parent in the extension part of the record.
+
+   procedure Build_Discr_Checking_Funcs (N : Node_Id);
+   --  Builds function which checks whether the component name is consistent
+   --  with the current discriminants. N is the full type declaration node,
+   --  and the discriminant checking functions are inserted after this node.
+
+   function Build_Initialization_Call
+     (Loc          : Source_Ptr;
+      Id_Ref       : Node_Id;
+      Typ          : Entity_Id;
+      In_Init_Proc : Boolean := False;
+      Enclos_Type  : Entity_Id := Empty;
+      Discr_Map    : Elist_Id := New_Elmt_List)
+      return         List_Id;
+   --  Builds a call to the initialization procedure of the Id entity. Id_Ref
+   --  is either a new reference to Id (for record fields), or an indexed
+   --  component (for array elements). Loc is the source location for the
+   --  constructed tree, and Typ is the type of the entity (the initialization
+   --  procedure of the base type is the procedure that actually gets called).
+   --  In_Init_Proc has to be set to True when the call is itself in an Init
+   --  procedure in order to enable the use of discriminals. Enclos_type is
+   --  the type of the init_proc and it is used for various expansion cases
+   --  including the case where Typ is a task type which is a array component,
+   --  the indices of the enclosing type are used to build the string that
+   --  identifies each task at runtime.
+   --
+   --  Discr_Map is used to replace discriminants by their discriminals in
+   --  expressions used to constrain record components. In the presence of
+   --  entry families bounded by discriminants, protected type discriminants
+   --  can appear within expressions in array bounds (not as stand-alone
+   --  identifiers) and a general replacement is necessary.
+
+   procedure Freeze_Type (N : Node_Id);
+   --  This procedure executes the freezing actions associated with the given
+   --  freeze type node N.
+
+   function Needs_Simple_Initialization (T : Entity_Id) return Boolean;
+   --  Certain types need initialization even though there is no specific
+   --  initialization routine. In this category are access types (which
+   --  need initializing to null), packed array types whose implementation
+   --  is a modular type, and all scalar types if Normalize_Scalars is set,
+   --  as well as private types whose underlying type is present and meets
+   --  any of these criteria. Finally, descendants of String and Wide_String
+   --  also need initialization in Initialize/Normalize_Scalars mode.
+
+   function Get_Simple_Init_Val
+     (T    : Entity_Id;
+      Loc  : Source_Ptr)
+      return Node_Id;
+   --  For a type which Needs_Simple_Initialization (see above), prepares
+   --  the tree for an expression representing the required initial value.
+   --  Loc is the source location used in constructing this tree which is
+   --  returned as the result of the call.
+
+end Exp_Ch3;

gcc/ada/exp_ch4.ads

+------------------------------------------------------------------------------
+--                                                                          --
+--                         GNAT COMPILER COMPONENTS                         --
+--                                                                          --
+--                              E X P _ C H 4                               --
+--                                                                          --
+--                                 S p e c                                  --
+--                                                                          --
+--                            $Revision: 1.42 $
+--                                                                          --
+--          Copyright (C) 1992-2001 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 2,  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 COPYING.  If not, write --
+-- to  the Free Software Foundation,  59 Temple Place - Suite 330,  Boston, --
+-- MA 02111-1307, USA.                                                      --
+--                                                                          --
+-- GNAT was originally developed  by the GNAT team at  New York University. --
+-- It is now maintained by Ada Core Technologies Inc (http://www.gnat.com). --
+--                                                                          --
+------------------------------------------------------------------------------
+
+--  Expand routines for chapter 4 constructs
+
+with Types; use Types;
+
+package Exp_Ch4 is
+
+   procedure Expand_N_Allocator                   (N : Node_Id);
+   procedure Expand_N_And_Then                    (N : Node_Id);
+   procedure Expand_N_Conditional_Expression      (N : Node_Id);
+   procedure Expand_N_In                          (N : Node_Id);
+   procedure Expand_N_Explicit_Dereference        (N : Node_Id);
+   procedure Expand_N_Indexed_Component           (N : Node_Id);
+   procedure Expand_N_Not_In                      (N : Node_Id);
+   procedure Expand_N_Null                        (N : Node_Id);
+   procedure Expand_N_Op_Abs                      (N : Node_Id);
+   procedure Expand_N_Op_Add                      (N : Node_Id);
+   procedure Expand_N_Op_And                      (N : Node_Id);
+   procedure Expand_N_Op_Concat                   (N : Node_Id);
+   procedure Expand_N_Op_Divide                   (N : Node_Id);
+   procedure Expand_N_Op_Expon                    (N : Node_Id);
+   procedure Expand_N_Op_Eq                       (N : Node_Id);
+   procedure Expand_N_Op_Ge                       (N : Node_Id);
+   procedure Expand_N_Op_Gt                       (N : Node_Id);
+   procedure Expand_N_Op_Le                       (N : Node_Id);
+   procedure Expand_N_Op_Lt                       (N : Node_Id);
+   procedure Expand_N_Op_Minus                    (N : Node_Id);
+   procedure Expand_N_Op_Mod                      (N : Node_Id);
+   procedure Expand_N_Op_Multiply                 (N : Node_Id);
+   procedure Expand_N_Op_Ne                       (N : Node_Id);
+   procedure Expand_N_Op_Not                      (N : Node_Id);
+   procedure Expand_N_Op_Or                       (N : Node_Id);
+   procedure Expand_N_Op_Plus                     (N : Node_Id);
+   procedure Expand_N_Op_Rem                      (N : Node_Id);
+   procedure Expand_N_Op_Rotate_Left              (N : Node_Id);
+   procedure Expand_N_Op_Rotate_Right             (N : Node_Id);
+   procedure Expand_N_Op_Shift_Left               (N : Node_Id);
+   procedure Expand_N_Op_Shift_Right              (N : Node_Id);
+   procedure Expand_N_Op_Shift_Right_Arithmetic   (N : Node_Id);
+   procedure Expand_N_Op_Subtract                 (N : Node_Id);
+   procedure Expand_N_Op_Xor                      (N : Node_Id);
+   procedure Expand_N_Or_Else                     (N : Node_Id);
+   procedure Expand_N_Qualified_Expression        (N : Node_Id);
+   procedure Expand_N_Selected_Component          (N : Node_Id);
+   procedure Expand_N_Slice                       (N : Node_Id);
+   procedure Expand_N_Type_Conversion             (N : Node_Id);
+   procedure Expand_N_Unchecked_Expression        (N : Node_Id);
+   procedure Expand_N_Unchecked_Type_Conversion   (N : Node_Id);
+
+   function Expand_Record_Equality
+     (Nod    : Node_Id;
+      Typ    : Entity_Id;
+      Lhs    : Node_Id;
+      Rhs    : Node_Id;
+      Bodies : List_Id)
+      return Node_Id;
+   --  Expand a record equality into an expression that compares the fields
+   --  individually to yield the required Boolean result. Loc is the
+   --  location for the generated nodes. Typ is the type of the record, and
+   --  Lhs, Rhs are the record expressions to be compared, these
+   --  expressions need not to be analyzed but have to be side-effect free.
+   --  Bodies is a list on which to attach bodies of local functions that
+   --  are created in the process. This is the responsability of the caller
+   --  to insert those bodies at the right place. Nod provdies the Sloc
+   --  value for generated code.
+
+end Exp_Ch4;

gcc/ada/exp_ch5.ads

+------------------------------------------------------------------------------
+--                                                                          --
+--                         GNAT COMPILER COMPONENTS                         --
+--                                                                          --
+--                              E X P _ C H 5                               --
+--                                                                          --
+--                                 S p e c                                  --
+--                                                                          --
+--                            $Revision: 1.15 $
+--                                                                          --
+--          Copyright (C) 1992-1999, 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 2,  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 COPYING.  If not, write --
+-- to  the Free Software Foundation,  59 Temple Place - Suite 330,  Boston, --
+-- MA 02111-1307, USA.                                                      --
+--                                                                          --
+-- GNAT was originally developed  by the GNAT team at  New York University. --
+-- It is now maintained by Ada Core Technologies Inc (http://www.gnat.com). --
+--                                                                          --
+------------------------------------------------------------------------------
+
+--  Expand routines for chapter 5 constructs
+
+with Types; use Types;
+
+package Exp_Ch5 is
+   procedure Expand_N_Assignment_Statement (N : Node_Id);
+   procedure Expand_N_Block_Statement      (N : Node_Id);
+   procedure Expand_N_Case_Statement       (N : Node_Id);
+   procedure Expand_N_Exit_Statement       (N : Node_Id);
+   procedure Expand_N_Goto_Statement       (N : Node_Id);
+   procedure Expand_N_If_Statement         (N : Node_Id);
+   procedure Expand_N_Loop_Statement       (N : Node_Id);
+   procedure Expand_N_Return_Statement     (N : Node_Id);
+end Exp_Ch5;

gcc/ada/exp_ch6.ads

+------------------------------------------------------------------------------
+--                                                                          --
+--                         GNAT COMPILER COMPONENTS                         --
+--                                                                          --
+--                              E X P _ C H 6                               --
+--                                                                          --
+--                                 S p e c                                  --
+--                                                                          --
+--                            $Revision: 1.13 $                             --
+--                                                                          --
+--     Copyright (C) 1992,1993,1994,1995 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 2,  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 COPYING.  If not, write --
+-- to  the Free Software Foundation,  59 Temple Place - Suite 330,  Boston, --
+-- MA 02111-1307, USA.                                                      --
+--                                                                          --
+-- GNAT was originally developed  by the GNAT team at  New York University. --
+-- It is now maintained by Ada Core Technologies Inc (http://www.gnat.com). --
+--                                                                          --
+------------------------------------------------------------------------------
+
+--  Expand routines for chapter 6 constructs
+
+with Types; use Types;
+
+package Exp_Ch6 is
+
+   procedure Expand_N_Function_Call            (N : Node_Id);
+   procedure Expand_N_Subprogram_Body          (N : Node_Id);
+   procedure Expand_N_Subprogram_Body_Stub     (N : Node_Id);
+   procedure Expand_N_Subprogram_Declaration   (N : Node_Id);
+   procedure Expand_N_Procedure_Call_Statement (N : Node_Id);
+
+   procedure Expand_Call (N : Node_Id);
+   --  This procedure contains common processing for Expand_N_Function_Call,
+   --  Expand_N_Procedure_Statement, and Expand_N_Entry_Call.
+
+   procedure Freeze_Subprogram (N : Node_Id);
+   --  generate the appropriate expansions related to Subprogram freeze
+   --  nodes (e. g. the filling of the corresponding Dispatch Table for
+   --  Primitive Operations)
+
+end Exp_Ch6;

gcc/ada/exp_ch7.ads

+------------------------------------------------------------------------------
+--                                                                          --
+--                         GNAT COMPILER COMPONENTS                         --
+--                                                                          --
+--                              E X P _ C H 7                               --
+--                                                                          --
+--                                 S p e c                                  --
+--                                                                          --
+--                            $Revision: 1.42 $
+--                                                                          --
+--          Copyright (C) 1992-2000 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 2,  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 COPYING.  If not, write --
+-- to  the Free Software Foundation,  59 Temple Place - Suite 330,  Boston, --
+-- MA 02111-1307, USA.                                                      --
+--                                                                          --
+-- GNAT was originally developed  by the GNAT team at  New York University. --
+-- It is now maintained by Ada Core Technologies Inc (http://www.gnat.com). --
+--                                                                          --
+------------------------------------------------------------------------------
+
+with Types; use Types;
+
+package Exp_Ch7 is
+
+   procedure Expand_N_Package_Body        (N : Node_Id);
+   procedure Expand_N_Package_Declaration (N : Node_Id);
+
+   ------------------------------
+   --  Finalization Management --
+   ------------------------------
+
+   function In_Finalization_Root (E : Entity_Id) return Boolean;
+   --  True if current scope is in package System.Finalization_Root. Used
+   --  to avoid certain expansions that would involve circularity in the
+   --  Rtsfind mechanism.
+
+   procedure Build_Final_List (N : Node_Id; Typ : Entity_Id);
+   --  Build finalization list for anonymous access types, and for access
+   --  types that are frozen before their designated types are known to
+   --  be controlled.
+
+   procedure Build_Controlling_Procs (Typ : Entity_Id);
+   --  Typ is a record, and array type having controlled components.
+   --  Create the procedures Deep_Initialize, Deep_Adjust and Deep_Finalize
+   --  that take care of finalization management at run-time.
+
+   function Controller_Component (Typ : Entity_Id) return Entity_Id;
+   --  Returns the entity of the component whose name is 'Name_uController'
+
+   function Controlled_Type (T : Entity_Id) return Boolean;
+   --  True if T potentially needs finalization actions
+
+   function Find_Final_List
+     (E    : Entity_Id;
+      Ref  : Node_Id := Empty)
+      return Node_Id;
+      --  E is an entity representing a controlled object, a controlled type
+      --  or a scope. If Ref is not empty, it is a reference to a controlled
+      --  record, the closest Final list is in the controller component of
+      --  the record containing Ref otherwise this function returns a
+      --  reference to the final list attached to the closest dynamic scope
+      --  (that can be E itself) creating this final list if necessary.
+
+   function Has_New_Controlled_Component (E : Entity_Id) return Boolean;
+   --  E is a type entity. Give the same resul as Has_Controlled_Component
+   --  except for tagged extensions where the result is True only if the
+   --  latest extension contains a controlled component.
+
+   function Make_Attach_Call
+     (Obj_Ref      : Node_Id;
+      Flist_Ref    : Node_Id;
+      With_Attach  : Node_Id)
+      return         Node_Id;
+   --  Attach the referenced object to the referenced Final Chain
+   --  'Flist_Ref' With_Attach is an expression of type Short_Short_Integer
+   --  which can be either '0' to signify no attachment, '1' for
+   --  attachement to a simply linked list or '2' for attachement to a
+   --  doubly linked list.
+
+   function Make_Init_Call
+     (Ref          : Node_Id;
+      Typ          : Entity_Id;
+      Flist_Ref    : Node_Id;
+      With_Attach  : Node_Id)
+      return         List_Id;
+   --  Ref is an expression (with no-side effect and is not required to
+   --  have been previously analyzed) that references the object to be
+   --  initialized. Typ is the expected type of Ref, which is a controlled
+   --  type (Is_Controlled) or a type with controlled components
+   --  (Has_Controlled). 'Dynamic_Case' controls the way the object is
+   --  attached which is different whether the object is dynamically
+   --  allocated or not.
+   --
+   --  This function will generate the appropriate calls to make
+   --  sure that the objects referenced by Ref are initialized. The
+   --  generate code is quite different depending on the fact the type
+   --  IS_Controlled or HAS_Controlled but this is not the problem of the
+   --  caller, the details are in the body.
+
+   function Make_Adjust_Call
+     (Ref          : Node_Id;
+      Typ          : Entity_Id;
+      Flist_Ref    : Node_Id;
+      With_Attach  : Node_Id)
+      return         List_Id;
+   --  Ref is an expression (with no-side effect and is not required to
+   --  have been previously analyzed) that references the object to be
+   --  adjusted. Typ is the expected type of Ref, which is a controlled
+   --  type (Is_Controlled) or a type with controlled components
+   --  (Has_Controlled).
+   --
+   --  This function will generate the appropriate calls to make
+   --  sure that the objects referenced by Ref are adjusted. The generated
+   --  code is quite different depending on the fact the type IS_Controlled
+   --  or HAS_Controlled but this is not the problem of the caller, the
+   --  details are in the body. If the parameter With_Attach is set to
+   --  True, the finalizable objects involved are attached to the proper
+   --  finalization chain. The objects must be attached when the adjust
+   --  takes place after an initialization expression but not when it takes
+   --  place after a regular assignment.
+   --
+   --  The description of With_Attach is completely obsolete ???
+
+   function Make_Final_Call
+     (Ref         : Node_Id;
+      Typ         : Entity_Id;
+      With_Detach : Node_Id)
+      return        List_Id;
+   --  Ref is an expression (with no-side effect and is not required to
+   --  have been previously analyzed) that references the object
+   --  to be Finalized. Typ is the expected type of Ref, which is a
+   --  controlled type (Is_Controlled) or a type with controlled
+   --  components (Has_Controlled).
+   --
+   --  This function will generate the appropriate calls to make
+   --  sure that the objects referenced by Ref are finalized. The generated
+   --  code is quite different depending on the fact the type IS_Controlled
+   --  or HAS_Controlled but this is not the problem of the caller, the
+   --  details are in the body. If the parameter With_Detach is set to
+   --  True, the finalizable objects involved are detached from the proper
+   --  finalization chain. The objects must be detached when finalizing an
+   --  unchecked deallocated object but not when finalizing the target of
+   --  an assignment, it is not necessary either on scope exit.
+
+   procedure Expand_Ctrl_Function_Call (N : Node_Id);
+   --  Expand a call to a function returning a controlled value. That is to
+   --  say attach the result of the call to the current finalization list,
+   --  which is the one of the transient scope created for such constructs.
+
+   --------------------------------
+   -- Transient Scope Management --
+   --------------------------------
+
+   procedure Expand_Cleanup_Actions (N : Node_Id);
+   --  Expand the necessary stuff into a scope to enable finalization of local
+   --  objects and deallocation of transient data when exiting the scope. N is
+   --  a "scope node" that is to say one of the following: N_Block_Statement,
+   --  N_Subprogram_Body, N_Task_Body, N_Entry_Body.
+
+   procedure Establish_Transient_Scope (N : Node_Id; Sec_Stack : Boolean);
+   --  Push a new transient scope on the scope stack. N is the node responsible
+   --  for the need of a transient scope. If Sec_Stack is True then the
+   --  secondary stack is brought in, otherwise it isn't.
+
+   function Node_To_Be_Wrapped return Node_Id;
+   --  return the node to be wrapped if the current scope is transient.
+
+   procedure Store_Before_Actions_In_Scope (L : List_Id);
+   --  Append the list L of actions to the end of the before-actions store
+   --  in the top of the scope stack
+
+   procedure Store_After_Actions_In_Scope (L : List_Id);
+   --  Append the list L of actions to the beginning of the after-actions
+   --  store in the top of the scope stack
+
+   procedure Wrap_Transient_Declaration (N : Node_Id);
+   --  N is an object declaration. Expand the finalization calls after the
+   --  declaration and make the outer scope beeing the transient one.
+
+   procedure Wrap_Transient_Expression (N : Node_Id);
+   --  N is a sub-expression. Expand a transient block around an expression
+
+   procedure Wrap_Transient_Statement (N : Node_Id);
+   --  N is a statement. Expand a transient block around an instruction
+
+end Exp_Ch7;

gcc/ada/exp_ch8.ads

+------------------------------------------------------------------------------
+--                                                                          --
+--                         GNAT COMPILER COMPONENTS                         --
+--                                                                          --
+--                              E X P _ C H 8                               --
+--                                                                          --
+--                                 S p e c                                  --
+--                                                                          --
+--                            $Revision: 1.7 $
+--                                                                          --
+--          Copyright (C) 1992-2000 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 2,  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 COPYING.  If not, write --
+-- to  the Free Software Foundation,  59 Temple Place - Suite 330,  Boston, --
+-- MA 02111-1307, USA.                                                      --
+--                                                                          --
+-- GNAT was originally developed  by the GNAT team at  New York University. --
+-- It is now maintained by Ada Core Technologies Inc (http://www.gnat.com). --
+--                                                                          --
+------------------------------------------------------------------------------
+
+--  Expand routines for chapter 8 constructs
+
+with Types; use Types;
+
+package Exp_Ch8 is
+   procedure Expand_N_Exception_Renaming_Declaration  (N : Node_Id);
+   procedure Expand_N_Object_Renaming_Declaration     (N : Node_Id);
+   procedure Expand_N_Package_Renaming_Declaration    (N : Node_Id);
+end Exp_Ch8;

gcc/ada/exp_code.ads

+------------------------------------------------------------------------------
+--                                                                          --
+--                         GNAT COMPILER COMPONENTS                         --
+--                                                                          --
+--                             E X P _ C O D E                              --
+--                                                                          --
+--                                 S p e c                                  --
+--                                                                          --
+--                            $Revision: 1.5 $                              --
+--                                                                          --
+--             Copyright (C) 1996 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 2,  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 COPYING.  If not, write --
+-- to  the Free Software Foundation,  59 Temple Place - Suite 330,  Boston, --
+-- MA 02111-1307, USA.                                                      --
+--                                                                          --
+-- GNAT was originally developed  by the GNAT team at  New York University. --
+-- It is now maintained by Ada Core Technologies Inc (http://www.gnat.com). --
+--                                                                          --
+------------------------------------------------------------------------------
+
+--  Processing for handling code statements
+
+with Types; use Types;
+
+with System; use System;
+package Exp_Code is
+
+   procedure Expand_Asm_Call (N : Node_Id);
+   --  Expands a call to Asm or Asm_Volatile into an equivalent
+   --  N_Code_Statement node.
+
+   --  The following routines provide an abstract interface to analyze
+   --  code statements, for use by Gigi processing for code statements.
+   --  Note that the implementations of these routines must not attempt
+   --  to expand tables that are frozen on entry to Gigi.
+
+   function Is_Asm_Volatile (N : Node_Id) return Boolean;
+   --  Given an N_Code_Statement node N, return True in the Asm_Volatile
+   --  case and False in the Asm case.
+
+   function Asm_Template (N : Node_Id) return Node_Id;
+   --  Given an N_Code_Statement node N, returns string literal node for
+   --  template in call
+
+   procedure Clobber_Setup (N : Node_Id);
+   --  Given an N_Code_Statement node N, setup to process the clobber list
+   --  with subsequent calls to Clobber_Get_Next.
+
+   function Clobber_Get_Next return System.Address;
+   --  Can only be called after a previous call to Clobber_Setup. The
+   --  returned value is a pointer to a null terminated (C format) string
+   --  for the next register argument. Null_Address is returned when there
+   --  are no more arguments.
+
+   procedure Setup_Asm_Inputs (N : Node_Id);
+   --  Given an N_Code_Statement node N, setup to read list of Asm_Input
+   --  arguments. The protocol is to construct a loop as follows:
+   --
+   --    Setup_Asm_Inputs (N);
+   --    while Present (Asm_Input_Value)
+   --      body
+   --      Next_Asm_Input;
+   --    end loop;
+   --
+   --  where the loop body calls Asm_Input_Constraint or Asm_Input_Value to
+   --  obtain the constraint string or input value expression from the current
+   --  Asm_Input argument.
+
+   function Asm_Input_Constraint return Node_Id;
+   --  Called within a loop initialized by Setup_Asm_Inputs and controlled
+   --  by Next_Asm_Input as described above. Returns a string literal node
+   --  for the constraint component of the current Asm_Input_Parameter, or
+   --  Empty if there are no more Asm_Input parameters.
+
+   function Asm_Input_Value return Node_Id;
+   --  Called within a loop initialized by Setup_Asm_Inputs and controlled
+   --  by Next_Asm_Input as described above. Returns the expression node for
+   --  the value component of the current Asm_Input parameter, or Empty if
+   --  there are no more Asm_Input parameters.
+
+   procedure Next_Asm_Input;
+   --  Step to next Asm_Input parameter. It is an error to call this procedure
+   --  if there are no more available parameters (which is impossible if the
+   --  call appears in a loop as in the above example).
+
+   procedure Setup_Asm_Outputs (N : Node_Id);
+   --  Given an N_Code_Statement node N, setup to read list of Asm_Output
+   --  arguments. The protocol is to construct a loop as follows:
+   --
+   --    Setup_Asm_Outputs (N);
+   --    while Present (Asm_Output_Value)
+   --      body
+   --      Next_Asm_Output;
+   --    end loop;
+   --
+   --  where the loop body calls Asm_Output_Constraint or Asm_Output_Variable
+   --  to obtain the constraint string or output variable name from the current
+   --  Asm_Output argument.
+
+   function Asm_Output_Constraint return Node_Id;
+   --  Called within a loop initialized by Setup_Asm_Outputs and controlled
+   --  by Next_Asm_Output as described above. Returns a string literal node
+   --  for the constraint component of the current Asm_Output_Parameter, or
+   --  Empty if there are no more Asm_Output parameters.
+
+   function Asm_Output_Variable return Node_Id;
+   --  Called within a loop initialized by Setup_Asm_Outputs and controlled
+   --  by Next_Asm_Output as described above. Returns the expression node for
+   --  the output variable component of the current Asm_Output parameter, or
+   --  Empty if there are no more Asm_Output parameters.
+
+   procedure Next_Asm_Output;
+   --  Step to next Asm_Output parameter. It is an error to call this procedure
+   --  if there are no more available parameters (which is impossible if the
+   --  call appears in a loop as in the above example).
+
+end Exp_Code;

gcc/ada/exp_disp.ads

+------------------------------------------------------------------------------
+--                                                                          --
+--                         GNAT COMPILER COMPONENTS                         --
+--                                                                          --
+--                             E X P _ D I S P                              --
+--                                                                          --
+--                                 S p e c                                  --
+--                                                                          --
+--                            $Revision: 1.9 $                              --
+--                                                                          --
+--          Copyright (C) 1992-1998 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 2,  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 COPYING.  If not, write --
+-- to  the Free Software Foundation,  59 Temple Place - Suite 330,  Boston, --
+-- MA 02111-1307, USA.                                                      --
+--                                                                          --
+-- GNAT was originally developed  by the GNAT team at  New York University. --
+-- It is now maintained by Ada Core Technologies Inc (http://www.gnat.com). --
+--                                                                          --
+------------------------------------------------------------------------------
+
+--  This package contains routines involved in tagged types and dynamic
+--  dispatching expansion
+
+with Types; use Types;
+package Exp_Disp is
+
+   type DT_Access_Action is
+      (CW_Membership,
+       DT_Entry_Size,
+       DT_Prologue_Size,
+       Get_Expanded_Name,
+       Get_External_Tag,
+       Get_Prim_Op_Address,
+       Get_RC_Offset,
+       Get_Remotely_Callable,
+       Get_TSD,
+       Inherit_DT,
+       Inherit_TSD,
+       Register_Tag,
+       Set_Expanded_Name,
+       Set_External_Tag,
+       Set_Prim_Op_Address,
+       Set_RC_Offset,
+       Set_Remotely_Callable,
+       Set_TSD,
+       TSD_Entry_Size,
+       TSD_Prologue_Size);
+
+
+   function Fill_DT_Entry
+     (Loc  : Source_Ptr;
+      Prim : Entity_Id)
+      return Node_Id;
+   --  Generate the code necessary to fill the appropriate entry of the
+   --  dispatch table of Prim's controlling type with Prim's address.
+
+   function Make_DT_Access_Action
+     (Typ    : Entity_Id;
+      Action : DT_Access_Action;
+      Args   : List_Id)
+      return Node_Id;
+   --  Generate a call to one of the Dispatch Table Access Subprograms defined
+   --  in Ada.Tags or in Interfaces.Cpp
+
+   function Make_DT (Typ : Entity_Id) return List_Id;
+   --  Expand the declarations for the Dispatch Table (or the Vtable in
+   --  the case of type whose ancestor is a CPP_Class)
+
+   procedure Set_All_DT_Position (Typ : Entity_Id);
+   --  Set the DT_Position field for each primitive operation. In the CPP
+   --  Class case check that no pragma CPP_Virtual is missing  and that the
+   --  DT_Position are coherent
+
+   procedure Expand_Dispatch_Call (Call_Node : Node_Id);
+   --  Expand the call to the operation through the dispatch table and perform
+   --  the required tag checks when appropriate. For CPP types the call is
+   --  done through the Vtable (tag checks are not relevant)
+
+   procedure Set_Default_Constructor (Typ : Entity_Id);
+   --  Typ is a CPP_Class type. Create the Init procedure of that type to
+   --  be the default constructor (i.e. the function returning this type,
+   --  having a pragma CPP_Constructor and no parameter)
+
+   function Get_Remotely_Callable (Obj : Node_Id) return Node_Id;
+   --  Return an expression that holds True if the object can be transmitted
+   --  onto another partition according to E.4 (18)
+
+end Exp_Disp;

gcc/ada/exp_dist.ads

+------------------------------------------------------------------------------
+--                                                                          --
+--                         GNAT COMPILER COMPONENTS                         --
+--                                                                          --
+--                             E X P _ D I S T                              --
+--                                                                          --
+--                                 S p e c                                  --
+--                                                                          --
+--                            $Revision: 1.18 $                             --
+--                                                                          --
+--          Copyright (C) 1992-1998 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 2,  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 COPYING.  If not, write --
+-- to  the Free Software Foundation,  59 Temple Place - Suite 330,  Boston, --
+-- MA 02111-1307, USA.                                                      --
+--                                                                          --
+-- GNAT was originally developed  by the GNAT team at  New York University. --
+-- It is now maintained by Ada Core Technologies Inc (http://www.gnat.com). --
+--                                                                          --
+------------------------------------------------------------------------------
+
+--  This package contains utility routines used for the generation of the
+--  stubs relevant to the distribution annex.
+
+with Types; use Types;
+
+package Exp_Dist is
+
+   procedure Add_RAST_Features (Vis_Decl : in Node_Id);
+   --  Build and add bodies for dereference and 'Access subprograms for a
+   --  remote access to subprogram type. Vis_Decl is the declaration node for
+   --  the RAS type.
+
+   procedure Add_RACW_Features (RACW_Type : in Entity_Id);
+   --  Add RACW features. If the RACW and the designated type are not in the
+   --  same scope, then Add_RACW_Primitive_Declarations_And_Bodies is called
+   --  automatically since we do know the primitive list already.
+
+   procedure Add_RACW_Primitive_Declarations_And_Bodies
+     (Designated_Type : in Entity_Id;
+      Insertion_Node  : in Node_Id;
+      Decls           : in List_Id);
+   --  Add primitive for the stub type, and the RPC receiver. The declarations
+   --  are inserted after insertion_Node, while the bodies are appened at the
+   --  end of Decls.
+
+   procedure Remote_Types_Tagged_Full_View_Encountered
+     (Full_View : in Entity_Id);
+   --  When a full view with a private view is encountered in a Remote_Types
+   --  package and corresponds to a tagged type, then this procedure is called
+   --  to generate the needed RACW features if it is needed.
+
+   procedure RACW_Type_Is_Asynchronous (RACW_Type : in Entity_Id);
+   --  This subprogram must be called when it is detected that the RACW type
+   --  is asynchronous.
+
+   procedure Expand_Calling_Stubs_Bodies (Unit_Node : in Node_Id);
+   --  Call the expansion phase for the calling stubs. The code will be added
+   --  at the end of the compilation unit, which is a package spec.
+
+   procedure Expand_Receiving_Stubs_Bodies (Unit_Node : in Node_Id);
+   --  Call the expansion phase for the calling stubs. The code will be added
+   --  at the end of the compilation unit, which may be either a package spec
+   --  or a package body.
+
+   procedure Expand_All_Calls_Remote_Subprogram_Call (N : in Node_Id);
+   --  Rewrite a call to a subprogram located in a Remote_Call_Interface
+   --  package on which the pragma All_Calls_Remote applies so that it
+   --  goes through the PCS. N is either an N_Procedure_Call_Statement
+   --  or an N_Function_Call node.
+
+   procedure Build_Passive_Partition_Stub (U : Node_Id);
+   --  Build stub for a shared passive package. U is the analyzed
+   --  compilation unit for a package declaration.
+
+end Exp_Dist;

gcc/ada/exp_fixd.ads

+------------------------------------------------------------------------------
+--                                                                          --
+--                         GNAT COMPILER COMPONENTS                         --
+--                                                                          --
+--                             E X P _ F I X D                              --
+--                                                                          --
+--                                 S p e c                                  --
+--                                                                          --
+--                            $Revision: 1.5 $                              --
+--                                                                          --
+--        Copyright (C) 1992,1993,1994 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 2,  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 COPYING.  If not, write --
+-- to  the Free Software Foundation,  59 Temple Place - Suite 330,  Boston, --
+-- MA 02111-1307, USA.                                                      --
+--                                                                          --
+-- GNAT was originally developed  by the GNAT team at  New York University. --
+-- It is now maintained by Ada Core Technologies Inc (http://www.gnat.com). --
+--                                                                          --
+------------------------------------------------------------------------------
+
+--  Expand routines for fixed-point convert, divide and multiply operations
+
+with Types; use Types;
+
+package Exp_Fixd is
+
+   --  General note on universal fixed. In the routines below, a fixed-point
+   --  type is always a specific fixed-point type or universal real, never
+   --  universal fixed. Universal fixed only appears as the result type of a
+   --  division or multplication and in all such cases, the parent node, which
+   --  must be either a conversion node or a 'Round attribute reference node,
+   --  has the specific type information. In both cases, the parent node is
+   --  removed from the tree, and the appropriate routine in this package is
+   --  called with a multiply or divide node with all types (and also possibly
+   --  the Rounded_Result flag) set.
+
+   ----------------------------
+   -- Fixed-Point Conversion --
+   ----------------------------
+
+   procedure Expand_Convert_Fixed_To_Fixed (N : Node_Id);
+   --  This routine expands the conversion of one fixed-point type to another,
+   --  N is the N_Op_Conversion node with the result and expression types (and
+   --  possibly the Rounded_Result flag) set.
+
+   procedure Expand_Convert_Fixed_To_Float (N : Node_Id);
+   --  This routine expands the conversion from a fixed-point type to a
+   --  floating-point type. N is an N_Type_Conversion node with the result
+   --  and expression types set.
+
+   procedure Expand_Convert_Fixed_To_Integer (N : Node_Id);
+   --  This routine expands the conversion from a fixed-point type to an
+   --  integer type. N is an N_Type_Conversion node with the result and
+   --  operand types set.
+
+   procedure Expand_Convert_Float_To_Fixed (N : Node_Id);
+   --  This routine expands the conversion from a floating-point type to
+   --  a fixed-point type. N is an N_Type_Conversion node with the result
+   --  and operand types (and possibly the Rounded_Result flag) set.
+
+   procedure Expand_Convert_Integer_To_Fixed (N : Node_Id);
+   --  This routine expands the conversion from an integer type to a
+   --  fixed-point type. N is an N_Type_Conversion node with the result
+   --  and operand types (and possibly the Rounded_Result flag) set.
+
+   --------------------------
+   -- Fixed-Point Division --
+   --------------------------
+
+   procedure Expand_Decimal_Divide_Call (N : Node_Id);
+   --  This routine expands a call to the procedure Decimal.Divide. The
+   --  argument N is the N_Function_Call node.
+
+   procedure Expand_Divide_Fixed_By_Fixed_Giving_Fixed (N : Node_Id);
+   --  This routine expands the division between fixed-point types, with
+   --  a fixed-point type result. N is an N_Op_Divide node with operand
+   --  and result types (and possibly the Rounded_Result flag) set. Either
+   --  (but not both) of the operands may be universal real.
+
+   procedure Expand_Divide_Fixed_By_Fixed_Giving_Float (N : Node_Id);
+   --  This routine expands the division between two fixed-point types with
+   --  a floating-point result. N is an N_Op_Divide node with the result
+   --  and operand types set. Either (but not both) of the operands may be
+   --  universal real.
+
+   procedure Expand_Divide_Fixed_By_Fixed_Giving_Integer (N : Node_Id);
+   --  This routine expands the division between two fixed-point types with
+   --  an integer type result. N is an N_Op_Divide node with the result and
+   --  operand types set. Either (but not both) of the operands may be
+   --  universal real.
+
+   procedure Expand_Divide_Fixed_By_Integer_Giving_Fixed (N : Node_Id);
+   --  This routine expands the division between a fixed-point type and
+   --  standard integer type. The result type is the same fixed-point type
+   --  as the operand type. N is an N_Op_Divide node with the result and
+   --  left operand types being the fixed-point type, and the right operand
+   --  type being standard integer (and possibly Rounded_Result set).
+
+   --------------------------------
+   -- Fixed-Point Multiplication --
+   --------------------------------
+
+   procedure Expand_Multiply_Fixed_By_Fixed_Giving_Fixed (N : Node_Id);
+   --  This routine expands the multiplication between fixed-point types
+   --  with a fixed-point type result. N is an N_Op_Multiply node with the
+   --  result and operand types set. Either (but not both) of the operands
+   --  may be universal real.
+
+   procedure Expand_Multiply_Fixed_By_Fixed_Giving_Float (N : Node_Id);
+   --  This routine expands the multiplication between two fixed-point types
+   --  with a floating-point result. N is an N_Op_Multiply node with the
+   --  result and operand types set. Either (but not both) of the operands
+   --  may be universal real.
+
+   procedure Expand_Multiply_Fixed_By_Fixed_Giving_Integer (N : Node_Id);
+   --  This routine expands the multiplication between two fixed-point types
+   --  with an integer result. N is an N_Op_Multiply node with the result
+   --  and operand types set. Either (but not both) of the operands may be
+   --  be universal real.
+
+   procedure Expand_Multiply_Fixed_By_Integer_Giving_Fixed (N : Node_Id);
+   --  This routine expands the multiplication between a fixed-point type and
+   --  a standard integer type. The result type is the same fixed-point type
+   --  as the fixed operand type. N is an N_Op_Multiply node whose result type
+   --  and left operand types are the fixed-point type, and whose right operand
+   --  type is always standard integer.
+
+   procedure Expand_Multiply_Integer_By_Fixed_Giving_Fixed (N : Node_Id);
+   --  This routine expands the multiplication between standard integer and a
+   --  fixed-point type. The result type is the same fixed-point type as the
+   --  the fixed operand type. N is an N_Op_Multiply node whose result type
+   --  and right operand types are the fixed-point type, and whose left operand
+   --  type is always standard integer.
+
+end Exp_Fixd;