[multiple changes]

2004-01-19  Arnaud Charlet  <charlet@act-europe.fr>

	* utils.c: Update copyright notice, missed in previous change.

2004-01-19  Vincent Celier  <celier@gnat.com>

	* mlib-prj.adb (Build_Library.Add_ALI_For): Only add the ALI to the
	args if Bind is True. Set First_ALI, if not already done.
	(Build_Library): For Stand Alone Libraries, extract from one ALI file
	an eventual --RTS switch, for gnatbind, and all backend switches +
	--RTS, for linking.

2004-01-19  Robert Dewar  <dewar@gnat.com>

	* sem_attr.adb, memtrack.adb: Minor reformatting

2004-01-19  Ed Schonberg  <schonberg@gnat.com>

	* exp_ch6.adb (Expand_Call): Remove code to fold calls to functions
	that rename enumeration literals. This is properly done in sem_eval.

	* sem_eval.ads, sem_eval.adb (Eval_Call): New procedure to fold calls
	to functions that rename enumeration literals.

	* sem_res.adb (Resolve_Call): Use Eval_Call to fold static calls to
	functions that rename enumeration literals.

From-SVN: r76146

9 files changed, 247 insertions, 81 deletions

diff --git a/gcc/ada/ChangeLog b/gcc/ada/ChangeLog
index fc3b66d..ae15e9d 100644
--- a/gcc/ada/ChangeLog
+++ b/gcc/ada/ChangeLog
@@ -1,3 +1,30 @@
+2004-01-19  Arnaud Charlet  <charlet@act-europe.fr>
+
+	* utils.c: Update copyright notice, missed in previous change.
+
+2004-01-19  Vincent Celier  <celier@gnat.com>
+
+	* mlib-prj.adb (Build_Library.Add_ALI_For): Only add the ALI to the
+	args if Bind is True. Set First_ALI, if not already done.
+	(Build_Library): For Stand Alone Libraries, extract from one ALI file
+	an eventual --RTS switch, for gnatbind, and all backend switches +
+	--RTS, for linking.
+
+2004-01-19  Robert Dewar  <dewar@gnat.com>
+
+	* sem_attr.adb, memtrack.adb: Minor reformatting
+
+2004-01-19  Ed Schonberg  <schonberg@gnat.com>
+
+	* exp_ch6.adb (Expand_Call): Remove code to fold calls to functions
+	that rename enumeration literals. This is properly done in sem_eval.
+
+	* sem_eval.ads, sem_eval.adb (Eval_Call): New procedure to fold calls
+	to functions that rename enumeration literals.
+
+	* sem_res.adb (Resolve_Call): Use Eval_Call to fold static calls to
+	functions that rename enumeration literals.
+
 2004-01-16  Kazu Hirata  <kazu@cs.umass.edu>
 
 	* Make-lang.in (utils.o): Depend on target.h.
diff --git a/gcc/ada/exp_ch6.adb b/gcc/ada/exp_ch6.adb
index fb73a0b..6a54343 100644
--- a/gcc/ada/exp_ch6.adb
+++ b/gcc/ada/exp_ch6.adb
@@ -6,7 +6,7 @@
 --                                                                          --
 --                                 B o d y                                  --
 --                                                                          --
---          Copyright (C) 1992-2003, Free Software Foundation, Inc.         --
+--          Copyright (C) 1992-2004, 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- --
@@ -1828,32 +1828,10 @@ package body Exp_Ch6 is
          Check_Restriction (No_Abort_Statements, N);
       end if;
 
