2010-09-19 Basile Starynkevitch <basile@starynkevitch.net>

	MELT branch merged with trunk rev 164348, with some improvements
	in gcc/melt-runtime.[ch]

2010-09-19  Basile Starynkevitch  <basile@starynkevitch.net>
	[[merged with trunk rev.164348, so improved MELT runtime!]]
	* gcc/melt-runtime.h: improved comments.
	(melt_debug_garbcoll, melt_debuggc_eprintf):  Moved from melt-runtime.c.
	(melt_obmag_string): New declaration.
	(struct meltobject_st, struct meltclosure_st, struct
	meltroutine_st, struct meltmixbigint_st, struct meltstring_st):
	using GTY variable_size and @@MELTGTY@@ comment.
	(melt_mark_special): added debug print.

	* gcc/melt-runtime.c:  Improved comments.
	Include bversion.h, realmpfr.h, gimple-pretty-print.h.
	(ggc_force_collect) Declared external.
	(melt_forward_counter): Added.
	(melt_obmag_string): New function.
	(melt_alptr_1, melt_alptr_2, melt_break_alptr_1_at)
	(melt_break_alptr_2_at, melt_break_alptr_1,melt_break_alptr_1)
	(melt_allocate_young_gc_zone, melt_free_young_gc_zone): New.
	(delete_special, meltgc_make_special): Improved debug printf and
	use melt_break_alptr_1...
	(ggc_alloc_*) macros defined for backport to GCC 4.5
	(melt_forwarded_copy): Don't clear the new destination zone in old
	GGC heap.
	(meltgc_add_out_raw_len): Use ggc_alloc_atomic.
	(meltgc_raw_new_mappointers, meltgc_raw_put_mappointers)
	(meltgc_raw_remove_mappointers): Corrected length argument to
	ggc_alloc_cleared_vec_entrypointermelt_st.
	(melt_really_initialize): Call melt_allocate_young_gc_zone.
	(melt_initialize):  Set flag_plugin_added.
	(melt_val2passflag): TODO_verify_loops only in GCC 4.5




git-svn-id: svn+ssh://gcc.gnu.org/svn/gcc/branches/melt-branch@164424 138bc75d-0d04-0410-961f-82ee72b054a4

1 files changed, 173 insertions, 45 deletions

diff --git a/gcc/ada/gnatcmd.adb b/gcc/ada/gnatcmd.adb
index 6ab6821a63d..93f7d1c6b93 100644
--- a/gcc/ada/gnatcmd.adb
+++ b/gcc/ada/gnatcmd.adb
@@ -6,7 +6,7 @@
 --                                                                          --
 --                                 B o d y                                  --
 --                                                                          --
---          Copyright (C) 1996-2009, Free Software Foundation, Inc.         --
+--          Copyright (C) 1996-2010, 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- --
@@ -26,6 +26,7 @@
 with GNAT.Directory_Operations; use GNAT.Directory_Operations;
 
 with Csets;
+with Hostparm; use Hostparm;
 with Makeutl;  use Makeutl;
 with MLib.Tgt; use MLib.Tgt;
 with MLib.Utl;
@@ -46,16 +47,14 @@ with Table;
 with Targparm;
 with Tempdir;
 with Types;    use Types;
-with Hostparm; use Hostparm;
---  Used to determine if we are in VMS or not for error message purposes
+with VMS_Conv; use VMS_Conv;
+with VMS_Cmds; use VMS_Cmds;
 
 with Ada.Characters.Handling; use Ada.Characters.Handling;
 with Ada.Command_Line;        use Ada.Command_Line;
 with Ada.Text_IO;             use Ada.Text_IO;
 
-with GNAT.OS_Lib;             use GNAT.OS_Lib;
-
-with VMS_Conv;                use VMS_Conv;
+with GNAT.OS_Lib; use GNAT.OS_Lib;
 
 procedure GNATCmd is
    Project_Node_Tree : Project_Node_Tree_Ref;
@@ -122,6 +121,7 @@ procedure GNATCmd is
 
    Naming_String      : constant SA := new String'("naming");
    Binder_String      : constant SA := new String'("binder");
+   Builder_String     : constant SA := new String'("builder");
    Compiler_String    : constant SA := new String'("compiler");
    Check_String       : constant SA := new String'("check");
    Synchronize_String : constant SA := new String'("synchronize");
@@ -139,7 +139,8 @@ procedure GNATCmd is
      new String_List'((Naming_String, Binder_String));
 
    Packages_To_Check_By_Check : constant String_List_Access :=
