2010-10-12 Vincent Celier <celier@adacore.com>

	* prj-nmsc.adb (Add_Source): Put source in hash table Source_Files_HT
	(Process_Exceptions_File_Based): Use hash table Source_Files_HT, instead
	of iterating through all sources of the project.
	* prj.adb (Free): Reset hash table Source_Files_HT
	(Reset): Reset hash table Source_Files_HT
	* prj.ads (Source_Data): New component Next_With_File_Name
	(Source_Files_Htable): New hash table
	(Project_Tree_Data): New component Source_Files_HT

2010-10-12  Tristan Gingold  <gingold@adacore.com>

	* g-trasym-vms-ia64.adb: Use the documented API.
	* gcc-interface/Makefile.in: Always set NO_REORDER_ADAFLAGS.
	* gcc-interface/Make-lang.in: Update dependencies.



git-svn-id: svn+ssh://gcc.gnu.org/svn/gcc/trunk@165377 138bc75d-0d04-0410-961f-82ee72b054a4

1 files changed, 128 insertions, 69 deletions

diff --git a/gcc/ada/g-trasym-vms-ia64.adb b/gcc/ada/g-trasym-vms-ia64.adb
index 28dab4729bd..a3ddf04c407 100644
--- a/gcc/ada/g-trasym-vms-ia64.adb
+++ b/gcc/ada/g-trasym-vms-ia64.adb
@@ -6,7 +6,7 @@
 --                                                                          --
 --                                 B o d y                                  --
 --                                                                          --
---         Copyright (C) 2005-2009, Free Software Foundation, Inc.          --
+--         Copyright (C) 2005-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- --
@@ -39,9 +39,6 @@ with System.Traceback_Entries;
 
 package body GNAT.Traceback.Symbolic is
 
-   pragma Warnings (Off); --  ??? needs comment
-   pragma Linker_Options ("--for-linker=sys$library:trace.exe");
-
    use System;
    use System.Aux_DEC;
    use System.Traceback_Entries;
@@ -67,16 +64,43 @@ package body GNAT.Traceback.Symbolic is
 
    subtype Cond_Value_Type is Unsigned_Longword;
 
-   function Symbolize
-     (Current_PC    : Address;
-      Filename_Dsc  : Address;
-      Library_Dsc   : Address;
-      Record_Number : Address;
-      Image_Dsc     : Address;
-      Module_Dsc    : Address;
-      Routine_Dsc   : Address;
-      Line_Number   : Address;
-      Relative_PC   : Address) return Cond_Value_Type;
+   --  TBK_API_PARAM as defined in TBKDEF.
+   type Tbk_Api_Param is record
+      Length              : Unsigned_Word;
+      T_Type              : Unsigned_Byte;
+      Version             : Unsigned_Byte;
+      Reserveda           : Unsigned_Longword;
+      Faulting_Pc         : Address;
+      Faulting_Fp         : Address;
+      Filename_Desc       : Address;
+      Library_Module_Desc : Address;
+      Record_Number       : Address;
+      Image_Desc          : Address;
+      Module_Desc         : Address;
+      Routine_Desc        : Address;
+      Listing_Lineno      : Address;
+      Rel_Pc              : Address;
+      Image_Base_Addr     : Address;
+      Module_Base_Addr    : Address;
+      Malloc_Rtn          : Address;
+      Free_Rtn            : Address;
+      Symbolize_Flags     : Address;
+      Reserved0           : Unsigned_Quadword;
+      Reserved1           : Unsigned_Quadword;
+      Reserved2           : Unsigned_Quadword;
+   end record;
+   pragma Convention (C, Tbk_Api_Param);
+
+   K_Version : constant Unsigned_Byte := 1;
+   --  Current API version.
+   K_Length  : constant Unsigned_Word := 152;
+   --  Length of the parameter.
+
+   pragma Compile_Time_Error (Tbk_Api_Param'Size = K_Length * 8,
+                              "Bad length for tbk_api_param");
+   --  Sanity check.
+
+   function Symbolize (Param : Address) return Cond_Value_Type;
    pragma Import (C, Symbolize, "TBK$I64_SYMBOLIZE");
 
    function Decode_Ada_Name (Encoded_Name : String) return String;
@@ -173,20 +197,16 @@ package body GNAT.Traceback.Symbolic is
    ------------------------
 
    function Symbolic_Traceback (Traceback : Tracebacks_Array) return String is
+      Param         : Tbk_Api_Param;
       Status        : Cond_Value_Type;
-      Filename_Name : Var_String;
-      Filename_Dsc  : Descriptor64;
-      Library_Name  : Var_String;
-      Library_Dsc   : Descriptor64;
-      Record_Number : Integer_64;
+      Record_Number : Unsigned_Longword;
       Image_Name    : Var_String;
       Image_Dsc     : Descriptor64;
       Module_Name   : Var_String;
       Module_Dsc    : Descriptor64;
       Routine_Name  : Var_String;
       Routine_Dsc   : Descriptor64;