-      --  Some more special cases for cases other than explicit dereference
-
-      if Nkind (Name (N)) /= N_Explicit_Dereference then
-
-         --  Calls to an enumeration literal are replaced by the literal
-         --  This case occurs only when we have a call to a function that
-         --  is a renaming of an enumeration literal. The normal case of
-         --  a direct reference to an enumeration literal has already been
-         --  been dealt with by Resolve_Call. If the function is itself
-         --  inherited (see 7423-001) the literal of the parent type must
-         --  be explicitly converted to the return type of the function.
-
-         if Ekind (Subp) = E_Enumeration_Literal then
-            if Base_Type (Etype (Subp)) /= Base_Type (Etype (N)) then
-               Rewrite
-                 (N, Convert_To (Etype (N), New_Occurrence_Of (Subp, Loc)));
-            else
-               Rewrite (N, New_Occurrence_Of (Subp, Loc));
-            end if;
-
-            Resolve (N);
-         end if;
+      if Nkind (Name (N)) = N_Explicit_Dereference then
 
       --  Handle case of access to protected subprogram type
 
-      else
          if Ekind (Base_Type (Etype (Prefix (Name (N))))) =
                                E_Access_Protected_Subprogram_Type
          then
diff --git a/gcc/ada/memtrack.adb b/gcc/ada/memtrack.adb
index 75000b0..2531702 100644
--- a/gcc/ada/memtrack.adb
+++ b/gcc/ada/memtrack.adb
@@ -235,6 +235,7 @@ package body System.Memory is
 
    procedure Free (Ptr : System.Address) is
       Addr : aliased constant System.Address := Ptr;
+
    begin
       Lock_Task.all;
 
@@ -265,7 +266,6 @@ package body System.Memory is
          c_free (Ptr);
 
          First_Call := True;
-
       end if;
 
       Unlock_Task.all;
@@ -280,10 +280,12 @@ package body System.Memory is
       if Needs_Init then
          Needs_Init := False;
          Gmemfile := fopen (Gmemfname, "wb" & ASCII.NUL);
+
          if Gmemfile = System.Null_Address then
             Put_Line ("Couldn't open gnatmem log file for writing");
             OS_Exit (255);
          end if;
+
          fwrite ("GMEM DUMP" & ASCII.LF, 10, 1, Gmemfile);
       end if;
    end Gmem_Initialize;
@@ -296,6 +298,7 @@ package body System.Memory is
      (Ptr : System.Address; Size : size_t) return System.Address
    is
       Result : System.Address;
