Skip to content

R
riscv-gcc-1
Commit f166413a by Arnaud Charlet
Options

[multiple changes] 

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.

From-SVN: r165377
parent d80ee77c
Showing with 230 additions and 132 deletions
gcc/ada/ChangeLog
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.
2010-10-12 Thomas Quinot <quinot@adacore.com> 2010-10-12 Thomas Quinot <quinot@adacore.com>
* rtsfind.ads, exp_dist.adb, exp_dist.ads (Build_General_Calling_Stubs, * rtsfind.ads, exp_dist.adb, exp_dist.ads (Build_General_Calling_Stubs,
......
gcc/ada/g-trasym-vms-ia64.adb
...@@ -6,7 +6,7 @@ ...@@ -6,7 +6,7 @@
-- -- -- --
-- B o d y -- -- 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 -- -- 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- -- -- terms of the GNU General Public License as published by the Free Soft- --
...@@ -39,9 +39,6 @@ with System.Traceback_Entries; ...@@ -39,9 +39,6 @@ with System.Traceback_Entries;
package body GNAT.Traceback.Symbolic is package body GNAT.Traceback.Symbolic is
pragma Warnings (Off); -- ??? needs comment
pragma Linker_Options ("--for-linker=sys$library:trace.exe");
use System; use System;
use System.Aux_DEC; use System.Aux_DEC;
use System.Traceback_Entries; use System.Traceback_Entries;
...@@ -67,16 +64,43 @@ package body GNAT.Traceback.Symbolic is ...@@ -67,16 +64,43 @@ package body GNAT.Traceback.Symbolic is
subtype Cond_Value_Type is Unsigned_Longword; subtype Cond_Value_Type is Unsigned_Longword;
function Symbolize -- TBK_API_PARAM as defined in TBKDEF.
(Current_PC : Address; type Tbk_Api_Param is record
Filename_Dsc : Address; Length : Unsigned_Word;
Library_Dsc : Address; T_Type : Unsigned_Byte;
Record_Number : Address; Version : Unsigned_Byte;
Image_Dsc : Address; Reserveda : Unsigned_Longword;
Module_Dsc : Address; Faulting_Pc : Address;
Routine_Dsc : Address; Faulting_Fp : Address;
Line_Number : Address; Filename_Desc : Address;
Relative_PC : Address) return Cond_Value_Type; 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"); pragma Import (C, Symbolize, "TBK$I64_SYMBOLIZE");
function Decode_Ada_Name (Encoded_Name : String) return String; function Decode_Ada_Name (Encoded_Name : String) return String;
...@@ -173,20 +197,16 @@ package body GNAT.Traceback.Symbolic is ...@@ -173,20 +197,16 @@ package body GNAT.Traceback.Symbolic is
------------------------ ------------------------
function Symbolic_Traceback (Traceback : Tracebacks_Array) return String is function Symbolic_Traceback (Traceback : Tracebacks_Array) return String is
Param : Tbk_Api_Param;
Status : Cond_Value_Type; Status : Cond_Value_Type;
Filename_Name : Var_String; Record_Number : Unsigned_Longword;
Filename_Dsc : Descriptor64;
Library_Name : Var_String;
Library_Dsc : Descriptor64;
Record_Number : Integer_64;
Image_Name : Var_String; Image_Name : Var_String;
Image_Dsc : Descriptor64; Image_Dsc : Descriptor64;
Module_Name : Var_String; Module_Name : Var_String;
Module_Dsc : Descriptor64; Module_Dsc : Descriptor64;
Routine_Name : Var_String; Routine_Name : Var_String;
Routine_Dsc : Descriptor64; Routine_Dsc : Descriptor64;
Line_Number : Integer_64; Line_Number : Unsigned_Longword;
Relative_PC : Integer_64;
Res : String (1 .. 256 * Traceback'Length); Res : String (1 .. 256 * Traceback'Length);
Len : Integer; Len : Integer;
...@@ -201,68 +221,107 @@ package body GNAT.Traceback.Symbolic is ...@@ -201,68 +221,107 @@ package body GNAT.Traceback.Symbolic is
System.Soft_Links.Lock_Task.all; System.Soft_Links.Lock_Task.all;
Setup_Descriptor64_Vs (Filename_Dsc, Filename_Name'Address); -- Initialize descriptors
Setup_Descriptor64_Vs (Library_Dsc, Library_Name'Address);
Setup_Descriptor64_Vs (Image_Dsc, Image_Name'Address); Setup_Descriptor64_Vs (Image_Dsc, Image_Name'Address);
Setup_Descriptor64_Vs (Module_Dsc, Module_Name'Address); Setup_Descriptor64_Vs (Module_Dsc, Module_Name'Address);
Setup_Descriptor64_Vs (Routine_Dsc, Routine_Name'Address); Setup_Descriptor64_Vs (Routine_Dsc, Routine_Name'Address);
for J in Traceback'Range loop for J in Traceback'Range loop
Status := Symbolize -- Initialize fields in case they are not written
(PC_For (Traceback (J)),
Filename_Dsc'Address, Record_Number := 0;
Library_Dsc'Address, Line_Number := 0;
Record_Number'Address, Image_Name.Curlen := 0;
Image_Dsc'Address, Module_Name.Curlen := 0;
Module_Dsc'Address, Routine_Name.Curlen := 0;
Routine_Dsc'Address,
Line_Number'Address, -- Symbolize
Relative_PC'Address);
Param := (Length => K_Length,
declare T_Type => 0,
First : Integer := Len + 1; Version => K_Version,
Last : Integer := First + 80 - 1; Reserveda => 0,
Pos : Integer; Faulting_Pc => PC_For (Traceback (J)),
Faulting_Fp => 0,
Routine_Name_D : String := Filename_Desc => Null_Address,
Decode_Ada_Name Library_Module_Desc => Null_Address,
(Routine_Name.Buf 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))); (1 .. Natural (Routine_Name.Curlen)));
begin Lineno : constant String :=
Res (First .. Last) := (others => ' '); Unsigned_Longword'Image (Line_Number);
Res (First .. First + Natural (Image_Name.Curlen) - 1) := begin
Image_Name.Buf (1 .. Natural (Image_Name.Curlen)); Res (First .. Last) := (others => ' ');
Res (First + 10 .. Res (First .. First + Natural (Image_Name.Curlen) - 1) :=
First + 10 + Natural (Module_Name.Curlen) - 1) := Image_Name.Buf (1 .. Natural (Image_Name.Curlen));
Module_Name.Buf (1 .. Natural (Module_Name.Curlen));
Res (First + 30 .. Res (First + 10 ..
First + 30 + Routine_Name_D'Length - 1) := First + 10 + Natural (Module_Name.Curlen) - 1) :=
Routine_Name_D; Module_Name.Buf (1 .. Natural (Module_Name.Curlen));
-- If routine name doesn't fit 20 characters, output Res (First + 30 ..
-- the line number on next line at 50th position First + 30 + Routine_Name_D'Length - 1) :=
Routine_Name_D;
if Routine_Name_D'Length > 20 then -- If routine name doesn't fit 20 characters, output
Pos := First + 30 + Routine_Name_D'Length; -- the line number on next line at 50th position
Res (Pos) := ASCII.LF;
Last := Pos + 80;
Res (Pos + 1 .. Last) := (others => ' ');
Pos := Pos + 51;
else
Pos := First + 50;
end if;
Res (Pos .. if Routine_Name_D'Length > 20 then
Pos + Integer_64'Image (Line_Number)'Length - 1) := Pos := First + 30 + Routine_Name_D'Length;
Integer_64'Image (Line_Number); 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; Res (Pos .. Pos + Lineno'Length - 1) := Lineno;
Len := Last;
end; Res (Last) := ASCII.LF;
Len := Last;
end;
else
Res (Len + 1 .. Len + 6) := "ERROR" & ASCII.LF;
Len := Len + 6;
end if;
end loop; end loop;
System.Soft_Links.Unlock_Task.all; System.Soft_Links.Unlock_Task.all;
......
gcc/ada/gcc-interface/Makefile.in
...@@ -2724,15 +2724,9 @@ s-tasdeb.o : s-tasdeb.adb s-tasdeb.ads ...@@ -2724,15 +2724,9 @@ s-tasdeb.o : s-tasdeb.adb s-tasdeb.ads
$< $(OUTPUT_OPTION) $< $(OUTPUT_OPTION)
# force no function reordering on a-except.o because of the exclusion bounds # force no function reordering on a-except.o because of the exclusion bounds
# mechanism (see the source file for more detailed information). However we # mechanism (see the source file for more detailed information).
# can do that only when building the runtime (not the compiler) because the
# -fno-toplevel-reorder option exists only in GCC 4.2 and above.
ifneq (,$(findstring xgcc,$(CC)))
NO_REORDER_ADAFLAGS=-fno-toplevel-reorder NO_REORDER_ADAFLAGS=-fno-toplevel-reorder
else
NO_REORDER_ADAFLAGS=
endif
# force debugging information on a-except.o so that it is always # force debugging information on a-except.o so that it is always
# possible to set conditional breakpoints on exceptions. # possible to set conditional breakpoints on exceptions.
......
gcc/ada/prj-nmsc.adb
...@@ -867,6 +867,10 @@ package body Prj.Nmsc is ...@@ -867,6 +867,10 @@ package body Prj.Nmsc is
Source_Paths_Htable.Set (Data.Tree.Source_Paths_HT, Path.Name, Id); Source_Paths_Htable.Set (Data.Tree.Source_Paths_HT, Path.Name, Id);
end if; end if;
Id.Next_With_File_Name :=
Source_Files_Htable.Get (Data.Tree.Source_Files_HT, File_Name);
Source_Files_Htable.Set (Data.Tree.Source_Files_HT, File_Name, Id);
if Index /= 0 then if Index /= 0 then
Project.Has_Multi_Unit_Sources := True; Project.Has_Multi_Unit_Sources := True;
end if; end if;
...@@ -3016,7 +3020,6 @@ package body Prj.Nmsc is ...@@ -3016,7 +3020,6 @@ package body Prj.Nmsc is
Element : String_Element; Element : String_Element;
File_Name : File_Name_Type; File_Name : File_Name_Type;
Source : Source_Id; Source : Source_Id;
Iter : Source_Iterator;
begin begin
case Kind is case Kind is
...@@ -3046,11 +3049,13 @@ package body Prj.Nmsc is ...@@ -3046,11 +3049,13 @@ package body Prj.Nmsc is
Element := Data.Tree.String_Elements.Table (Element_Id); Element := Data.Tree.String_Elements.Table (Element_Id);
File_Name := Canonical_Case_File_Name (Element.Value); File_Name := Canonical_Case_File_Name (Element.Value);
Iter := For_Each_Source (Data.Tree, Project); Source := Source_Files_Htable.Get
(Data.Tree.Source_Files_HT, File_Name);
while Source /= No_Source
and then Source.Project /= Project
loop loop
Source := Prj.Element (Iter); Source := Source.Next_With_File_Name;
exit when Source = No_Source or else Source.File = File_Name;
Next (Iter);
end loop; end loop;
if Source = No_Source then if Source = No_Source then
......
gcc/ada/prj.adb
...@@ -876,6 +876,7 @@ package body Prj is ...@@ -876,6 +876,7 @@ package body Prj is
Array_Table.Free (Tree.Arrays); Array_Table.Free (Tree.Arrays);
Package_Table.Free (Tree.Packages); Package_Table.Free (Tree.Packages);
Source_Paths_Htable.Reset (Tree.Source_Paths_HT); Source_Paths_Htable.Reset (Tree.Source_Paths_HT);
Source_Files_Htable.Reset (Tree.Source_Files_HT);
Free_List (Tree.Projects, Free_Project => True); Free_List (Tree.Projects, Free_Project => True);
Free_Units (Tree.Units_HT); Free_Units (Tree.Units_HT);
...@@ -904,6 +905,7 @@ package body Prj is ...@@ -904,6 +905,7 @@ package body Prj is
Array_Table.Init (Tree.Arrays); Array_Table.Init (Tree.Arrays);
Package_Table.Init (Tree.Packages); Package_Table.Init (Tree.Packages);
Source_Paths_Htable.Reset (Tree.Source_Paths_HT); Source_Paths_Htable.Reset (Tree.Source_Paths_HT);
Source_Files_Htable.Reset (Tree.Source_Files_HT);
Replaced_Source_HTable.Reset (Tree.Replaced_Sources); Replaced_Source_HTable.Reset (Tree.Replaced_Sources);
Tree.Replaced_Source_Number := 0; Tree.Replaced_Source_Number := 0;
......
gcc/ada/prj.ads
...@@ -770,6 +770,10 @@ package Prj is ...@@ -770,6 +770,10 @@ package Prj is
Next_In_Lang : Source_Id := No_Source; Next_In_Lang : Source_Id := No_Source;
-- Link to another source of the same language in the same project -- Link to another source of the same language in the same project
Next_With_File_Name : Source_Id := No_Source;
-- Link to another source with the same base file name
end record; end record;
No_Source_Data : constant Source_Data := No_Source_Data : constant Source_Data :=
...@@ -803,7 +807,17 @@ package Prj is ...@@ -803,7 +807,17 @@ package Prj is
Switches_TS => Empty_Time_Stamp, Switches_TS => Empty_Time_Stamp,
Naming_Exception => False, Naming_Exception => False,
Duplicate_Unit => False, Duplicate_Unit => False,
Next_In_Lang => No_Source); Next_In_Lang => No_Source,
Next_With_File_Name => No_Source);
package Source_Files_Htable is new Simple_HTable
(Header_Num => Header_Num,
Element => Source_Id,
No_Element => No_Source,
Key => File_Name_Type,
Hash => Hash,
Equal => "=");
-- Mapping of source file names to source ids
package Source_Paths_Htable is new Simple_HTable package Source_Paths_Htable is new Simple_HTable
(Header_Num => Header_Num, (Header_Num => Header_Num,
...@@ -1367,7 +1381,10 @@ package Prj is ...@@ -1367,7 +1381,10 @@ package Prj is
-- The number of entries in Replaced_Sources -- The number of entries in Replaced_Sources
Units_HT : Units_Htable.Instance; Units_HT : Units_Htable.Instance;
-- Unit name to Unit_Index (and from there so Source_Id) -- Unit name to Unit_Index (and from there to Source_Id)
Source_Files_HT : Source_Files_Htable.Instance;
-- Base source file names to Source_Id list.
Source_Paths_HT : Source_Paths_Htable.Instance; Source_Paths_HT : Source_Paths_Htable.Instance;
-- Full path to Source_Id -- Full path to Source_Id
......
Markdown is supported
0% or
You are about to add 0 people to the discussion. Proceed with caution.
Finish editing this message first!
Please register or to comment