From: Emmanuel Briot Date: Thu, 25 Jun 2009 09:00:52 +0000 (+0000) Subject: fmap.ads, [...] (Source_Data.Get_Object): Field removed, since it can be computed... X-Git-Url: http://review.tizen.org/git/?a=commitdiff_plain;h=1d24fc5e45ad67dd6b622e79e3d5b254e05613dc;p=platform%2Fupstream%2Fgcc.git fmap.ads, [...] (Source_Data.Get_Object): Field removed, since it can be computed efficiently from the other fields. 2009-06-25 Emmanuel Briot * fmap.ads, make.adb, prj.adb, prj.ads, prj-nmsc.adb, prj-env.adb, prj-env.ads (Source_Data.Get_Object): Field removed, since it can be computed efficiently from the other fields. (Object_To_Global_Archive): New subprogram (Create_Mapping): Remove unneeded call to Remove_Forbidden_File_Name. (Override_Kind): Fix handling of separates in Ada. (Create_Mapping_File): Remove duplicate code (Naming_Data.Implementation_Exception, Specification_Exception): field removed, since never used. (Naming_Data.Specs, .Bodies): field removed, since this is only used while processing the project and is not needed once the tree is in memory. This brings Naming_Data and Lang_Naming_Data closer (same content now, but different use still). From-SVN: r148934 --- diff --git a/gcc/ada/ChangeLog b/gcc/ada/ChangeLog index ba22776..03f594b 100644 --- a/gcc/ada/ChangeLog +++ b/gcc/ada/ChangeLog @@ -1,3 +1,19 @@ +2009-06-25 Emmanuel Briot + + * fmap.ads, make.adb, prj.adb, prj.ads, prj-nmsc.adb, prj-env.adb, + prj-env.ads (Source_Data.Get_Object): Field removed, since it can be + computed efficiently from the other fields. + (Object_To_Global_Archive): New subprogram + (Create_Mapping): Remove unneeded call to Remove_Forbidden_File_Name. + (Override_Kind): Fix handling of separates in Ada. + (Create_Mapping_File): Remove duplicate code + (Naming_Data.Implementation_Exception, Specification_Exception): + field removed, since never used. + (Naming_Data.Specs, .Bodies): field removed, since this is only + used while processing the project and is not needed once the tree + is in memory. This brings Naming_Data and Lang_Naming_Data + closer (same content now, but different use still). + 2009-06-25 Pascal Obry * sem_ch4.adb: Minor reformatting. diff --git a/gcc/ada/fmap.ads b/gcc/ada/fmap.ads index 77c1a0e..fb781ce 100644 --- a/gcc/ada/fmap.ads +++ b/gcc/ada/fmap.ads @@ -31,6 +31,7 @@ -- following: -- For each source file, there are three lines in the mapping file: -- Unit name with %b or %s added depending on whether it is a body or a spec +-- This line is omitted for file-based languages -- File name -- Path name (set to '/' if the file should be ignored in fact, ie for -- a Locally_Removed_File in a project) diff --git a/gcc/ada/make.adb b/gcc/ada/make.adb index 5999951..8b1dbd5 100644 --- a/gcc/ada/make.adb +++ b/gcc/ada/make.adb @@ -6643,7 +6643,7 @@ package body Make is Prj.Env.Create_Mapping_File (Project, In_Tree => Project_Tree, - Language => No_Name, + Language => Name_Ada, Name => Data.Mapping_File_Names (Data.Last_Mapping_File_Names)); diff --git a/gcc/ada/prj-env.adb b/gcc/ada/prj-env.adb index d728b05..2659fe4 100644 --- a/gcc/ada/prj-env.adb +++ b/gcc/ada/prj-env.adb @@ -758,10 +758,6 @@ package body Prj.Env is if Data.Locally_Removed then Fmap.Add_Forbidden_File_Name (Data.File); else - -- Put back the file in case it was excluded in an extended - -- project - Fmap.Remove_Forbidden_File_Name (Data.File); - Fmap.Add_To_File_Map (Unit_Name => Unit_Name_Type (Data.Unit.Name), File_Name => Data.File, @@ -779,33 +775,18 @@ package body Prj.Env is procedure Create_Mapping_File (Project : Project_Id; - Language : Name_Id := No_Name; + Language : Name_Id; In_Tree : Project_Tree_Ref; Name : out Path_Name_Type) is File : File_Descriptor := Invalid_FD; Status : Boolean; - Present : Project_Boolean_Htable.Instance; - -- For each project in the closure of Project, the corresponding flag - -- will be set to True. - - Source : Source_Id; - Suffix : File_Name_Type; - Unit : Unit_Index; - Data : Source_Id; - Iter : Source_Iterator; - procedure Put_Name_Buffer; -- Put the line contained in the Name_Buffer in the mapping file - procedure Put_Data (Spec : Boolean); - -- Put the mapping of the spec or body contained in Data in the file - -- (3 lines). - - procedure Recursive_Flag (Prj : Project_Id); - -- Set the flags corresponding to Prj, the projects it imports - -- (directly or indirectly) or extends to True. Call itself recursively. + procedure Process (Project : Project_Id; State : in out Integer); + -- Generate the mapping file for Project (not recursively) --------- -- Put -- @@ -819,81 +800,97 @@ package body Prj.Env is Name_Buffer (Name_Len) := ASCII.LF; Last := Write (File, Name_Buffer (1)'Address, Name_Len); + if Current_Verbosity = High then + Write_Str ("Mapping file: " & Name_Buffer (1 .. Name_Len)); + end if; + if Last /= Name_Len then Prj.Com.Fail ("Disk full, cannot write mapping file"); end if; end Put_Name_Buffer; - -------------- - -- Put_Data -- - -------------- - - procedure Put_Data (Spec : Boolean) is - begin - -- Line with the unit name - - Get_Name_String (Unit.Name); - Name_Len := Name_Len + 1; - Name_Buffer (Name_Len) := '%'; - Name_Len := Name_Len + 1; - - if Spec then - Name_Buffer (Name_Len) := 's'; - else - Name_Buffer (Name_Len) := 'b'; - end if; - - Put_Name_Buffer; + ------------- + -- Process -- + ------------- - -- Line with the file name + procedure Process (Project : Project_Id; State : in out Integer) is + pragma Unreferenced (State); + Source : Source_Id; + Suffix : File_Name_Type; + Iter : Source_Iterator; - Get_Name_String (Data.File); - Put_Name_Buffer; + begin + Iter := For_Each_Source (In_Tree, Project, Language => Language); - -- Line with the path name + loop + Source := Prj.Element (Iter); + exit when Source = No_Source; - if Data.Locally_Removed then - Name_Len := 1; - Name_Buffer (1 .. Name_Len) := "/"; - else - Get_Name_String (Data.Path.Name); - end if; + if Source.Replaced_By = No_Source + and then Source.Path.Name /= No_Path + and then + (Source.Language.Config.Kind = File_Based + or else Source.Unit /= No_Unit_Index) + then + if Source.Unit /= No_Unit_Index then + Get_Name_String (Source.Unit.Name); + + if Get_Mode = Ada_Only then + -- ??? Mapping_Spec_Suffix could be set in the case of + -- gnatmake as well + Name_Len := Name_Len + 1; + Name_Buffer (Name_Len) := '%'; + Name_Len := Name_Len + 1; + + if Source.Kind = Spec then + Name_Buffer (Name_Len) := 's'; + else + Name_Buffer (Name_Len) := 'b'; + end if; + else + case Source.Kind is + when Spec => + Suffix := + Source.Language.Config.Mapping_Spec_Suffix; + when Impl | Sep => + Suffix := + Source.Language.Config.Mapping_Body_Suffix; + end case; + + if Suffix /= No_File then + Add_Str_To_Name_Buffer + (Get_Name_String (Suffix)); + end if; + end if; - Put_Name_Buffer; - end Put_Data; + Put_Name_Buffer; + end if; - -------------------- - -- Recursive_Flag -- - -------------------- + Get_Name_String (Source.File); + Put_Name_Buffer; - procedure Recursive_Flag (Prj : Project_Id) is - Imported : Project_List; + if Source.Locally_Removed then + Name_Len := 1; + Name_Buffer (1) := '/'; + else + Get_Name_String (Source.Path.Name); + end if; - begin - -- Nothing to do for non existent project or project that has already - -- been flagged. + Put_Name_Buffer; + end if; - if Prj /= No_Project - and then not Project_Boolean_Htable.Get (Present, Prj) - then - Project_Boolean_Htable.Set (Present, Prj, True); + Next (Iter); + end loop; + end Process; - Imported := Prj.Imported_Projects; - while Imported /= null loop - Recursive_Flag (Imported.Project); - Imported := Imported.Next; - end loop; + procedure For_Every_Imported_Project is new + For_Every_Project_Imported (State => Integer, Action => Process); - Recursive_Flag (Prj.Extends); - end if; - end Recursive_Flag; + Dummy : Integer := 0; -- Start of processing for Create_Mapping_File begin - -- Flag the necessary projects - - Recursive_Flag (Project); -- Create the temporary file @@ -912,103 +909,7 @@ package body Prj.Env is end if; end if; - if Language = No_Name then - if In_Tree.Private_Part.Fill_Mapping_File then - Unit := Units_Htable.Get_First (In_Tree.Units_HT); - while Unit /= null loop - -- Case of unit has a valid name - - if Unit.Name /= No_Name then - Data := Unit.File_Names (Spec); - - -- If there is a spec, put it mapping in the file if it is - -- from a project in the closure of Project. - - if Data /= No_Source - and then Project_Boolean_Htable.Get (Present, Data.Project) - then - Put_Data (Spec => True); - end if; - - Data := Unit.File_Names (Impl); - - -- If there is a body (or subunit) put its mapping in the - -- file if it is from a project in the closure of Project. - - if Data /= No_Source - and then Project_Boolean_Htable.Get (Present, Data.Project) - then - Put_Data (Spec => False); - end if; - end if; - - Unit := Units_Htable.Get_Next (In_Tree.Units_HT); - end loop; - end if; - - -- If language is defined - - else - -- For all source of the Language of all projects in the closure - - declare - P : Project_List; - - begin - P := In_Tree.Projects; - while P /= null loop - if Project_Boolean_Htable.Get (Present, P.Project) then - - Iter := For_Each_Source (In_Tree, P.Project); - loop - Source := Prj.Element (Iter); - exit when Source = No_Source; - - if Source.Language.Name = Language - and then Source.Replaced_By = No_Source - and then Source.Path.Name /= No_Path - then - if Source.Unit /= No_Unit_Index then - Get_Name_String (Source.Unit.Name); - - if Source.Kind = Spec then - Suffix := - Source.Language.Config.Mapping_Spec_Suffix; - else - Suffix := - Source.Language.Config.Mapping_Body_Suffix; - end if; - - if Suffix /= No_File then - Add_Str_To_Name_Buffer - (Get_Name_String (Suffix)); - end if; - - Put_Name_Buffer; - end if; - - Get_Name_String (Source.File); - Put_Name_Buffer; - - if Source.Locally_Removed then - Name_Len := 1; - Name_Buffer (1 .. Name_Len) := "/"; - else - Get_Name_String (Source.Path.Name); - end if; - - Put_Name_Buffer; - end if; - - Next (Iter); - end loop; - end if; - - P := P.Next; - end loop; - end; - end if; - + For_Every_Imported_Project (Project, Dummy); GNAT.OS_Lib.Close (File, Status); if not Status then @@ -1019,8 +920,6 @@ package body Prj.Env is Prj.Com.Fail ("disk full, could not write mapping file"); end if; - - Project_Boolean_Htable.Reset (Present); end Create_Mapping_File; -------------------------- diff --git a/gcc/ada/prj-env.ads b/gcc/ada/prj-env.ads index 34b77aa..a41df8c 100644 --- a/gcc/ada/prj-env.ads +++ b/gcc/ada/prj-env.ads @@ -41,17 +41,13 @@ package Prj.Env is procedure Create_Mapping_File (Project : Project_Id; - Language : Name_Id := No_Name; + Language : Name_Id; In_Tree : Project_Tree_Ref; Name : out Path_Name_Type); -- Create a temporary mapping file for project Project. For each source or -- template of Language in the Project, put the mapping of its file -- name and path name in this file. -- - -- This function either looks at all the source files for the specified - -- language in the project, or if Language is set to No_Name, at all - -- units in the project. - -- -- Implementation note: we pass a language name, not a language_index here, -- since the latter would have to match exactly the index of that language -- for the specified project, and that is not information available in diff --git a/gcc/ada/prj-nmsc.adb b/gcc/ada/prj-nmsc.adb index 9b345b4..4793ad2 100644 --- a/gcc/ada/prj-nmsc.adb +++ b/gcc/ada/prj-nmsc.adb @@ -277,9 +277,14 @@ package body Prj.Nmsc is procedure Check_Naming_Schemes (Project : Project_Id; In_Tree : Project_Tree_Ref; - Is_Config_File : Boolean); + Is_Config_File : Boolean; + Bodies : out Array_Element_Id; + Specs : out Array_Element_Id); -- Check the naming scheme part of Data. -- Is_Config_File should be True if Project is a config file (.cgpr) + -- This also returns the naming scheme exceptions for unit-based + -- languages (Bodies and Specs are associative arrays mapping individual + -- unit names to source file names). procedure Check_Configuration (Project : Project_Id; @@ -831,6 +836,8 @@ package body Prj.Nmsc is Compiler_Driver_Mandatory : Boolean; Allow_Duplicate_Basenames : Boolean) is + Specs : Array_Element_Id; + Bodies : Array_Element_Id; Extending : Boolean := False; begin @@ -908,13 +915,11 @@ package body Prj.Nmsc is Extending := Project.Extends /= No_Project; - Check_Naming_Schemes (Project, In_Tree, Is_Config_File); + Check_Naming_Schemes (Project, In_Tree, Is_Config_File, Bodies, Specs); if Get_Mode = Ada_Only then - Prepare_Ada_Naming_Exceptions - (Project.Naming.Bodies, In_Tree, Impl); - Prepare_Ada_Naming_Exceptions - (Project.Naming.Specs, In_Tree, Spec); + Prepare_Ada_Naming_Exceptions (Bodies, In_Tree, Impl); + Prepare_Ada_Naming_Exceptions (Specs, In_Tree, Spec); end if; -- Find the sources @@ -929,11 +934,11 @@ package body Prj.Nmsc is -- of this project file. Warn_If_Not_Sources - (Project, In_Tree, Project.Naming.Bodies, + (Project, In_Tree, Bodies, Specs => False, Extending => Extending); Warn_If_Not_Sources - (Project, In_Tree, Project.Naming.Specs, + (Project, In_Tree, Specs, Specs => True, Extending => Extending); @@ -2700,7 +2705,9 @@ package body Prj.Nmsc is procedure Check_Naming_Schemes (Project : Project_Id; In_Tree : Project_Tree_Ref; - Is_Config_File : Boolean) + Is_Config_File : Boolean; + Bodies : out Array_Element_Id; + Specs : out Array_Element_Id) is Naming_Id : constant Package_Id := Util.Value_Of (Name_Naming, Project.Decl.Packages, In_Tree); @@ -3163,20 +3170,18 @@ package body Prj.Nmsc is Separate_Suffix => Project.Naming.Separate_Suffix, Sep_Suffix_Loc => Sep_Suffix_Loc); - Project.Naming.Bodies := - Util.Value_Of (Name_Body, Naming.Decl.Arrays, In_Tree); + Bodies := Util.Value_Of (Name_Body, Naming.Decl.Arrays, In_Tree); - if Project.Naming.Bodies /= No_Array_Element then + if Bodies /= No_Array_Element then Check_And_Normalize_Unit_Names - (Project, In_Tree, Project.Naming.Bodies, "Naming.Bodies"); + (Project, In_Tree, Bodies, "Naming.Bodies"); end if; - Project.Naming.Specs := - Util.Value_Of (Name_Spec, Naming.Decl.Arrays, In_Tree); + Specs := Util.Value_Of (Name_Spec, Naming.Decl.Arrays, In_Tree); - if Project.Naming.Specs /= No_Array_Element then + if Specs /= No_Array_Element then Check_And_Normalize_Unit_Names - (Project, In_Tree, Project.Naming.Specs, "Naming.Specs"); + (Project, In_Tree, Specs, "Naming.Specs"); end if; -- Check Spec_Suffix @@ -3374,6 +3379,9 @@ package body Prj.Nmsc is -- Start of processing for Check_Naming_Schemes begin + Specs := No_Array_Element; + Bodies := No_Array_Element; + -- No Naming package or parsing a configuration file? nothing to do if Naming_Id /= No_Package and not Is_Config_File then @@ -4229,20 +4237,6 @@ package body Prj.Nmsc is Project.Naming.Body_Suffix := Impl_Suffixs; end if; end; - - -- Get the exceptions, if any - - Project.Naming.Specification_Exceptions := - Util.Value_Of - (Name_Specification_Exceptions, - In_Arrays => Naming.Decl.Arrays, - In_Tree => In_Tree); - - Project.Naming.Implementation_Exceptions := - Util.Value_Of - (Name_Implementation_Exceptions, - In_Arrays => Naming.Decl.Arrays, - In_Tree => In_Tree); end if; end Check_Package_Naming; @@ -7324,16 +7318,22 @@ package body Prj.Nmsc is ------------------- procedure Override_Kind (Source : Source_Id; Kind : Source_Kind) is - Unit : constant Unit_Index := Source.Unit; begin - -- Remove reference in the unit, if necessary + -- If the file was previously already associated with a unit, change it - if Unit /= null + if Source.Unit /= null and then Source.Kind in Spec_Or_Body - and then Unit.File_Names (Source.Kind) /= null + and then Source.Unit.File_Names (Source.Kind) /= null then - Unit.File_Names (Source.Kind).Unit := No_Unit_Index; - Unit.File_Names (Source.Kind) := null; + -- If we had another file referencing the same unit (for instance it + -- was in an extended project), that source file is in fact invisible + -- from now on, and in particular doesn't belong to the same unit + + if Source.Unit.File_Names (Source.Kind) /= Source then + Source.Unit.File_Names (Source.Kind).Unit := No_Unit_Index; + end if; + + Source.Unit.File_Names (Source.Kind) := null; end if; Source.Kind := Kind; diff --git a/gcc/ada/prj.adb b/gcc/ada/prj.adb index 7d96eec..e66182f 100644 --- a/gcc/ada/prj.adb +++ b/gcc/ada/prj.adb @@ -73,11 +73,7 @@ package body Prj is Casing => All_Lower_Case, Spec_Suffix => No_Array_Element, Body_Suffix => No_Array_Element, - Separate_Suffix => No_File, - Specs => No_Array_Element, - Bodies => No_Array_Element, - Specification_Exceptions => No_Array_Element, - Implementation_Exceptions => No_Array_Element); + Separate_Suffix => No_File); Project_Empty : constant Project_Data := (Qualifier => Unspecified, @@ -1455,6 +1451,19 @@ package body Prj is and then not Source.Locally_Removed; end Is_Compilable; + ------------------------------ + -- Object_To_Global_Archive -- + ------------------------------ + + function Object_To_Global_Archive (Source : Source_Id) return Boolean is + begin + return Source.Language.Config.Kind = File_Based + and then Source.Kind = Impl + and then Source.Language.Config.Objects_Linked + and then Is_Compilable (Source) + and then Source.Language.Config.Object_Generated; + end Object_To_Global_Archive; + ---------------------------- -- Get_Language_From_Name -- ---------------------------- diff --git a/gcc/ada/prj.ads b/gcc/ada/prj.ads index 456c172..8c564f8 100644 --- a/gcc/ada/prj.ads +++ b/gcc/ada/prj.ads @@ -399,6 +399,12 @@ package Prj is -- Return True if we know how to compile Source (i.e. if a compiler is -- defined). This doesn't indicate whether the source should be compiled. + function Object_To_Global_Archive (Source : Source_Id) return Boolean; + pragma Inline (Object_To_Global_Archive); + -- Return True if the object file should be put in the global archive. + -- This is for Ada, when only the closure of a main needs to be + -- (re)compiled. + function Other_Part (Source : Source_Id) return Source_Id; pragma Inline (Other_Part); -- Source ID for the other part, if any: for a spec, indicates its body; @@ -662,7 +668,10 @@ package Prj is -- Kind of the source: spec, body or subunit Unit : Unit_Index := No_Unit_Index; - -- Name of the unit, if language is unit based + -- Name of the unit, if language is unit based. This is only set for + -- those finles that are part of the compilation set (for instance a + -- file in an extended project that is overridden will not have this + -- field set). Index : Int := 0; -- Index of the source in a multi unit source file (the same Source_Data @@ -673,11 +682,6 @@ package Prj is Locally_Removed : Boolean := False; -- True if the source has been "excluded" - Get_Object : Boolean := False; - -- Indicates that the object of the source should be put in the global - -- archive. This is for Ada, when only the closure of a main needs to - -- be compiled/recompiled. - Replaced_By : Source_Id := No_Source; File : File_Name_Type := No_File; @@ -747,7 +751,6 @@ package Prj is Unit => No_Unit_Index, Index => 0, Locally_Removed => False, - Get_Object => False, Replaced_By => No_Source, File => No_File, Display_File => No_File, @@ -848,22 +851,6 @@ package Prj is Separate_Suffix : File_Name_Type := No_File; -- String to append to unit name for source file name of an Ada subunit - Specs : Array_Element_Id := No_Array_Element; - -- An associative array mapping individual specs to source file names - -- This is specific to unit-based languages. - - Bodies : Array_Element_Id := No_Array_Element; - -- An associative array mapping individual bodies to source file names - -- This is specific to unit-based languages. - - Specification_Exceptions : Array_Element_Id := No_Array_Element; - -- An associative array listing spec file names that do not have the - -- spec suffix. Not used by Ada. Indexed by programming language name. - - Implementation_Exceptions : Array_Element_Id := No_Array_Element; - -- An associative array listing body file names that do not have the - -- body suffix. Not used by Ada. Indexed by programming language name. - end record; function Spec_Suffix_Of