+
    begin
       if Size = size_t'Last then
          Raise_Exception (Storage_Error'Identity, "object too large");
diff --git a/gcc/ada/mlib-prj.adb b/gcc/ada/mlib-prj.adb
index 19149c0..daaed1c 100644
--- a/gcc/ada/mlib-prj.adb
+++ b/gcc/ada/mlib-prj.adb
@@ -6,7 +6,7 @@
 --                                                                          --
 --                                 B o d y                                  --
 --                                                                          --
---              Copyright (C) 2001-2003, Ada Core Technologies, Inc.        --
+--              Copyright (C) 2001-2004, Ada Core Technologies, 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- --
@@ -39,6 +39,7 @@ with Prj.Env;  use Prj.Env;
 with Prj.Util; use Prj.Util;
 with Sinput.P;
 with Snames;   use Snames;
+with Switch;   use Switch;
 with Table;
 with Types;    use Types;
 
@@ -353,6 +354,9 @@ package body MLib.Prj is
       Copy_Dir : Name_Id;
       --  Directory where to copy ALI files and possibly interface sources
 
+      First_ALI : Name_Id := No_Name;
+      --  Store the ALI file name of a source of the library (the first found)
+
       procedure Add_ALI_For (Source : Name_Id);
       --  Add the name of the ALI file corresponding to Source to the
       --  Arguments.
@@ -386,14 +390,27 @@ package body MLib.Prj is
 
       procedure Add_ALI_For (Source : Name_Id) is
          ALI : constant String := ALI_File_Name (Get_Name_String (Source));
+         ALI_Id : Name_Id;
       begin
-         Add_Argument (ALI);
-
-         --  Add the ALI file name to the library ALIs
+         if Bind then
+            Add_Argument (ALI);
+         end if;
 
          Name_Len := 0;
          Add_Str_To_Name_Buffer (S => ALI);
-         Library_ALIs.Set (Name_Find, True);
+         ALI_Id := Name_Find;
+
+         --  Add the ALI file name to the library ALIs
+
+         if Bind then
+            Library_ALIs.Set (ALI_Id, True);
+         end if;
+
+         --  Set First_ALI, if not already done
+
+         if First_ALI = No_Name then
+            First_ALI := ALI_Id;
+         end if;
       end Add_ALI_For;
 
       ---------------
@@ -850,59 +867,111 @@ package body MLib.Prj is
                   end;
                end if;
             end;
+         end if;
 
-            --  Get all the ALI files of the project file
+         --  Get all the ALI files of the project file. We do that even if
+         --  Bind is False, so that First_ALI is set.
 
-            declare
-               Unit : Unit_Data;
+         declare
+            Unit : Unit_Data;
 
-            begin
-               Library_ALIs.Reset;
-               Interface_ALIs.Reset;
-               Processed_ALIs.Reset;
-               for Source in 1 .. Com.Units.Last loop
-                  Unit := Com.Units.Table (Source);
-
-                  if Unit.File_Names (Body_Part).Name /= No_Name
-                    and then Unit.File_Names (Body_Part).Path /= Slash
+         begin
+            Library_ALIs.Reset;
+            Interface_ALIs.Reset;
+            Processed_ALIs.Reset;
+            for Source in 1 .. Com.Units.Last loop
+               Unit := Com.Units.Table (Source);
+
+               if Unit.File_Names (Body_Part).Name /= No_Name
+                 and then Unit.File_Names (Body_Part).Path /= Slash
+               then
+                  if
+                    Check_Project (Unit.File_Names (Body_Part).Project)
                   then
-                     if
-                       Check_Project (Unit.File_Names (Body_Part).Project)
-                     then
-                        if Unit.File_Names (Specification).Name = No_Name then
-                           declare
-                              Src_Ind : Source_File_Index;
-
-                           begin
-                              Src_Ind := Sinput.P.Load_Project_File
-                                (Get_Name_String
-                                   (Unit.File_Names
-                                      (Body_Part).Path));
+                     if Unit.File_Names (Specification).Name = No_Name then
+                        declare
+                           Src_Ind : Source_File_Index;
+
+                        begin
+                           Src_Ind := Sinput.P.Load_Project_File
+                             (Get_Name_String
+                                (Unit.File_Names
+                                   (Body_Part).Path));
+
+                           --  Add the ALI file only if it is not a subunit
+
+                           if
+                           not Sinput.P.Source_File_Is_Subunit (Src_Ind)
+                           then
+                              Add_ALI_For
+                                (Unit.File_Names (Body_Part).Name);
+                              exit when not Bind;
+                           end if;
+                        end;
+
+                     else
+                        Add_ALI_For (Unit.File_Names (Body_Part).Name);
+                        exit when not Bind;
+                     end if;
+                  end if;
 
-                              --  Add the ALI file only if it is not a subunit
+               elsif Unit.File_Names (Specification).Name /= No_Name
+                 and then Unit.File_Names (Specification).Path /= Slash
+                 and then Check_Project
+                   (Unit.File_Names (Specification).Project)
+               then
+                  Add_ALI_For (Unit.File_Names (Specification).Name);
+                  exit when not Bind;
+               end if;
+            end loop;
 
-                              if
-                              not Sinput.P.Source_File_Is_Subunit (Src_Ind)
-                              then
-                                 Add_ALI_For
-                                   (Unit.File_Names (Body_Part).Name);
-                              end if;
-                           end;
+         end;
 
-                        else
-                           Add_ALI_For (Unit.File_Names (Body_Part).Name);
-                        end if;
-                     end if;
+         --  Continue setup and call gnatbind if Bind is True
 
-                  elsif Unit.File_Names (Specification).Name /= No_Name
-                    and then Unit.File_Names (Specification).Path /= Slash
-                    and then Check_Project
-                      (Unit.File_Names (Specification).Project)
-                  then
-                     Add_ALI_For (Unit.File_Names (Specification).Name);
+         if Bind then
+            --  Get an eventual --RTS from the ALI file
+
+            if First_ALI /= No_Name then
+               declare
+                  use Types;
+                  T : Text_Buffer_Ptr;
+                  A : ALI_Id;
+
+               begin
+                  --  Load the ALI file
+
+                  T := Read_Library_Info (First_ALI, True);
+
+                  --  Read it
+
+                  A := Scan_ALI
+                         (First_ALI, T, Ignore_ED => False, Err => False);
+
+                  if A /= No_ALI_Id then
+                     for Index in
+                       ALI.Units.Table
+                         (ALI.ALIs.Table (A).First_Unit).First_Arg ..
+                       ALI.Units.Table
+                         (ALI.ALIs.Table (A).First_Unit).Last_Arg
+                     loop
+                        --  Look for --RTS. If found, add the switch to call
+                        --  gnatbind.
+
+                        declare
+                           Arg : String_Ptr renames Args.Table (Index);
+                        begin
+                           if
+                             Arg (Arg'First + 2 .. Arg'First + 5) = "RTS="
+                           then
+                              Add_Argument (Arg.all);
+                              exit;
+                           end if;
+                        end;
+                     end loop;
                   end if;
-               end loop;
-            end;
+               end;
+            end if;
 
             --  Set the paths
 
@@ -958,6 +1027,52 @@ package body MLib.Prj is
                Add_Argument (PIC_Option);
             end if;
 
+            --  Get the back-end switches and --RTS from the ALI file
+
+            if First_ALI /= No_Name then
+               declare
+                  use Types;
+                  T : Text_Buffer_Ptr;
+                  A : ALI_Id;
+
+               begin
+                  --  Load the ALI file
+
+                  T := Read_Library_Info (First_ALI, True);
+
+                  --  Read it
+
+                  A := Scan_ALI
+                         (First_ALI, T, Ignore_ED => False, Err => False);
+
+                  if A /= No_ALI_Id then
+                     for Index in
+                       ALI.Units.Table
+                         (ALI.ALIs.Table (A).First_Unit).First_Arg ..
+                       ALI.Units.Table
+                         (ALI.ALIs.Table (A).First_Unit).Last_Arg
+                     loop
+                        --  Do not compile with the front end switches except
+                        --  for --RTS.
+
+                        declare
+                           Arg : String_Ptr renames Args.Table (Index);
+                        begin
+                           if not Is_Front_End_Switch (Arg.all)
+                             or else
+                               Arg (Arg'First + 2 .. Arg'First + 5) = "RTS="
+                           then
+                              Add_Argument (Arg.all);
+                           end if;
+                        end;
+                     end loop;
+                  end if;
+               end;
+            end if;
+
+            --  Now that all the arguments are set, compile the binder
+            --  generated file.
+
             Display (Gcc);
             GNAT.OS_Lib.Spawn
               (Gcc_Path.all, Arguments (1 .. Argument_Number), Success);
diff --git a/gcc/ada/sem_attr.adb b/gcc/ada/sem_attr.adb
index 51fd7c9..86e7b6a 100644
--- a/gcc/ada/sem_attr.adb
+++ b/gcc/ada/sem_attr.adb
@@ -4464,8 +4464,8 @@ package body Sem_Attr is
         and then Raises_Constraint_Error (N)
       then
          Rewrite (N,
-            Make_Raise_Program_Error (Loc,
-              Reason => PE_Accessibility_Check_Failed));
+           Make_Raise_Program_Error (Loc,
+             Reason => PE_Accessibility_Check_Failed));
          Set_Etype (N, C_Type);
          return;
 