-      Line_Number   : Integer_64;
-      Relative_PC   : Integer_64;
+      Line_Number   : Unsigned_Longword;
       Res           : String (1 .. 256 * Traceback'Length);
       Len           : Integer;
 
@@ -201,68 +221,107 @@ package body GNAT.Traceback.Symbolic is
 
       System.Soft_Links.Lock_Task.all;
 
-      Setup_Descriptor64_Vs (Filename_Dsc, Filename_Name'Address);
-      Setup_Descriptor64_Vs (Library_Dsc, Library_Name'Address);
+      --  Initialize descriptors
+
       Setup_Descriptor64_Vs (Image_Dsc, Image_Name'Address);
       Setup_Descriptor64_Vs (Module_Dsc, Module_Name'Address);
       Setup_Descriptor64_Vs (Routine_Dsc, Routine_Name'Address);
 
       for J in Traceback'Range loop
-         Status := Symbolize
-           (PC_For (Traceback (J)),
-            Filename_Dsc'Address,
-            Library_Dsc'Address,
-            Record_Number'Address,
-            Image_Dsc'Address,
-            Module_Dsc'Address,
-            Routine_Dsc'Address,
-            Line_Number'Address,
-            Relative_PC'Address);
-
-         declare
-            First : Integer := Len + 1;
-            Last  : Integer := First + 80 - 1;
-            Pos   : Integer;
-
-            Routine_Name_D : String :=
-                               Decode_Ada_Name
-                                 (Routine_Name.Buf
+         --  Initialize fields in case they are not written
+
+         Record_Number := 0;
+         Line_Number := 0;
+         Image_Name.Curlen := 0;
+         Module_Name.Curlen := 0;
+         Routine_Name.Curlen := 0;
+
+         --  Symbolize
+
+         Param := (Length              => K_Length,
+                   T_Type              => 0,
+                   Version             => K_Version,
+                   Reserveda           => 0,
+                   Faulting_Pc         => PC_For (Traceback (J)),
+                   Faulting_Fp         => 0,
+                   Filename_Desc       => Null_Address,
+                   Library_Module_Desc => Null_Address,
+                   Record_Number => Record_Number'Address,
+                   Image_Desc       => Image_Dsc'Address,
+                   Module_Desc      => Module_Dsc'Address,
+                   Routine_Desc     => Routine_Dsc'Address,
+                   Listing_Lineno   => Line_Number'Address,
+                   Rel_Pc           => Null_Address,
+                   Image_Base_Addr  => Null_Address,
+                   Module_Base_Addr => Null_Address,
+                   Malloc_Rtn       => Null_Address,
+                   Free_Rtn         => Null_Address,
+                   Symbolize_Flags  => Null_Address,
+                   Reserved0        => (0, 0),
+                   Reserved1        => (0, 0),
+                   Reserved2        => (0, 0));
+
+         Status := Symbolize (Param'Address);
+
+         if (Status rem 2) = 1 then
+
+            --  Success
+
+            if Line_Number = 0 then
+               --  As GCC doesn't emit source file correlation, use record
+               --  number of line number is not set
+
+               Line_Number := Record_Number;
+            end if;
+
+            declare
+               First : constant Integer := Len + 1;
+               Last  : Integer := First + 80 - 1;
+               Pos   : Integer;
+
+               Routine_Name_D : constant String :=
+                 Decode_Ada_Name (Routine_Name.Buf
                                     (1 .. Natural (Routine_Name.Curlen)));
 
-         begin
-            Res (First .. Last) := (others => ' ');
+               Lineno : constant String :=
+                 Unsigned_Longword'Image (Line_Number);
 
-            Res (First .. First + Natural (Image_Name.Curlen) - 1) :=
-              Image_Name.Buf (1 .. Natural (Image_Name.Curlen));
+            begin
+               Res (First .. Last) := (others => ' ');
 
-            Res (First + 10 ..
-                 First + 10 + Natural (Module_Name.Curlen) - 1) :=
-              Module_Name.Buf (1 .. Natural (Module_Name.Curlen));
+               Res (First .. First + Natural (Image_Name.Curlen) - 1) :=
+                 Image_Name.Buf (1 .. Natural (Image_Name.Curlen));
 
-            Res (First + 30 ..
-                 First + 30 + Routine_Name_D'Length - 1) :=
-              Routine_Name_D;
+               Res (First + 10 ..
+                      First + 10 + Natural (Module_Name.Curlen) - 1) :=
+                 Module_Name.Buf (1 .. Natural (Module_Name.Curlen));
 
-            --  If routine name doesn't fit 20 characters, output
-            --  the line number on next line at 50th position
+               Res (First + 30 ..
+                      First + 30 + Routine_Name_D'Length - 1) :=
+                 Routine_Name_D;
 
-            if Routine_Name_D'Length > 20 then
-               Pos := First + 30 + Routine_Name_D'Length;
-               Res (Pos) := ASCII.LF;
-               Last := Pos + 80;
-               Res (Pos + 1 .. Last) := (others => ' ');
-               Pos := Pos + 51;
-            else
-               Pos := First + 50;
-            end if;
+               --  If routine name doesn't fit 20 characters, output
+               --  the line number on next line at 50th position
 
-            Res (Pos ..
-                 Pos + Integer_64'Image (Line_Number)'Length - 1) :=
-              Integer_64'Image (Line_Number);
+               if Routine_Name_D'Length > 20 then
+                  Pos := First + 30 + Routine_Name_D'Length;
+                  Res (Pos) := ASCII.LF;
+                  Last := Pos + 80;
+                  Res (Pos + 1 .. Last) := (others => ' ');
+                  Pos := Pos + 51;
+               else
+                  Pos := First + 50;
+               end if;
 
-            Res (Last) := ASCII.LF;
-            Len := Last;
-         end;
+               Res (Pos .. Pos + Lineno'Length - 1) := Lineno;
+
+               Res (Last) := ASCII.LF;
+               Len := Last;
+            end;
+         else
+            Res (Len + 1 .. Len + 6) := "ERROR" & ASCII.LF;
+            Len := Len + 6;
+         end if;
       end loop;
 
       System.Soft_Links.Unlock_Task.all;