-     new String_List'((Naming_String, Check_String, Compiler_String));
+     new String_List'
+          ((Naming_String, Builder_String, Check_String, Compiler_String));
 
    Packages_To_Check_By_Sync : constant String_List_Access :=
      new String_List'((Naming_String, Synchronize_String, Compiler_String));
@@ -209,9 +210,9 @@ procedure GNATCmd is
 
    procedure Check_Files;
    --  For GNAT LIST, GNAT PRETTY, GNAT METRIC, and GNAT STACK, check if a
-   --  project file is specified, without any file arguments. If it is the
-   --  case, invoke the GNAT tool with the proper list of files, derived from
-   --  the sources of the project.
+   --  project file is specified, without any file arguments and without a
+   --  switch -files=. If it is the case, invoke the GNAT tool with the proper
+   --  list of files, derived from the sources of the project.
 
    function Check_Project
      (Project      : Project_Id;
@@ -232,6 +233,11 @@ procedure GNATCmd is
    --  STUB), gnatpp (GNAT PRETTY), gnatelim (GNAT ELIM), and gnatmetric (GNAT
    --  METRIC).
 
+   function Mapping_File return Path_Name_Type;
+   --  Create and return the path name of a mapping file. Used for gnatstub
+   --  (GNAT STUB), gnatpp (GNAT PRETTY), gnatelim (GNAT ELIM), and gnatmetric
+   --  (GNAT METRIC).
+
    procedure Delete_Temp_Config_Files;
    --  Delete all temporary config files. The caller is responsible for
    --  ensuring that Keep_Temporary_Files is False.
@@ -314,20 +320,25 @@ procedure GNATCmd is
       Success     : Boolean;
 
    begin
-      --  Check if there is at least one argument that is not a switch
+      --  Check if there is at least one argument that is not a switch or if
+      --  there is a -files= switch.
 
       for Index in 1 .. Last_Switches.Last loop
-         if Last_Switches.Table (Index) (1) /= '-' then
+         if Last_Switches.Table (Index).all'Length > 7
+           and then Last_Switches.Table (Index) (1 .. 7) = "-files="
+         then
+            Add_Sources := False;
+            exit;
+
+         elsif Last_Switches.Table (Index) (1) /= '-' then
             if Index = 1
               or else
                 (The_Command = Check
-                   and then
-                     Last_Switches.Table (Index - 1).all /= "-o")
+                   and then Last_Switches.Table (Index - 1).all /= "-o")
               or else
                 (The_Command = Pretty
-                   and then
-                     Last_Switches.Table (Index - 1).all /= "-o"  and then
-                     Last_Switches.Table (Index - 1).all /= "-of")
+                   and then Last_Switches.Table (Index - 1).all /= "-o"
+                   and then Last_Switches.Table (Index - 1).all /= "-of")
               or else
                 (The_Command = Metric
                    and then
@@ -346,13 +357,13 @@ procedure GNATCmd is
          end if;
       end loop;
 
-      --  If all arguments were switches, add the path names of all the sources
-      --  of the main project.
+      --  If all arguments are switches and there is no switch -files=, add
+      --  the path names of all the sources of the main project.
 
       if Add_Sources then
 
-         --  For gnatcheck, gnatpp and gnatmetric , create a temporary file and
-         --  put the list of sources in it.
+         --  For gnatcheck, gnatpp, and gnatmetric, create a temporary file
+         --  and put the list of sources in it.
 
          if The_Command = Check  or else
             The_Command = Pretty or else
@@ -443,8 +454,8 @@ procedure GNATCmd is
                   then
                      --  There is a body, check if it is for this project
 
-                     if All_Projects or else
-                        Unit.File_Names (Impl).Project = Project
+                     if All_Projects
+                       or else Unit.File_Names (Impl).Project = Project
                      then
                         Subunit := False;
 
@@ -794,8 +805,6 @@ procedure GNATCmd is
          Return_Code  => Return_Code,
          Err_To_Out   => True);
 
-      Close (FD);
-
       --  Read the output of the invocation of gnatmake
 
       Open (File, In_File, Get_Name_String (Name));
@@ -883,6 +892,21 @@ procedure GNATCmd is
    end Index;
 
    ------------------
+   -- Mapping_File --
+   ------------------
+
+   function Mapping_File return Path_Name_Type is
+      Result : Path_Name_Type;
+   begin
+      Prj.Env.Create_Mapping_File
+        (Project  => Project,
+         Language => Name_Ada,
+         In_Tree  => Project_Tree,
+         Name     => Result);
+      return Result;
+   end Mapping_File;
+
+   ------------------
    -- Process_Link --
    ------------------
 