diff --git a/gcc/ada/sem_eval.adb b/gcc/ada/sem_eval.adb
index 222355d1..f884854 100644
--- a/gcc/ada/sem_eval.adb
+++ b/gcc/ada/sem_eval.adb
@@ -6,7 +6,7 @@
 --                                                                          --
 --                                 B o d y                                  --
 --                                                                          --
---          Copyright (C) 1992-2003 Free Software Foundation, Inc.          --
+--          Copyright (C) 1992-2004 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- --
@@ -1180,6 +1180,49 @@ package body Sem_Eval is
       null;
    end Eval_Character_Literal;
 
+   ---------------
+   -- Eval_Call --
+   ---------------
+
+   --  Static function calls are either calls to predefined operators
+   --  with static arguments, or calls to functions that rename a literal.
+   --  Only the latter case is handled here, predefined operators are
+   --  constant-folded elsewhere.
+   --  If the function is itself inherited (see 7423-001) the literal of
+   --  the parent type must be explicitly converted to the return type
+   --  of the function.
+
+   procedure Eval_Call (N : Node_Id) is
+      Loc : constant Source_Ptr := Sloc (N);
+      Typ : constant Entity_Id  := Etype (N);
+      Lit : Entity_Id;
+
+   begin
+      if Nkind (N) = N_Function_Call
+        and then No (Parameter_Associations (N))
+        and then Is_Entity_Name (Name (N))
+        and then Present (Alias (Entity (Name (N))))
+        and then Is_Enumeration_Type (Base_Type (Typ))
+      then
+         Lit := Alias (Entity (Name (N)));
+
+         while Present (Alias (Lit)) loop
+            Lit := Alias (Lit);
+         end loop;
+
+         if Ekind (Lit) = E_Enumeration_Literal then
+            if Base_Type (Etype (Lit)) /= Base_Type (Typ) then
+               Rewrite
+                 (N, Convert_To (Typ, New_Occurrence_Of (Lit, Loc)));
+            else
+               Rewrite (N, New_Occurrence_Of (Lit, Loc));
+            end if;
+
+            Resolve (N, Typ);
+         end if;
+      end if;
+   end Eval_Call;
+
    ------------------------
    -- Eval_Concatenation --
    ------------------------
diff --git a/gcc/ada/sem_eval.ads b/gcc/ada/sem_eval.ads
index 0271885..404ba58 100644
--- a/gcc/ada/sem_eval.ads
+++ b/gcc/ada/sem_eval.ads
@@ -6,7 +6,7 @@
 --                                                                          --
 --                                 S p e c                                  --
 --                                                                          --
---          Copyright (C) 1992-2003 Free Software Foundation, Inc.          --
+--          Copyright (C) 1992-2004 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- --
@@ -268,6 +268,7 @@ package Sem_Eval is
    procedure Eval_Actual                 (N : Node_Id);
    procedure Eval_Allocator              (N : Node_Id);
    procedure Eval_Arithmetic_Op          (N : Node_Id);
+   procedure Eval_Call                   (N : Node_Id);
    procedure Eval_Character_Literal      (N : Node_Id);
    procedure Eval_Concatenation          (N : Node_Id);
    procedure Eval_Conditional_Expression (N : Node_Id);
diff --git a/gcc/ada/sem_res.adb b/gcc/ada/sem_res.adb
index 5960a4d..59a98c5 100644
--- a/gcc/ada/sem_res.adb
+++ b/gcc/ada/sem_res.adb
@@ -3807,8 +3807,7 @@ package body Sem_Res is
          Check_Intrinsic_Call (N);
       end if;
 
-      --  If we fall through we definitely have a non-static call
-
+      Eval_Call (N);
       Check_Elab_Call (N);
    end Resolve_Call;
 
diff --git a/gcc/ada/utils.c b/gcc/ada/utils.c
index 579fa11..b58ccde 100644
--- a/gcc/ada/utils.c
+++ b/gcc/ada/utils.c
@@ -6,7 +6,7 @@
  *                                                                          *
  *                          C Implementation File                           *
  *                                                                          *
- *          Copyright (C) 1992-2003, Free Software Foundation, Inc.         *
+ *          Copyright (C) 1992-2004, 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- *