@@ -1056,8 +1080,7 @@ procedure GNATCmd is
                   --  Append ".ali" if file name does not end with it
 
                   if Switch'Length <= 4
-                    or else Switch (Switch'Last - 3 .. Switch'Last)
-                    /= ".ali"
+                    or else Switch (Switch'Last - 3 .. Switch'Last) /= ".ali"
                   then
                      Last := ALI_File'Last;
                   end if;
@@ -1070,8 +1093,8 @@ procedure GNATCmd is
 
                   else
                      for K in Switch'Range loop
-                        if Switch (K) = '/' or else
-                          Switch (K) = Directory_Separator
+                        if Switch (K) = '/'
+                          or else Switch (K) = Directory_Separator
                         then
                            Test_Existence := True;
                            exit;
@@ -1245,7 +1268,10 @@ procedure GNATCmd is
       New_Line;
 
       for C in Command_List'Range loop
-         if not Command_List (C).VMS_Only then
+
+         --  No usage for VMS only command or for Sync
+
+         if not Command_List (C).VMS_Only and then C /= Sync then
             if Targparm.AAMP_On_Target then
                Put ("gnaampcmd ");
             else
@@ -1279,7 +1305,7 @@ procedure GNATCmd is
       end loop;
 
       New_Line;
-      Put_Line ("Commands find, list, metric, pretty, stack, stub and xref " &
+      Put_Line ("All commands except chop, krunch and preprocess " &
                 "accept project file switches -vPx, -Pprj and -Xnam=val");
       New_Line;
    end Non_VMS_Usage;
@@ -1291,9 +1317,7 @@ procedure GNATCmd is
 begin
    --  Initializations
 
-   Namet.Initialize;
    Csets.Initialize;
-
    Snames.Initialize;
 
    Project_Node_Tree := new Project_Node_Tree_Data;
@@ -1323,6 +1347,19 @@ begin
 
    Targparm.Get_Target_Parameters;
 
+   --  Put the command line in environment variable GNAT_DRIVER_COMMAND_LINE,
+   --  so that the spawned tool may know the way the GNAT driver was invoked.
+
+   Name_Len := 0;
+   Add_Str_To_Name_Buffer (Command_Name);
+
+   for J in 1 .. Argument_Count loop
+      Add_Char_To_Name_Buffer (' ');
+      Add_Str_To_Name_Buffer (Argument (J));
+   end loop;
+
+   Setenv ("GNAT_DRIVER_COMMAND_LINE", Name_Buffer (1 .. Name_Len));
+
    --  Add the directory where the GNAT driver is invoked in front of the path,
    --  if the GNAT driver is invoked with directory information. Do not do this
    --  for VMS, where the notion of path does not really exist.
@@ -1611,11 +1648,12 @@ begin
 
                   --  --subdirs=... Specify Subdirs
 
-                  if Argv'Length > Makeutl.Subdirs_Option'Length and then
-                    Argv
-                     (Argv'First ..
-                      Argv'First + Makeutl.Subdirs_Option'Length - 1) =
-                        Makeutl.Subdirs_Option
+                  if Argv'Length > Makeutl.Subdirs_Option'Length
+                    and then
+                      Argv
+                       (Argv'First ..
+                        Argv'First + Makeutl.Subdirs_Option'Length - 1) =
+                          Makeutl.Subdirs_Option
                   then
                      Subdirs :=
                        new String'
@@ -1724,8 +1762,9 @@ begin
                                         ('=',
                                          Argv (Argv'First + 2 .. Argv'Last));
                      begin
-                        if Equal_Pos >= Argv'First + 3 and then
-                          Equal_Pos /= Argv'Last then
+                        if Equal_Pos >= Argv'First + 3
+                          and then Equal_Pos /= Argv'Last
+                        then
                            Add (Project_Node_Tree,
                                 External_Name =>
                                   Argv (Argv'First + 2 .. Equal_Pos - 1),
@@ -1927,7 +1966,7 @@ begin
             end if;
          end;
 
-         if The_Command = Bind
+         if        The_Command = Bind
            or else The_Command = Link
            or else The_Command = Elim
          then
@@ -1942,7 +1981,7 @@ begin
          --  For gnatcheck, gnatstub, gnatmetric, gnatpp and gnatelim, create
          --  a configuration pragmas file, if necessary.
 
-         if The_Command = Pretty
+         if        The_Command = Pretty
            or else The_Command = Metric
            or else The_Command = Stub
            or else The_Command = Elim
@@ -2080,7 +2119,7 @@ begin
                      while K <= First_Switches.Last
                        and then
                         (The_Command /= Check
-                           or else First_Switches.Table (K).all /= "-rules")
+                          or else First_Switches.Table (K).all /= "-rules")
                      loop
                         Add_To_Carg_Switches (First_Switches.Table (K));
                         K := K + 1;
@@ -2120,8 +2159,7 @@ begin
                      while K <= Last_Switches.Last
                        and then
                         (The_Command /= Check
-                         or else
-                         Last_Switches.Table (K).all /= "-rules")
+                          or else Last_Switches.Table (K).all /= "-rules")
                      loop
                         Add_To_Carg_Switches (Last_Switches.Table (K));
                         K := K + 1;
@@ -2149,6 +2187,7 @@ begin
 
             declare
                CP_File : constant Path_Name_Type := Configuration_Pragmas_File;
+               M_File  : constant Path_Name_Type := Mapping_File;
 
             begin
                if CP_File /= No_Path then
@@ -2162,6 +2201,95 @@ begin
                        (new String'("-gnatec=" & Get_Name_String (CP_File)));
                   end if;
                end if;
+
+               if M_File /= No_Path then
+                  Add_To_Carg_Switches
+                    (new String'("-gnatem=" & Get_Name_String (M_File)));
+               end if;
+
+               --  For gnatcheck, also indicate a global configuration pragmas
+               --  file and, if -U is not used, a local one.
+
+               if The_Command = Check then
+                  declare
+                     Pkg  : constant Prj.Package_Id :=
+                              Prj.Util.Value_Of
+                                (Name        => Name_Builder,
+                                 In_Packages => Project.Decl.Packages,
+                                 In_Tree     => Project_Tree);
+
+                     Variable : Variable_Value :=
+                                  Prj.Util.Value_Of
+                                    (Name                    => No_Name,
+                                     Attribute_Or_Array_Name =>
+                                       Name_Global_Configuration_Pragmas,
+                                     In_Package              => Pkg,
+                                     In_Tree                 => Project_Tree);
+
+                  begin
+                     if (Variable = Nil_Variable_Value
+                          or else Length_Of_Name (Variable.Value) = 0)
+                       and then Pkg /= No_Package
+                     then
+                        Variable :=
+                          Prj.Util.Value_Of
+                            (Name                    => Name_Ada,
+                             Attribute_Or_Array_Name =>
+                               Name_Global_Config_File,
+                             In_Package              => Pkg,
+                             In_Tree                 => Project_Tree);
+                     end if;
+
+                     if Variable /= Nil_Variable_Value
+                       and then Length_Of_Name (Variable.Value) /= 0
+                     then
+                        Add_To_Carg_Switches
+                          (new String'
+                             ("-gnatec=" & Get_Name_String (Variable.Value)));
+                     end if;
+                  end;
+
+                  if not All_Projects then
+                     declare
+                        Pkg : constant Prj.Package_Id :=
+                                Prj.Util.Value_Of
+                                  (Name        => Name_Compiler,
+                                   In_Packages => Project.Decl.Packages,
+                                   In_Tree     => Project_Tree);
+
+                        Variable : Variable_Value :=
+                                     Prj.Util.Value_Of
+                                       (Name        => No_Name,
+                                        Attribute_Or_Array_Name =>
+                                          Name_Local_Configuration_Pragmas,
+                                        In_Package  => Pkg,
+                                        In_Tree     => Project_Tree);
+
+                     begin
+                        if (Variable = Nil_Variable_Value
+                             or else Length_Of_Name (Variable.Value) = 0)
+                          and then Pkg /= No_Package
+                        then
+                           Variable :=
+                             Prj.Util.Value_Of
+                               (Name                    => Name_Ada,
+                                Attribute_Or_Array_Name =>
+                                  Name_Local_Config_File,
+                                In_Package              => Pkg,
+                                In_Tree                 => Project_Tree);
+                        end if;
+
+                        if Variable /= Nil_Variable_Value
+                          and then Length_Of_Name (Variable.Value) /= 0
+                        then
+                           Add_To_Carg_Switches
+                             (new String'
+                                ("-gnatec=" &
+                                 Get_Name_String (Variable.Value)));
+                        end if;
+                     end;
+                  end if;
+               end if;
             end;
          end if;