diff options
Diffstat (limited to 'gcc')
| -rw-r--r-- | gcc/ada/ChangeLog | 20 | ||||
| -rw-r--r-- | gcc/ada/clean.adb | 58 | ||||
| -rw-r--r-- | gcc/ada/gnatcmd.adb | 92 | ||||
| -rw-r--r-- | gcc/ada/make.adb | 311 | ||||
| -rw-r--r-- | gcc/ada/mlib-prj.adb | 81 | ||||
| -rw-r--r-- | gcc/ada/prj-env.adb | 130 | ||||
| -rw-r--r-- | gcc/ada/prj-nmsc.adb | 346 | ||||
| -rw-r--r-- | gcc/ada/prj-proc.adb | 5 | ||||
| -rw-r--r-- | gcc/ada/prj.adb | 93 | ||||
| -rw-r--r-- | gcc/ada/prj.ads | 67 |
10 files changed, 572 insertions, 631 deletions
diff --git a/gcc/ada/ChangeLog b/gcc/ada/ChangeLog index 40d738e6316..94ac0243f86 100644 --- a/gcc/ada/ChangeLog +++ b/gcc/ada/ChangeLog @@ -1,3 +1,23 @@ +2009-06-24 Emmanuel Briot <briot@adacore.com> + + * gnatcmd.adb, make.adb, mlib-prj.adb, prj.adb, prj.ads, clean.adb, + prj-nmsc.adb, prj-env.adb, prj-proc.adb (Units_Table): Removed, since + no longer useful. + (Source_Data.Lang_Kind): Removed, since it duplicates information + already available through Language.Config. + (Source_Data.Compile): Removed, since information is already available + through the language. + (Is_Compilable): New subprogram. + (Source_Data.Dependency): Removed, since already available through + the language. + (Source_Data.Object_Exist, Object_Linked): Removed since available + through the language already. + (Unit_Data.File_Names): Is now also set in multi_language mode, to + bring the two modes closer in the resulting data structures. + (Source_Data.Unit): Now a direct pointer to the unit data, rather than + just the name that would point into a hash table. + (Get_Language_From_Name): New subprogram. + 2009-06-24 Javier Miranda <miranda@adacore.com> * exp_ch4.adb (Expand_N_Type_Conversion): Handle entities that are diff --git a/gcc/ada/clean.adb b/gcc/ada/clean.adb index 933a97bbee3..fa03e5cfac9 100644 --- a/gcc/ada/clean.adb +++ b/gcc/ada/clean.adb @@ -540,7 +540,7 @@ package body Clean is Last : Natural; Delete_File : Boolean; - Unit : Unit_Data; + Unit : Unit_Index; begin if Project.Library @@ -570,13 +570,11 @@ package body Clean is Canonical_Case_File_Name (Name (1 .. Last)); Delete_File := False; - -- Compare with source file names of the project + Unit := Units_Htable.Get_First (Project_Tree.Units_HT); - for Index in - 1 .. Unit_Table.Last (Project_Tree.Units) - loop - Unit := Project_Tree.Units.Table (Index); + -- Compare with source file names of the project + while Unit /= No_Unit_Index loop if Unit.File_Names (Impl) /= null and then Ultimate_Extending_Project_Of (Unit.File_Names (Impl).Project) = Project @@ -599,6 +597,8 @@ package body Clean is Delete_File := True; exit; end if; + + Unit := Units_Htable.Get_Next (Project_Tree.Units_HT); end loop; if Delete_File then @@ -733,15 +733,13 @@ package body Clean is if Last > 4 and then Name (Last - 3 .. Last) = ".ali" then declare - Unit : Unit_Data; + Unit : Unit_Index; begin -- Compare with ALI file names of the project - for - Index in 1 .. Unit_Table.Last (Project_Tree.Units) - loop - Unit := Project_Tree.Units.Table (Index); - + Unit := Units_Htable.Get_First + (Project_Tree.Units_HT); + while Unit /= No_Unit_Index loop if Unit.File_Names (Impl) /= null and then Unit.File_Names (Impl).Project /= No_Project @@ -781,6 +779,9 @@ package body Clean is exit; end if; end if; + + Unit := Units_Htable.Get_Next + (Project_Tree.Units_HT); end loop; end; end if; @@ -817,7 +818,7 @@ package body Clean is -- Name of the executable file Current_Dir : constant Dir_Name_Str := Get_Current_Dir; - U_Data : Unit_Data; + Unit : Unit_Index; File_Name1 : File_Name_Type; Index1 : Int; File_Name2 : File_Name_Type; @@ -879,10 +880,8 @@ package body Clean is if Has_Ada_Sources (Project) or else Project.Extends /= No_Project then - for Unit in Unit_Table.First .. - Unit_Table.Last (Project_Tree.Units) - loop - U_Data := Project_Tree.Units.Table (Unit); + Unit := Units_Htable.Get_First (Project_Tree.Units_HT); + while Unit /= No_Unit_Index loop File_Name1 := No_File; File_Name2 := No_File; @@ -890,29 +889,26 @@ package body Clean is -- project, check for the corresponding ALI file in the -- object directory. - if (U_Data.File_Names (Impl) /= null + if (Unit.File_Names (Impl) /= null and then In_Extension_Chain - (U_Data.File_Names (Impl).Project, Project)) + (Unit.File_Names (Impl).Project, Project)) or else - (U_Data.File_Names (Spec) /= null + (Unit.File_Names (Spec) /= null and then In_Extension_Chain - (U_Data.File_Names - (Spec).Project, Project)) + (Unit.File_Names (Spec).Project, Project)) then - if U_Data.File_Names (Impl) /= null then - File_Name1 := U_Data.File_Names (Impl).File; - Index1 := U_Data.File_Names (Impl).Index; + if Unit.File_Names (Impl) /= null then + File_Name1 := Unit.File_Names (Impl).File; + Index1 := Unit.File_Names (Impl).Index; else File_Name1 := No_File; Index1 := 0; end if; - if U_Data.File_Names (Spec) /= null then - File_Name2 := - U_Data.File_Names (Spec).File; - Index2 := - U_Data.File_Names (Spec).Index; + if Unit.File_Names (Spec) /= null then + File_Name2 := Unit.File_Names (Spec).File; + Index2 := Unit.File_Names (Spec).Index; else File_Name2 := No_File; Index2 := 0; @@ -1031,6 +1027,8 @@ package body Clean is end if; end; end if; + + Unit := Units_Htable.Get_Next (Project_Tree.Units_HT); end loop; end if; diff --git a/gcc/ada/gnatcmd.adb b/gcc/ada/gnatcmd.adb index 5b86cf607b0..f19bdd07de4 100644 --- a/gcc/ada/gnatcmd.adb +++ b/gcc/ada/gnatcmd.adb @@ -306,7 +306,7 @@ procedure GNATCmd is procedure Check_Files is Add_Sources : Boolean := True; - Unit_Data : Prj.Unit_Data; + Unit : Prj.Unit_Index; Subunit : Boolean := False; FD : File_Descriptor := Invalid_FD; Status : Integer; @@ -409,27 +409,24 @@ procedure GNATCmd is end loop; end if; - for Unit in Unit_Table.First .. - Unit_Table.Last (Project_Tree.Units) - loop - Unit_Data := Project_Tree.Units.Table (Unit); - + Unit := Units_Htable.Get_First (Project_Tree.Units_HT); + while Unit /= No_Unit_Index loop -- For gnatls, we only need to put the library units, body or -- spec, but not the subunits. if The_Command = List then - if Unit_Data.File_Names (Impl) /= null - and then Unit_Data.File_Names (Impl).Path.Name /= Slash + if Unit.File_Names (Impl) /= null + and then Unit.File_Names (Impl).Path.Name /= Slash then -- There is a body, check if it is for this project if All_Projects or else - Unit_Data.File_Names (Impl).Project = Project + Unit.File_Names (Impl).Project = Project then Subunit := False; - if Unit_Data.File_Names (Spec) = null - or else Unit_Data.File_Names (Spec).Path.Name = Slash + if Unit.File_Names (Spec) = null + or else Unit.File_Names (Spec).Path.Name = Slash then -- We have a body with no spec: we need to check if -- this is a subunit, because gnatls will complain @@ -439,7 +436,7 @@ procedure GNATCmd is Src_Ind : constant Source_File_Index := Sinput.P.Load_Project_File (Get_Name_String - (Unit_Data.File_Names + (Unit.File_Names (Impl).Path.Name)); begin Subunit := @@ -452,25 +449,25 @@ procedure GNATCmd is Last_Switches.Table (Last_Switches.Last) := new String' (Get_Name_String - (Unit_Data.File_Names + (Unit.File_Names (Impl).Display_File)); end if; end if; - elsif Unit_Data.File_Names (Spec) /= null - and then Unit_Data.File_Names (Spec).Path.Name /= Slash + elsif Unit.File_Names (Spec) /= null + and then Unit.File_Names (Spec).Path.Name /= Slash then -- We have a spec with no body. Check if it is for this -- project. if All_Projects or else - Unit_Data.File_Names (Spec).Project = Project + Unit.File_Names (Spec).Project = Project then Last_Switches.Increment_Last; Last_Switches.Table (Last_Switches.Last) := new String' (Get_Name_String - (Unit_Data.File_Names + (Unit.File_Names (Spec).Display_File)); end if; end if; @@ -481,19 +478,19 @@ procedure GNATCmd is -- but not the subunits. elsif The_Command = Stack then - if Unit_Data.File_Names (Impl) /= null - and then Unit_Data.File_Names (Impl).Path.Name /= Slash + if Unit.File_Names (Impl) /= null + and then Unit.File_Names (Impl).Path.Name /= Slash then -- There is a body. Check if .ci files for this project -- must be added. if Check_Project - (Unit_Data.File_Names (Impl).Project, Project) + (Unit.File_Names (Impl).Project, Project) then Subunit := False; - if Unit_Data.File_Names (Spec) = null - or else Unit_Data.File_Names (Spec).Path.Name = Slash + if Unit.File_Names (Spec) = null + or else Unit.File_Names (Spec).Path.Name = Slash then -- We have a body with no spec: we need to check -- if this is a subunit, because .ci files are not @@ -503,7 +500,7 @@ procedure GNATCmd is Src_Ind : constant Source_File_Index := Sinput.P.Load_Project_File (Get_Name_String - (Unit_Data.File_Names + (Unit.File_Names (Impl).Path.Name)); begin Subunit := @@ -516,38 +513,38 @@ procedure GNATCmd is Last_Switches.Table (Last_Switches.Last) := new String' (Get_Name_String - (Unit_Data.File_Names + (Unit.File_Names (Impl).Project. Object_Directory.Name) & Directory_Separator & MLib.Fil.Ext_To (Get_Name_String - (Unit_Data.File_Names + (Unit.File_Names (Impl).Display_File), "ci")); end if; end if; - elsif Unit_Data.File_Names (Spec) /= null - and then Unit_Data.File_Names (Spec).Path.Name /= Slash + elsif Unit.File_Names (Spec) /= null + and then Unit.File_Names (Spec).Path.Name /= Slash then -- We have a spec with no body. Check if it is for this -- project. if Check_Project - (Unit_Data.File_Names (Spec).Project, Project) + (Unit.File_Names (Spec).Project, Project) then Last_Switches.Increment_Last; Last_Switches.Table (Last_Switches.Last) := new String' (Get_Name_String - (Unit_Data.File_Names + (Unit.File_Names (Spec).Project. Object_Directory.Name) & Dir_Separator & MLib.Fil.Ext_To (Get_Name_String - (Unit_Data.File_Names (Spec).File), + (Unit.File_Names (Spec).File), "ci")); end if; end if; @@ -558,13 +555,13 @@ procedure GNATCmd is -- specified. for Kind in Spec_Or_Body loop - if Unit_Data.File_Names (Kind) /= null + if Unit.File_Names (Kind) /= null and then Check_Project - (Unit_Data.File_Names (Kind).Project, Project) - and then Unit_Data.File_Names (Kind).Path.Name /= Slash + (Unit.File_Names (Kind).Project, Project) + and then Unit.File_Names (Kind).Path.Name /= Slash then Get_Name_String - (Unit_Data.File_Names (Kind).Path.Display_Name); + (Unit.File_Names (Kind).Path.Display_Name); if FD /= Invalid_FD then Name_Len := Name_Len + 1; @@ -581,12 +578,14 @@ procedure GNATCmd is Last_Switches.Table (Last_Switches.Last) := new String' (Get_Name_String - (Unit_Data.File_Names + (Unit.File_Names (Kind).Path.Display_Name)); end if; end if; end loop; end if; + + Unit := Units_Htable.Get_Next (Project_Tree.Units_HT); end loop; end; @@ -758,7 +757,7 @@ procedure GNATCmd is -- Used to read file if there is an error, it is good enough to display -- just 250 characters if the first line of the file is very long. - Udata : Unit_Data; + Unit : Unit_Index; Path : Path_Name_Type; begin @@ -817,27 +816,26 @@ procedure GNATCmd is Get_Line (File, Line, Last); Path := No_Path; - for Unit in Unit_Table.First .. - Unit_Table.Last (Project_Tree.Units) - loop - Udata := Project_Tree.Units.Table (Unit); - - if Udata.File_Names (Spec) /= null + Unit := Units_Htable.Get_First (Project_Tree.Units_HT); + while Unit /= No_Unit_Index loop + if Unit.File_Names (Spec) /= null and then - Get_Name_String (Udata.File_Names (Spec).File) = + Get_Name_String (Unit.File_Names (Spec).File) = Line (1 .. Last) then - Path := Udata.File_Names (Spec).Path.Name; + Path := Unit.File_Names (Spec).Path.Name; exit; - elsif Udata.File_Names (Impl) /= null + elsif Unit.File_Names (Impl) /= null and then - Get_Name_String (Udata.File_Names (Impl).File) = + Get_Name_String (Unit.File_Names (Impl).File) = Line (1 .. Last) then - Path := Udata.File_Names (Impl).Path.Name; + Path := Unit.File_Names (Impl).Path.Name; exit; end if; + + Unit := Units_Htable.Get_Next (Project_Tree.Units_HT); end loop; Last_Switches.Increment_Last; diff --git a/gcc/ada/make.adb b/gcc/ada/make.adb index fcbe4fed89a..4eb20f3418f 100644 --- a/gcc/ada/make.adb +++ b/gcc/ada/make.adb @@ -1465,19 +1465,16 @@ package body Make is Sfile : File_Name_Type) return Boolean is UID : Prj.Unit_Index; - U_Data : Unit_Data; begin UID := Units_Htable.Get (Project_Tree.Units_HT, Uname); if UID /= Prj.No_Unit_Index then - U_Data := Project_Tree.Units.Table (UID); - - if (U_Data.File_Names (Impl) = null - or else U_Data.File_Names (Impl).File /= Sfile) + if (UID.File_Names (Impl) = null + or else UID.File_Names (Impl).File /= Sfile) and then - (U_Data.File_Names (Spec) = null - or else U_Data.File_Names (Spec).File /= Sfile) + (UID.File_Names (Spec) = null + or else UID.File_Names (Spec).File /= Sfile) then Verbose_Msg (Uname, "sources do not include ", Name_Id (Sfile)); return True; @@ -1942,12 +1939,11 @@ package body Make is ALI_Project := No_Project; declare - Udata : Prj.Unit_Data; + Udata : Prj.Unit_Index; begin - for U in 1 .. Unit_Table.Last (Project_Tree.Units) loop - Udata := Project_Tree.Units.Table (U); - + Udata := Units_Htable.Get_First (Project_Tree.Units_HT); + while Udata /= No_Unit_Index loop if Udata.File_Names (Impl) /= null and then Udata.File_Names (Impl).File = Source_File then @@ -1962,6 +1958,8 @@ package body Make is Udata.File_Names (Spec).Project; exit; end if; + + Udata := Units_Htable.Get_Next (Project_Tree.Units_HT); end loop; end; @@ -2035,6 +2033,7 @@ package body Make is Projects : array (1 .. Num_Ext) of Project_Id; Dep : Sdep_Record; OK : Boolean := True; + UID : Unit_Index; begin Proj := ALI_Project; @@ -2051,28 +2050,20 @@ package body Make is ALIs.Table (ALI).Last_Sdep loop Dep := Sdep.Table (D); - + UID := Units_Htable.Get_First (Project_Tree.Units_HT); Proj := No_Project; Unit_Loop : - for - UID in 1 .. Unit_Table.Last (Project_Tree.Units) - loop - if Project_Tree.Units.Table (UID). - File_Names (Impl) /= null - and then Project_Tree.Units.Table (UID). - File_Names (Impl).File = Dep.Sfile + while UID /= null loop + if UID.File_Names (Impl) /= null + and then UID.File_Names (Impl).File = Dep.Sfile then - Proj := Project_Tree.Units.Table (UID). - File_Names (Impl).Project; + Proj := UID.File_Names (Impl).Project; - elsif Project_Tree.Units.Table (UID). - File_Names (Spec) /= null - and then Project_Tree.Units.Table (UID). - File_Names (Spec).File = Dep.Sfile + elsif UID.File_Names (Spec) /= null + and then UID.File_Names (Spec).File = Dep.Sfile then - Proj := Project_Tree.Units.Table (UID). - File_Names (Spec).Project; + Proj := UID.File_Names (Spec).Project; end if; -- If a source is in a project, check if it is one @@ -2088,6 +2079,9 @@ package body Make is exit Unit_Loop; end if; + + UID := + Units_Htable.Get_Next (Project_Tree.Units_HT); end loop Unit_Loop; end loop D_Chk; @@ -3605,7 +3599,6 @@ package body Make is declare Unit_Name : Name_Id; Uid : Prj.Unit_Index; - Udata : Unit_Data; begin Get_Name_String (Uname); @@ -3616,26 +3609,24 @@ package body Make is (Project_Tree.Units_HT, Unit_Name); if Uid /= Prj.No_Unit_Index then - Udata := Project_Tree.Units.Table (Uid); - - if Udata.File_Names (Impl) /= null + if Uid.File_Names (Impl) /= null and then - Udata.File_Names (Impl).Path.Name /= + Uid.File_Names (Impl).Path.Name /= Slash then - Sfile := Udata.File_Names (Impl).File; + Sfile := Uid.File_Names (Impl).File; Source_Index := - Udata.File_Names (Impl).Index; + Uid.File_Names (Impl).Index; - elsif Udata.File_Names (Spec) /= null + elsif Uid.File_Names (Spec) /= null and then - Udata.File_Names + Uid.File_Names (Spec).Path.Name /= Slash then Sfile := - Udata.File_Names (Spec).File; + Uid.File_Names (Spec).File; Source_Index := - Udata.File_Names (Spec).Index; + Uid.File_Names (Spec).Index; end if; end if; end; @@ -4384,6 +4375,7 @@ package body Make is Bytes : Integer; OK : Boolean := True; + Unit : Unit_Index; Status : Boolean; -- For call to Close @@ -4396,139 +4388,137 @@ package body Make is -- Traverse all units - for J in Unit_Table.First .. - Unit_Table.Last (Project_Tree.Units) - loop - declare - Unit : constant Unit_Data := Project_Tree.Units.Table (J); - begin - if Unit.Name /= No_Name then + Unit := Units_Htable.Get_First (Project_Tree.Units_HT); - -- If there is a body, put it in the mapping + while Unit /= No_Unit_Index loop + if Unit.Name /= No_Name then - if Unit.File_Names (Impl) /= No_Source - and then Unit.File_Names (Impl).Project /= - No_Project - then - Get_Name_String (Unit.Name); - Add_Str_To_Name_Buffer ("%b"); - ALI_Unit := Name_Find; - ALI_Name := - Lib_File_Name - (Unit.File_Names (Impl).Display_File); - ALI_Project := Unit.File_Names (Impl).Project; - - -- Otherwise, if there is a spec, put it in the - -- mapping. - - elsif Unit.File_Names (Spec) /= No_Source - and then Unit.File_Names (Spec).Project /= - No_Project - then - Get_Name_String (Unit.Name); - Add_Str_To_Name_Buffer ("%s"); - ALI_Unit := Name_Find; - ALI_Name := - Lib_File_Name - (Unit.File_Names (Spec).Display_File); - ALI_Project := Unit.File_Names (Spec).Project; + -- If there is a body, put it in the mapping - else - ALI_Name := No_File; - end if; + if Unit.File_Names (Impl) /= No_Source + and then Unit.File_Names (Impl).Project /= + No_Project + then + Get_Name_String (Unit.Name); + Add_Str_To_Name_Buffer ("%b"); + ALI_Unit := Name_Find; + ALI_Name := + Lib_File_Name + (Unit.File_Names (Impl).Display_File); + ALI_Project := Unit.File_Names (Impl).Project; + + -- Otherwise, if there is a spec, put it in the + -- mapping. + + elsif Unit.File_Names (Spec) /= No_Source + and then Unit.File_Names (Spec).Project /= + No_Project + then + Get_Name_String (Unit.Name); + Add_Str_To_Name_Buffer ("%s"); + ALI_Unit := Name_Find; + ALI_Name := + Lib_File_Name + (Unit.File_Names (Spec).Display_File); + ALI_Project := Unit.File_Names (Spec).Project; - -- If we have something to put in the mapping then do it - -- now. However, if the project is extended, we don't put - -- anything in the mapping file, because we do not know - -- where the ALI file is: it might be in the extended - -- project obj dir as well as in the extending project - -- obj dir. + else + ALI_Name := No_File; + end if; - if ALI_Name /= No_File - and then ALI_Project.Extended_By = No_Project - and then ALI_Project.Extends = No_Project - then - -- First check if the ALI file exists. If it does not, - -- do not put the unit in the mapping file. + -- If we have something to put in the mapping then do it + -- now. However, if the project is extended, we don't put + -- anything in the mapping file, because we do not know + -- where the ALI file is: it might be in the extended + -- project obj dir as well as in the extending project + -- obj dir. + + if ALI_Name /= No_File + and then ALI_Project.Extended_By = No_Project + and then ALI_Project.Extends = No_Project + then + -- First check if the ALI file exists. If it does not, + -- do not put the unit in the mapping file. + + declare + ALI : constant String := Get_Name_String (ALI_Name); + + begin + -- For library projects, use the library directory, + -- for other projects, use the object directory. + + if ALI_Project.Library then + Get_Name_String (ALI_Project.Library_Dir.Name); + else + Get_Name_String + (ALI_Project.Object_Directory.Name); + end if; + + if Name_Buffer (Name_Len) /= + Directory_Separator + then + Add_Char_To_Name_Buffer (Directory_Separator); + end if; + + Add_Str_To_Name_Buffer (ALI); + Add_Char_To_Name_Buffer (ASCII.LF); declare - ALI : constant String := Get_Name_String (ALI_Name); + ALI_Path_Name : constant String := + Name_Buffer (1 .. Name_Len); begin - -- For library projects, use the library directory, - -- for other projects, use the object directory. + if Is_Regular_File + (ALI_Path_Name (1 .. ALI_Path_Name'Last - 1)) + then - if ALI_Project.Library then - Get_Name_String (ALI_Project.Library_Dir.Name); - else - Get_Name_String - (ALI_Project.Object_Directory.Name); - end if; + -- First line is the unit name - if Name_Buffer (Name_Len) /= - Directory_Separator - then - Add_Char_To_Name_Buffer (Directory_Separator); - end if; + Get_Name_String (ALI_Unit); + Add_Char_To_Name_Buffer (ASCII.LF); + Bytes := + Write + (Mapping_FD, + Name_Buffer (1)'Address, + Name_Len); + OK := Bytes = Name_Len; - Add_Str_To_Name_Buffer (ALI); - Add_Char_To_Name_Buffer (ASCII.LF); + exit when not OK; - declare - ALI_Path_Name : constant String := - Name_Buffer (1 .. Name_Len); + -- Second line it the ALI file name - begin - if Is_Regular_File - (ALI_Path_Name (1 .. ALI_Path_Name'Last - 1)) - then - - -- First line is the unit name - - Get_Name_String (ALI_Unit); - Add_Char_To_Name_Buffer (ASCII.LF); - Bytes := - Write - (Mapping_FD, - Name_Buffer (1)'Address, - Name_Len); - OK := Bytes = Name_Len; - - exit when not OK; - - -- Second line it the ALI file name - - Get_Name_String (ALI_Name); - Add_Char_To_Name_Buffer (ASCII.LF); - Bytes := - Write - (Mapping_FD, - Name_Buffer (1)'Address, - Name_Len); - OK := Bytes = Name_Len; - - exit when not OK; - - -- Third line it the ALI path name - - Bytes := - Write - (Mapping_FD, - ALI_Path_Name (1)'Address, - ALI_Path_Name'Length); - OK := Bytes = ALI_Path_Name'Length; - - -- If OK is False, it means we were unable - -- to write a line. No point in continuing - -- with the other units. - - exit when not OK; - end if; - end; + Get_Name_String (ALI_Name); + Add_Char_To_Name_Buffer (ASCII.LF); + Bytes := + Write + (Mapping_FD, + Name_Buffer (1)'Address, + Name_Len); + OK := Bytes = Name_Len; + + exit when not OK; + + -- Third line it the ALI path name + + Bytes := + Write + (Mapping_FD, + ALI_Path_Name (1)'Address, + ALI_Path_Name'Length); + OK := Bytes = ALI_Path_Name'Length; + + -- If OK is False, it means we were unable + -- to write a line. No point in continuing + -- with the other units. + + exit when not OK; + end if; end; - end if; + end; end if; - end; + end if; + + Unit := Units_Htable.Get_Next (Project_Tree.Units_HT); end loop; Close (Mapping_FD, Status); @@ -6968,7 +6958,7 @@ package body Make is Into_Q : Boolean) is Put_In_Q : Boolean := Into_Q; - Unit : Unit_Data; + Unit : Unit_Index; Sfile : File_Name_Type; Index : Int; @@ -7010,10 +7000,9 @@ package body Make is begin -- For all the sources in the project files, - for Id in Unit_Table.First .. - Unit_Table.Last (Project_Tree.Units) - loop - Unit := Project_Tree.Units.Table (Id); + Unit := Units_Htable.Get_First (Project_Tree.Units_HT); + + while Unit /= null loop Sfile := No_File; Index := 0; @@ -7126,6 +7115,8 @@ package body Make is Init_Q; end if; end if; + + Unit := Units_Htable.Get_Next (Project_Tree.Units_HT); end loop; end Insert_Project_Sources; diff --git a/gcc/ada/mlib-prj.adb b/gcc/ada/mlib-prj.adb index 42b1ba66a3e..1be2f786ed8 100644 --- a/gcc/ada/mlib-prj.adb +++ b/gcc/ada/mlib-prj.adb @@ -936,18 +936,16 @@ package body MLib.Prj is -- Bind is False, so that First_ALI is set. declare - Unit : Unit_Data; + Unit : Unit_Index; begin Library_ALIs.Reset; Interface_ALIs.Reset; Processed_ALIs.Reset; - for Source in Unit_Table.First .. - Unit_Table.Last (In_Tree.Units) - loop - Unit := In_Tree.Units.Table (Source); + Unit := Units_Htable.Get_First (In_Tree.Units_HT); + while Unit /= No_Unit_Index loop if Unit.File_Names (Impl) /= null and then Unit.File_Names (Impl).Path.Name /= Slash then @@ -988,6 +986,8 @@ package body MLib.Prj is Add_ALI_For (Unit.File_Names (Spec).File); exit when not Bind; end if; + + Unit := Units_Htable.Get_Next (In_Tree.Units_HT); end loop; end; @@ -1406,6 +1406,7 @@ package body MLib.Prj is B_Start.all); Fname : File_Name_Type; Proj : Project_Id; + Index : Unit_Index; begin if Is_Regular_File (ALI_Path) then @@ -1417,35 +1418,26 @@ package body MLib.Prj is -- the library. if not Add_It then - for Index in - 1 .. Unit_Table.Last - (In_Tree.Units) - loop - if In_Tree.Units.Table - (Index).File_Names - (Impl) /= null + Index := Units_Htable.Get_First + (In_Tree.Units_HT); + while Index /= null loop + if Index.File_Names (Impl) /= + null then Proj := - In_Tree.Units.Table (Index). - File_Names - (Impl).Project; + Index.File_Names (Impl) + .Project; Fname := - In_Tree.Units.Table (Index). - File_Names (Impl).File; + Index.File_Names (Impl).File; - elsif - In_Tree.Units.Table - (Index).File_Names - (Spec) /= null + elsif Index.File_Names (Spec) /= + null then Proj := - In_Tree.Units.Table - (Index).File_Names - (Spec).Project; + Index.File_Names (Spec) + .Project; Fname := - In_Tree.Units.Table - (Index).File_Names - (Spec).File; + Index.File_Names (Spec).File; else Proj := No_Project; @@ -1478,6 +1470,9 @@ package body MLib.Prj is end if; exit when Add_It; + + Index := Units_Htable.Get_Next + (In_Tree.Units_HT); end loop; end if; @@ -1830,16 +1825,13 @@ package body MLib.Prj is and then Name (Last - 3 .. Last) = ".ali" then declare - Unit : Unit_Data; + Unit : Unit_Index; begin -- Compare with ALI file names of the project - for Index in - 1 .. Unit_Table.Last (In_Tree.Units) - loop - Unit := In_Tree.Units.Table (Index); - + Unit := Units_Htable.Get_First (In_Tree.Units_HT); + while Unit /= No_Unit_Index loop if Unit.File_Names (Impl) /= null and then Unit.File_Names (Impl).Project /= No_Project @@ -1880,6 +1872,8 @@ package body MLib.Prj is exit; end if; end if; + + Unit := Units_Htable.Get_Next (In_Tree.Units_HT); end loop; end; end if; @@ -1959,7 +1953,7 @@ package body MLib.Prj is declare Dir : Dir_Type; Delete : Boolean := False; - Unit : Unit_Data; + Unit : Unit_Index; Name : String (1 .. 200); Last : Natural; @@ -1980,9 +1974,8 @@ package body MLib.Prj is -- Compare with source file names of the project - for Index in 1 .. Unit_Table.Last (In_Tree.Units) loop - Unit := In_Tree.Units.Table (Index); - + Unit := Units_Htable.Get_First (In_Tree.Units_HT); + while Unit /= No_Unit_Index loop if Unit.File_Names (Impl) /= null and then Ultimate_Extending_Project_Of (Unit.File_Names (Impl).Project) = For_Project @@ -2007,6 +2000,8 @@ package body MLib.Prj is Delete := True; exit; end if; + + Unit := Units_Htable.Get_Next (In_Tree.Units_HT); end loop; end if; @@ -2163,7 +2158,7 @@ package body MLib.Prj is First_Unit : ALI.Unit_Id; Second_Unit : ALI.Unit_Id; - Data : Unit_Data; + Data : Unit_Index; Copy_Subunits : Boolean := False; -- When True, indicates that subunits, if any, need to be copied too @@ -2186,12 +2181,10 @@ package body MLib.Prj is pragma Warnings (Off, Success); begin - Unit_Loop : - for Index in Unit_Table.First .. - Unit_Table.Last (In_Tree.Units) - loop - Data := In_Tree.Units.Table (Index); + Data := Units_Htable.Get_First (In_Tree.Units_HT); + Unit_Loop : + while Data /= No_Unit_Index loop -- Find and copy the immediate or inherited source for J in Data.File_Names'Range loop @@ -2209,6 +2202,8 @@ package body MLib.Prj is exit Unit_Loop; end if; end loop; + + Data := Units_Htable.Get_Next (In_Tree.Units_HT); end loop Unit_Loop; end Copy; diff --git a/gcc/ada/prj-env.adb b/gcc/ada/prj-env.adb index 1d135cf4a93..6ef82572292 100644 --- a/gcc/ada/prj-env.adb +++ b/gcc/ada/prj-env.adb @@ -397,7 +397,7 @@ package body Prj.Env is File_Name : Path_Name_Type := No_Path; File : File_Descriptor := Invalid_FD; - Current_Unit : Unit_Index := Unit_Table.First; + Current_Unit : Unit_Index := Units_Htable.Get_First (In_Tree.Units_HT); First_Project : Project_List; @@ -673,34 +673,26 @@ package body Prj.Env is -- Visit all the units and process those that need an SFN pragma - while - Current_Unit <= Unit_Table.Last (In_Tree.Units) - loop - declare - Unit : constant Unit_Data := - In_Tree.Units.Table (Current_Unit); - - begin - if Unit.File_Names (Spec) /= null - and then Unit.File_Names (Spec).Naming_Exception - then - Put (Unit.Name, - Unit.File_Names (Spec).File, - Spec, - Unit.File_Names (Spec).Index); - end if; + while Current_Unit /= No_Unit_Index loop + if Current_Unit.File_Names (Spec) /= null + and then Current_Unit.File_Names (Spec).Naming_Exception + then + Put (Current_Unit.Name, + Current_Unit.File_Names (Spec).File, + Spec, + Current_Unit.File_Names (Spec).Index); + end if; - if Unit.File_Names (Impl) /= null - and then Unit.File_Names (Impl).Naming_Exception - then - Put (Unit.Name, - Unit.File_Names (Impl).File, - Impl, - Unit.File_Names (Impl).Index); - end if; + if Current_Unit.File_Names (Impl) /= null + and then Current_Unit.File_Names (Impl).Naming_Exception + then + Put (Current_Unit.Name, + Current_Unit.File_Names (Impl).File, + Impl, + Current_Unit.File_Names (Impl).Index); + end if; - Current_Unit := Current_Unit + 1; - end; + Current_Unit := Units_Htable.Get_Next (In_Tree.Units_HT); end loop; -- If there are no non standard naming scheme, issue the GNAT @@ -746,19 +738,19 @@ package body Prj.Env is -------------------- procedure Create_Mapping (In_Tree : Project_Tree_Ref) is - The_Unit_Data : Unit_Data; + Unit : Unit_Index; Data : Source_Id; begin Fmap.Reset_Tables; - for Unit in 1 .. Unit_Table.Last (In_Tree.Units) loop - The_Unit_Data := In_Tree.Units.Table (Unit); + Unit := Units_Htable.Get_First (In_Tree.Units_HT); + while Unit /= No_Unit_Index loop -- Process only if the unit has a valid name - if The_Unit_Data.Name /= No_Name then - Data := The_Unit_Data.File_Names (Spec); + if Unit.Name /= No_Name then + Data := Unit.File_Names (Spec); -- If there is a spec, put it in the mapping @@ -767,13 +759,13 @@ package body Prj.Env is Fmap.Add_Forbidden_File_Name (Data.File); else Fmap.Add_To_File_Map - (Unit_Name => Unit_Name_Type (The_Unit_Data.Name), + (Unit_Name => Unit_Name_Type (Unit.Name), File_Name => Data.File, Path_Name => File_Name_Type (Data.Path.Name)); end if; end if; - Data := The_Unit_Data.File_Names (Impl); + Data := Unit.File_Names (Impl); -- If there is a body (or subunit) put it in the mapping @@ -782,12 +774,14 @@ package body Prj.Env is Fmap.Add_Forbidden_File_Name (Data.File); else Fmap.Add_To_File_Map - (Unit_Name => Unit_Name_Type (The_Unit_Data.Name), + (Unit_Name => Unit_Name_Type (Unit.Name), File_Name => Data.File, Path_Name => File_Name_Type (Data.Path.Name)); end if; end if; end if; + + Unit := Units_Htable.Get_Next (In_Tree.Units_HT); end loop; end Create_Mapping; @@ -810,7 +804,7 @@ package body Prj.Env is Source : Source_Id; Suffix : File_Name_Type; - The_Unit_Data : Unit_Data; + Unit : Unit_Index; Data : Source_Id; Iter : Source_Iterator; @@ -850,7 +844,7 @@ package body Prj.Env is begin -- Line with the unit name - Get_Name_String (The_Unit_Data.Name); + Get_Name_String (Unit.Name); Name_Len := Name_Len + 1; Name_Buffer (Name_Len) := '%'; Name_Len := Name_Len + 1; @@ -926,13 +920,12 @@ package body Prj.Env is if Language = No_Name then if In_Tree.Private_Part.Fill_Mapping_File then - for Unit in 1 .. Unit_Table.Last (In_Tree.Units) loop - The_Unit_Data := In_Tree.Units.Table (Unit); - + Unit := Units_Htable.Get_First (In_Tree.Units_HT); + while Unit /= null loop -- Case of unit has a valid name - if The_Unit_Data.Name /= No_Name then - Data := The_Unit_Data.File_Names (Spec); + 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. @@ -943,7 +936,7 @@ package body Prj.Env is Put_Data (Spec => True); end if; - Data := The_Unit_Data.File_Names (Impl); + 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. @@ -954,6 +947,8 @@ package body Prj.Env is Put_Data (Spec => False); end if; end if; + + Unit := Units_Htable.Get_Next (In_Tree.Units_HT); end loop; end if; @@ -980,8 +975,8 @@ package body Prj.Env is and then Source.Replaced_By = No_Source and then Source.Path.Name /= No_Path then - if Source.Unit /= No_Name then - Get_Name_String (Source.Unit); + if Source.Unit /= No_Unit_Index then + Get_Name_String (Source.Unit.Name); if Source.Kind = Spec then Suffix := @@ -1111,8 +1106,7 @@ package body Prj.Env is Name & Body_Suffix_Of (In_Tree, "ada", Project.Naming); - Unit : Unit_Data; - + Unit : Unit_Index; The_Original_Name : Name_Id; The_Spec_Name : Name_Id; The_Body_Name : Name_Id; @@ -1154,13 +1148,9 @@ package body Prj.Env is loop -- Loop through units - -- Should have comment explaining reverse ??? - - for Current in reverse Unit_Table.First .. - Unit_Table.Last (In_Tree.Units) - loop - Unit := In_Tree.Units.Table (Current); + Unit := Units_Htable.Get_First (In_Tree.Units_HT); + while Unit /= null loop -- Check for body if not Main_Project_Only @@ -1290,6 +1280,8 @@ package body Prj.Env is end if; end; end if; + + Unit := Units_Htable.Get_Next (In_Tree.Units_HT); end loop; -- If we are not in an extending project, give up @@ -1405,16 +1397,13 @@ package body Prj.Env is declare Original_Name : String := Source_File_Name; - Unit : Unit_Data; + Unit : Unit_Index; begin Canonical_Case_File_Name (Original_Name); + Unit := Units_Htable.Get_First (In_Tree.Units_HT); - for Id in Unit_Table.First .. - Unit_Table.Last (In_Tree.Units) - loop - Unit := In_Tree.Units.Table (Id); - + while Unit /= null loop if Unit.File_Names (Spec) /= null and then Unit.File_Names (Spec).File /= No_File and then @@ -1460,6 +1449,8 @@ package body Prj.Env is return; end if; + + Unit := Units_Htable.Get_Next (In_Tree.Units_HT); end loop; end; @@ -1490,15 +1481,14 @@ package body Prj.Env is -- Could use some comments in this body ??? procedure Print_Sources (In_Tree : Project_Tree_Ref) is - Unit : Unit_Data; + Unit : Unit_Index; begin Write_Line ("List of Sources:"); - for Id in Unit_Table.First .. - Unit_Table.Last (In_Tree.Units) - loop - Unit := In_Tree.Units.Table (Id); + Unit := Units_Htable.Get_First (In_Tree.Units_HT); + + while Unit /= No_Unit_Index loop Write_Str (" "); Write_Line (Namet.Get_Name_String (Unit.Name)); @@ -1534,6 +1524,8 @@ package body Prj.Env is Write_Line (Namet.Get_Name_String (Unit.File_Names (Impl).File)); end if; + + Unit := Units_Htable.Get_Next (In_Tree.Units_HT); end loop; Write_Line ("end of List of Sources."); @@ -1557,7 +1549,7 @@ package body Prj.Env is Extended_Body_Name : String := Name & Body_Suffix_Of (In_Tree, "ada", Main_Project.Naming); - Unit : Unit_Data; + Unit : Unit_Index; Current_Name : File_Name_Type; The_Original_Name : File_Name_Type; @@ -1580,11 +1572,9 @@ package body Prj.Env is Name_Buffer (1 .. Name_Len) := Extended_Body_Name; The_Body_Name := Name_Find; - for Current in reverse Unit_Table.First .. - Unit_Table.Last (In_Tree.Units) - loop - Unit := In_Tree.Units.Table (Current); + Unit := Units_Htable.Get_First (In_Tree.Units_HT); + while Unit /= null loop -- Case of a body present if Unit.File_Names (Impl) /= null then @@ -1618,6 +1608,8 @@ package body Prj.Env is exit; end if; end if; + + Unit := Units_Htable.Get_Next (In_Tree.Units_HT); end loop; -- Get the ultimate extending project diff --git a/gcc/ada/prj-nmsc.adb b/gcc/ada/prj-nmsc.adb index a203f8378df..7565420a590 100644 --- a/gcc/ada/prj-nmsc.adb +++ b/gcc/ada/prj-nmsc.adb @@ -233,7 +233,6 @@ package body Prj.Nmsc is Kind : Source_Kind; File_Name : File_Name_Type; Display_File : File_Name_Type; - Lang_Kind : Language_Kind; Naming_Exception : Boolean := False; Path : Path_Information := No_Path_Information; Alternate_Languages : Language_List := null; @@ -665,7 +664,6 @@ package body Prj.Nmsc is Kind : Source_Kind; File_Name : File_Name_Type; Display_File : File_Name_Type; - Lang_Kind : Language_Kind; Naming_Exception : Boolean := False; Path : Path_Information := No_Path_Information; Alternate_Languages : Language_List := null; @@ -675,6 +673,7 @@ package body Prj.Nmsc is Source_To_Replace : Source_Id := No_Source) is Config : constant Language_Config := Lang_Id.Config; + UData : Unit_Index; begin Id := new Source_Data; @@ -683,7 +682,7 @@ package body Prj.Nmsc is Write_Str ("Adding source File: "); Write_Str (Get_Name_String (File_Name)); - if Lang_Kind = Unit_Based then + if Lang_Id.Config.Kind = Unit_Based then Write_Str (" Unit: "); -- ??? in gprclean, it seems we sometimes pass an empty Unit name -- (see test extended_projects) @@ -699,29 +698,45 @@ package body Prj.Nmsc is Id.Project := Project; Id.Language := Lang_Id; - Id.Lang_Kind := Lang_Kind; - Id.Compiled := Lang_Id.Config.Compiler_Driver /= - Empty_File_Name; Id.Kind := Kind; Id.Alternate_Languages := Alternate_Languages; Id.Other_Part := Other_Part; - Id.Object_Exists := Config.Object_Generated; - Id.Object_Linked := Config.Objects_Linked; - if Other_Part /= No_Source then Other_Part.Other_Part := Id; end if; - Id.Unit := Unit; + -- Add the source id to the Unit_Sources_HT hash table, if the unit name + -- is not null. + + if Unit /= No_Name then + Unit_Sources_Htable.Set (In_Tree.Unit_Sources_HT, Unit, Id); + + -- ??? Record_Unit has already fetched that earlier, so this isn't + -- the most efficient way. But we can't really pass a parameter since + -- Process_Exceptions_Unit_Based and Check_File haven't looked it up. + + UData := Units_Htable.Get (In_Tree.Units_HT, Unit); + if UData = No_Unit_Index then + UData := new Unit_Data; + UData.Name := Unit; + Units_Htable.Set (In_Tree.Units_HT, Unit, UData); + end if; + + UData.File_Names (Kind) := Id; + Id.Unit := UData; + end if; + Id.Index := Index; Id.File := File_Name; Id.Display_File := Display_File; - Id.Dependency := Lang_Id.Config.Dependency_Kind; - Id.Dep_Name := Dependency_Name (File_Name, Id.Dependency); + Id.Dep_Name := Dependency_Name + (File_Name, Lang_Id.Config.Dependency_Kind); Id.Naming_Exception := Naming_Exception; - if Id.Compiled and then Id.Object_Exists then + if Is_Compilable (Id) + and then Config.Object_Generated + then Id.Object := Object_Name (File_Name, Config.Object_File_Suffix); Id.Switches := Switches_Name (File_Name); end if; @@ -731,13 +746,6 @@ package body Prj.Nmsc is Source_Paths_Htable.Set (In_Tree.Source_Paths_HT, Path.Name, Id); end if; - -- Add the source id to the Unit_Sources_HT hash table, if the unit name - -- is not null. - - if Unit /= No_Name then - Unit_Sources_Htable.Set (In_Tree.Unit_Sources_HT, Unit, Id); - end if; - -- Add the source to the language list Id.Next_In_Lang := Lang_Id.First_Source; @@ -1152,13 +1160,6 @@ package body Prj.Nmsc is Prev_Index : Language_Ptr := No_Language_Index; -- The index of the previous language - Current_Language : Name_Id := No_Name; - -- The name of the language - - procedure Get_Language_Index_Of (Language : Name_Id); - -- Get the language index of Language, if Language is one of the - -- languages of the project. - procedure Process_Project_Level_Simple_Attributes; -- Process the simple attributes at the project level @@ -1168,35 +1169,6 @@ package body Prj.Nmsc is procedure Process_Packages; -- Read the packages of the project - --------------------------- - -- Get_Language_Index_Of -- - --------------------------- - - procedure Get_Language_Index_Of (Language : Name_Id) is - Real_Language : Name_Id; - - begin - Get_Name_String (Language); - To_Lower (Name_Buffer (1 .. Name_Len)); - Real_Language := Name_Find; - - -- Nothing to do if the language is the same as the current language - - if Current_Language /= Real_Language then - Lang_Index := Project.Languages; - while Lang_Index /= No_Language_Index loop - exit when Lang_Index.Name = Real_Language; - Lang_Index := Lang_Index.Next; - end loop; - - if Lang_Index = No_Language_Index then - Current_Language := No_Name; - else - Current_Language := Real_Language; - end if; - end if; - end Get_Language_Index_Of; - ---------------------- -- Process_Packages -- ---------------------- @@ -1249,7 +1221,8 @@ package body Prj.Nmsc is -- Get the name of the language - Get_Language_Index_Of (Element.Index); + Lang_Index := Get_Language_From_Name + (Project, Get_Name_String (Element.Index)); if Lang_Index /= No_Language_Index then case Current_Array.Name is @@ -1357,7 +1330,8 @@ package body Prj.Nmsc is -- Get the name of the language - Get_Language_Index_Of (Element.Index); + Lang_Index := Get_Language_From_Name + (Project, Get_Name_String (Element.Index)); if Lang_Index /= No_Language_Index then case Current_Array.Name is @@ -1698,7 +1672,8 @@ package body Prj.Nmsc is -- Get the name of the language - Get_Language_Index_Of (Element.Index); + Lang_Index := Get_Language_From_Name + (Project, Get_Name_String (Element.Index)); if Lang_Index /= No_Language_Index then case Current_Array.Name is @@ -2215,7 +2190,8 @@ package body Prj.Nmsc is -- Get the name of the language - Get_Language_Index_Of (Element.Index); + Lang_Index := Get_Language_From_Name + (Project, Get_Name_String (Element.Index)); if Lang_Index /= No_Language_Index then case Current_Array.Name is @@ -2370,8 +2346,6 @@ package body Prj.Nmsc is Lang_Index := Project.Languages; while Lang_Index /= No_Language_Index loop - Current_Language := Lang_Index.Display_Name; - -- For all languages, Compiler_Driver needs to be specified. This is -- only necessary if we do intend to compiler (not in GPS for -- instance) @@ -2379,7 +2353,7 @@ package body Prj.Nmsc is if Compiler_Driver_Mandatory and then Lang_Index.Config.Compiler_Driver = No_File then - Error_Msg_Name_1 := Current_Language; + Error_Msg_Name_1 := Lang_Index.Display_Name; Error_Msg (Project, In_Tree, @@ -2432,7 +2406,7 @@ package body Prj.Nmsc is if Lang_Index.Config.Naming_Data.Spec_Suffix = No_File and then Lang_Index.Config.Naming_Data.Body_Suffix = No_File then - Error_Msg_Name_1 := Current_Language; + Error_Msg_Name_1 := Lang_Index.Display_Name; Error_Msg (Project, In_Tree, @@ -2900,8 +2874,7 @@ package body Prj.Nmsc is Kind => Kind, File_Name => File_Name, Display_File => File_Name_Type (Element.Value), - Naming_Exception => True, - Lang_Kind => File_Based); + Naming_Exception => True); else -- Check if the file name is already recorded for another @@ -3011,6 +2984,8 @@ package body Prj.Nmsc is if Unit /= No_Name then -- Check if the source already exists + -- ??? In Ada_Only mode (Record_Unit), we use a htable for + -- efficiency Source_To_Replace := No_Source; Iter := For_Each_Source (In_Tree); @@ -3018,7 +2993,9 @@ package body Prj.Nmsc is loop Source := Prj.Element (Iter); exit when Source = No_Source - or else (Source.Unit = Unit and then Source.Index = Index); + or else (Source.Unit /= null + and then Source.Unit.Name = Unit + and then Source.Index = Index); Next (Iter); end loop; @@ -3030,8 +3007,10 @@ package body Prj.Nmsc is Next (Iter); Source := Prj.Element (Iter); - exit when Source = No_Source or else - (Source.Unit = Unit and then Source.Index = Index); + exit when Source = No_Source + or else (Source.Unit /= null + and then Source.Unit.Name = Unit + and then Source.Index = Index); end loop; end if; @@ -3067,7 +3046,6 @@ package body Prj.Nmsc is Kind => Kind, File_Name => File_Name, Display_File => File_Name_Type (Element.Value.Value), - Lang_Kind => Unit_Based, Other_Part => Other_Part, Unit => Unit, Index => Index, @@ -3426,7 +3404,7 @@ package body Prj.Nmsc is loop Src_Id := Prj.Element (Iter); exit when Src_Id = No_Source - or else Src_Id.Lang_Kind /= File_Based + or else Src_Id.Language.Config.Kind /= File_Based or else Src_Id.Kind /= Spec; Next (Iter); end loop; @@ -4451,8 +4429,7 @@ package body Prj.Nmsc is Interfaces : String_List_Id := Lib_Interfaces.Values; Interface_ALIs : String_List_Id := Nil_String; Unit : Name_Id; - The_Unit_Id : Unit_Index; - UData : Unit_Data; + UData : Unit_Index; procedure Add_ALI_For (Source : File_Name_Type); -- Add an ALI file name to the list of Interface ALIs @@ -4526,10 +4503,9 @@ package body Prj.Nmsc is Error_Msg_Name_1 := Unit; if Get_Mode = Ada_Only then - The_Unit_Id := - Units_Htable.Get (In_Tree.Units_HT, Unit); + UData := Units_Htable.Get (In_Tree.Units_HT, Unit); - if The_Unit_Id = No_Unit_Index then + if UData = No_Unit_Index then Error_Msg (Project, In_Tree, "unknown unit %%", @@ -4539,12 +4515,8 @@ package body Prj.Nmsc is else -- Check that the unit is part of the project - UData := In_Tree.Units.Table (The_Unit_Id); - if UData.File_Names (Impl) /= null - and then - UData.File_Names (Impl).Path.Name /= - Slash + and then UData.File_Names (Impl).Path.Name /= Slash then if Check_Project (UData.File_Names (Impl).Project, @@ -4625,8 +4597,10 @@ package body Prj.Nmsc is Iter := For_Each_Source (In_Tree, Project); loop - while Prj.Element (Iter) /= No_Source and then - Prj.Element (Iter).Unit /= Unit + while Prj.Element (Iter) /= No_Source + and then + (Prj.Element (Iter).Unit = null + or else Prj.Element (Iter).Unit.Name /= Unit) loop Next (Iter); end loop; @@ -6928,9 +6902,9 @@ package body Prj.Nmsc is if Source.Naming_Exception and then Source.Path = No_Path_Information then - if Source.Unit /= No_Name then + if Source.Unit /= No_Unit_Index then Error_Msg_Name_1 := Name_Id (Source.Display_File); - Error_Msg_Name_2 := Name_Id (Source.Unit); + Error_Msg_Name_2 := Name_Id (Source.Unit.Name); Error_Msg (Project, In_Tree, "source file %% for unit %% not found", @@ -7360,7 +7334,7 @@ package body Prj.Nmsc is -- Check if this is a subunit - if Name_Loc.Source.Unit /= No_Name + if Name_Loc.Source.Unit /= No_Unit_Index and then Name_Loc.Source.Kind = Impl then Src_Ind := Sinput.P.Load_Project_File @@ -7411,7 +7385,8 @@ package body Prj.Nmsc is exit when Source = No_Source; if Unit /= No_Name - and then Source.Unit = Unit + and then Source.Unit /= No_Unit_Index + and then Source.Unit.Name = Unit and then ((Source.Kind = Spec and then Kind = Impl) or else @@ -7420,7 +7395,8 @@ package body Prj.Nmsc is Other_Part := Source; elsif (Unit /= No_Name - and then Source.Unit = Unit + and then Source.Unit /= No_Unit_Index + and then Source.Unit.Name = Unit and then (Source.Kind = Kind or else @@ -7494,7 +7470,6 @@ package body Prj.Nmsc is In_Tree => In_Tree, Project => Project, Lang_Id => Language, - Lang_Kind => Lang_Kind, Kind => Kind, Alternate_Languages => Alternate_Languages, File_Name => File_Name, @@ -7687,18 +7662,18 @@ package body Prj.Nmsc is (Name => Source.File, Location => No_Location, Source => Source, - Except => Source.Unit /= No_Name, + Except => Source.Unit /= No_Unit_Index, Found => False)); -- If this is an Ada exception, record in table Unit_Exceptions - if Source.Unit /= No_Name then + if Source.Unit /= No_Unit_Index then declare Unit_Except : Unit_Exception := - Unit_Exceptions.Get (Source.Unit); + Unit_Exceptions.Get (Source.Unit.Name); begin - Unit_Except.Name := Source.Unit; + Unit_Except.Name := Source.Unit.Name; if Source.Kind = Spec then Unit_Except.Spec := Source.File; @@ -7706,7 +7681,7 @@ package body Prj.Nmsc is Unit_Except.Impl := Source.File; end if; - Unit_Exceptions.Set (Source.Unit, Unit_Except); + Unit_Exceptions.Set (Source.Unit.Name, Unit_Except); end; end if; @@ -7738,105 +7713,65 @@ package body Prj.Nmsc is procedure Mark_Excluded_Sources is Source : Source_Id := No_Source; OK : Boolean; - Unit : Unit_Data; Excluded : File_Found := Excluded_Sources_Htable.Get_First; - - procedure Exclude - (Extended : Project_Id; - Index : Unit_Index; - Kind : Spec_Or_Body); - -- If the current file (Excluded) belongs to the current project or - -- one that the current project extends, then mark this file/unit as - -- excluded. It is an error to locally remove a file from another - -- project. - - ------------- - -- Exclude -- - ------------- - - procedure Exclude - (Extended : Project_Id; - Index : Unit_Index; - Kind : Spec_Or_Body) - is - begin - if Extended = Project - or else Is_Extending (Project, Extended) - then - OK := True; - - if Index /= No_Unit_Index then - Unit.File_Names (Kind).Path.Name := Slash; - Unit.File_Names (Kind).Naming_Exception := False; - In_Tree.Units.Table (Index) := Unit; - end if; - - if Source /= No_Source then - Source.Locally_Removed := True; - Source.In_Interfaces := False; - end if; - - if Current_Verbosity = High then - Write_Str ("Removing file "); - Write_Line (Get_Name_String (Excluded.File)); - end if; - - Add_Forbidden_File_Name (Excluded.File); - - else - Error_Msg - (Project, In_Tree, - "cannot remove a source from another project", - Excluded.Location); - end if; - end Exclude; - - -- Start of processing for Mark_Excluded_Sources - + Index : Unit_Index; begin while Excluded /= No_File_Found loop OK := False; - case Get_Mode is - when Ada_Only => + -- ??? Don't we have a hash table to map files to Source_Id ? + Iter := For_Each_Source (In_Tree); + loop + Source := Prj.Element (Iter); + exit when Source = No_Source; - -- ??? This loop could be the same as for Multi_Language if - -- we were setting In_Tree.First_Source when we search for - -- Ada sources (basically once we have removed the use of - -- Project.Ada_Sources). + if Source.File = Excluded.File then + if Source.Project = Project + or else Is_Extending (Project, Source.Project) + then + OK := True; + + if Source.Unit /= No_Unit_Index then + Index := + Units_Htable.Get + (In_Tree.Units_HT, Source.Unit.Name); + if Index.File_Names (Source.Kind) /= null then + Index.File_Names (Source.Kind).Path.Name := Slash; + Index.File_Names (Source.Kind).Naming_Exception := + False; + + -- ??? Should we simply set (can be done from the + -- source) + -- Index.File_Names (Source.Kind) := null; + end if; + end if; - For_Each_Unit : - for Index in Unit_Table.First .. - Unit_Table.Last (In_Tree.Units) - loop - Unit := In_Tree.Units.Table (Index); + if Source /= No_Source then + Source.Locally_Removed := True; + Source.In_Interfaces := False; + end if; - for Kind in Spec_Or_Body'Range loop - if Unit.File_Names (Kind) /= null - and then Unit.File_Names (Kind).File = Excluded.File - then - Exclude (Unit.File_Names (Kind).Project, Index, Kind); - exit For_Each_Unit; + if Current_Verbosity = High then + Write_Str ("Removing file "); + Write_Line (Get_Name_String (Excluded.File)); end if; - end loop; - end loop For_Each_Unit; - when Multi_Language => - Iter := For_Each_Source (In_Tree); - loop - Source := Prj.Element (Iter); - exit when Source = No_Source; + Add_Forbidden_File_Name (Excluded.File); - if Source.File = Excluded.File then - Exclude (Source.Project, No_Unit_Index, Spec); - exit; + else + Error_Msg + (Project, In_Tree, + "cannot remove a source from another project", + Excluded.Location); end if; - Next (Iter); - end loop; + exit; + end if; - OK := OK or Excluded.Found; - end case; + Next (Iter); + end loop; + + OK := OK or Excluded.Found; if not OK then Err_Vars.Error_Msg_File_1 := Excluded.File; @@ -7898,10 +7833,11 @@ package body Prj.Nmsc is Src_Id := Prj.Element (Iter); exit when Src_Id = No_Source; - if Src_Id.Compiled and then Src_Id.Object_Exists + if Is_Compilable (Src_Id) + and then Src_Id.Language.Config.Object_Generated and then Is_Extending (Project, Src_Id.Project) then - if Src_Id.Unit = No_Name then + if Src_Id.Unit = No_Unit_Index then if Src_Id.Kind = Impl then Check_Object (Src_Id); end if; @@ -8081,10 +8017,9 @@ package body Prj.Nmsc is Unit_Kind : Spec_Or_Body; Needs_Pragma : Boolean) is - The_Unit : Unit_Index := + -- ??? Add_Source will look it up again, can we do that only once ? + UData : constant Unit_Index := Units_Htable.Get (In_Tree.Units_HT, Unit_Name); - UData : Unit_Data; - Kind : Source_Kind; Source : Source_Id; To_Record : Boolean := False; The_Location : Source_Ptr := Location; @@ -8101,16 +8036,13 @@ package body Prj.Nmsc is -- unit kind (spec or body), or what is in the unit list is a unit of -- a project we are extending. - if The_Unit /= No_Unit_Index then - UData := In_Tree.Units.Table (The_Unit); - + if UData /= No_Unit_Index then if UData.File_Names (Unit_Kind) = null or else - ((UData.File_Names (Unit_Kind).File = Canonical_File - and then UData.File_Names (Unit_Kind).Path.Name = Slash) - or else UData.File_Names (Unit_Kind).File = No_File - or else Is_Extending - (Project.Extends, UData.File_Names (Unit_Kind).Project)) + (UData.File_Names (Unit_Kind).File = Canonical_File + and then UData.File_Names (Unit_Kind).Path.Name = Slash) + or else Is_Extending + (Project.Extends, UData.File_Names (Unit_Kind).Project) then if UData.File_Names (Unit_Kind) /= null and then UData.File_Names (Unit_Kind).Path.Name = Slash @@ -8120,7 +8052,6 @@ package body Prj.Nmsc is end if; To_Record := True; - Source_Recorded := True; -- If the same file is already in the list, do not add it again @@ -8180,43 +8111,26 @@ package body Prj.Nmsc is Location); else - UData.Name := Unit_Name; - Unit_Table.Increment_Last (In_Tree.Units); - The_Unit := Unit_Table.Last (In_Tree.Units); - Units_Htable.Set (In_Tree.Units_HT, Unit_Name, The_Unit); - - Source_Recorded := True; To_Record := True; end if; end if; if To_Record then Files_Htable.Set (Proc_Data.Units, Canonical_File, Project); - - case Unit_Kind is - when Impl => - Kind := Impl; - when Spec => - Kind := Spec; - end case; - Add_Source (Id => Source, In_Tree => In_Tree, Project => Project, Lang_Id => Ada_Language, - Lang_Kind => Unit_Based, File_Name => Canonical_File, Display_File => File_Name, Unit => Unit_Name, Path => (Canonical_Path, Path_Name), Naming_Exception => Needs_Pragma, - Kind => Kind, + Kind => Unit_Kind, Index => Unit_Ind, Other_Part => No_Source); -- ??? Can we find file ? - - UData.File_Names (Unit_Kind) := Source; - In_Tree.Units.Table (The_Unit) := UData; + Source_Recorded := True; end if; end Record_Unit; @@ -8415,8 +8329,7 @@ package body Prj.Nmsc is is Conv : Array_Element_Id; Unit : Name_Id; - The_Unit_Id : Unit_Index; - The_Unit_Data : Unit_Data; + The_Unit_Data : Unit_Index; Location : Source_Ptr; begin @@ -8427,14 +8340,13 @@ package body Prj.Nmsc is Get_Name_String (Unit); To_Lower (Name_Buffer (1 .. Name_Len)); Unit := Name_Find; - The_Unit_Id := Units_Htable.Get (In_Tree.Units_HT, Unit); + The_Unit_Data := Units_Htable.Get (In_Tree.Units_HT, Unit); Location := In_Tree.Array_Elements.Table (Conv).Value.Location; - if The_Unit_Id = No_Unit_Index then + if The_Unit_Data = No_Unit_Index then Error_Msg (Project, In_Tree, "?unknown unit %%", Location); else - The_Unit_Data := In_Tree.Units.Table (The_Unit_Id); Error_Msg_Name_2 := In_Tree.Array_Elements.Table (Conv).Value.Value; diff --git a/gcc/ada/prj-proc.adb b/gcc/ada/prj-proc.adb index 677c5973746..e5097908274 100644 --- a/gcc/ada/prj-proc.adb +++ b/gcc/ada/prj-proc.adb @@ -321,9 +321,8 @@ package body Prj.Proc is Source1 := Prj.Element (Iter); exit when Source1 = No_Source; - Name := Source1.Unit; - - if Name /= No_Name then + if Source1.Unit /= No_Unit_Index then + Name := Source1.Unit.Name; Source2 := Unit_Htable.Get (Name); if Source2 = No_Source then diff --git a/gcc/ada/prj.adb b/gcc/ada/prj.adb index 30f40fb0035..d3c29c9d370 100644 --- a/gcc/ada/prj.adb +++ b/gcc/ada/prj.adb @@ -149,6 +149,9 @@ package body Prj is procedure Free_List (Languages : in out Language_List); -- Free memory allocated for the list of languages or sources + procedure Free_Units (Table : in out Units_Htable.Instance); + -- Free memory allocated for unit information in the project + procedure Language_Changed (Iter : in out Source_Iterator); procedure Project_Changed (Iter : in out Source_Iterator); -- Called when a new project or language was selected for this iterator. @@ -638,21 +641,10 @@ package body Prj is function Is_A_Language (Project : Project_Id; - Language_Name : Name_Id) return Boolean - is - Lang_Ind : Language_Ptr; - + Language_Name : Name_Id) return Boolean is begin - Lang_Ind := Project.Languages; - while Lang_Ind /= No_Language_Index loop - if Lang_Ind.Name = Language_Name then - return True; - end if; - - Lang_Ind := Lang_Ind.Next; - end loop; - - return False; + return Get_Language_From_Name + (Project, Get_Name_String (Language_Name)) /= null; end Is_A_Language; ------------------ @@ -860,6 +852,11 @@ package body Prj is while Source /= No_Source loop Tmp := Source.Next_In_Lang; Free_List (Source.Alternate_Languages); + + if Source.Unit /= null then + Source.Unit.File_Names (Source.Kind) := null; + end if; + Unchecked_Free (Source); Source := Tmp; end loop; @@ -907,6 +904,32 @@ package body Prj is end loop; end Free_List; + ---------------- + -- Free_Units -- + ---------------- + + procedure Free_Units (Table : in out Units_Htable.Instance) is + procedure Unchecked_Free is new Ada.Unchecked_Deallocation + (Unit_Data, Unit_Index); + Unit : Unit_Index; + begin + Unit := Units_Htable.Get_First (Table); + + while Unit /= No_Unit_Index loop + if Unit.File_Names (Spec) /= null then + Unit.File_Names (Spec).Unit := No_Unit_Index; + end if; + if Unit.File_Names (Impl) /= null then + Unit.File_Names (Impl).Unit := No_Unit_Index; + end if; + + Unchecked_Free (Unit); + Unit := Units_Htable.Get_Next (Table); + end loop; + + Units_Htable.Reset (Table); + end Free_Units; + ---------- -- Free -- ---------- @@ -923,12 +946,11 @@ package body Prj is Array_Element_Table.Free (Tree.Array_Elements); Array_Table.Free (Tree.Arrays); Package_Table.Free (Tree.Packages); - Unit_Table.Free (Tree.Units); - Units_Htable.Reset (Tree.Units_HT); Source_Paths_Htable.Reset (Tree.Source_Paths_HT); Unit_Sources_Htable.Reset (Tree.Unit_Sources_HT); Free_List (Tree.Projects, Free_Project => True); + Free_Units (Tree.Units_HT); -- Private part @@ -961,12 +983,11 @@ package body Prj is Array_Element_Table.Init (Tree.Array_Elements); Array_Table.Init (Tree.Arrays); Package_Table.Init (Tree.Packages); - Unit_Table.Init (Tree.Units); - Units_Htable.Reset (Tree.Units_HT); Source_Paths_Htable.Reset (Tree.Source_Paths_HT); Unit_Sources_Htable.Reset (Tree.Unit_Sources_HT); Free_List (Tree.Projects, Free_Project => True); + Free_Units (Tree.Units_HT); -- Private part table @@ -1427,6 +1448,42 @@ package body Prj is For_All_Projects (Project, Dummy); end Compute_All_Imported_Projects; + ------------------- + -- Is_Compilable -- + ------------------- + + function Is_Compilable (Source : Source_Id) return Boolean is + begin + return Source.Language.Config.Compiler_Driver /= Empty_File_Name; + end Is_Compilable; + + ---------------------------- + -- Get_Language_From_Name -- + ---------------------------- + + function Get_Language_From_Name + (Project : Project_Id; Name : String) return Language_Ptr + is + N : Name_Id; + Result : Language_Ptr; + begin + Name_Len := Name'Length; + Name_Buffer (1 .. Name_Len) := Name; + To_Lower (Name_Buffer (1 .. Name_Len)); + N := Name_Find; + + Result := Project.Languages; + while Result /= No_Language_Index loop + if Result.Name = N then + return Result; + end if; + + Result := Result.Next; + end loop; + + return No_Language_Index; + end Get_Language_From_Name; + begin -- Make sure that the standard config and user project file extensions are -- compatible with canonical case file naming. diff --git a/gcc/ada/prj.ads b/gcc/ada/prj.ads index 0ea15df8454..3dd629634c1 100644 --- a/gcc/ada/prj.ads +++ b/gcc/ada/prj.ads @@ -307,6 +307,11 @@ package Prj is No_Language_Index : constant Language_Ptr := null; -- Constant indicating that there is no language data + function Get_Language_From_Name + (Project : Project_Id; Name : String) return Language_Ptr; + -- Get a language from a project. This might return null if no such + -- language exists in the project + Max_Header_Num : constant := 6150; type Header_Num is range 0 .. Max_Header_Num; -- Size for hash table below. The upper bound is an arbitrary value, the @@ -392,6 +397,11 @@ package Prj is type Source_Data; type Source_Id is access all Source_Data; + function Is_Compilable (Source : Source_Id) return Boolean; + pragma Inline (Is_Compilable); + -- Return True if we know how to compile Source (ie if a compiler is + -- defined). This doesn't indicate whether the source should be compiled + No_Source : constant Source_Id := null; type Path_Syntax_Kind is @@ -615,6 +625,17 @@ package Prj is end record; type Source_Kind is (Spec, Impl, Sep); + subtype Spec_Or_Body is Source_Kind range Spec .. Impl; + + type File_Names_Data is array (Spec_Or_Body) of Source_Id; + type Unit_Data is record + Name : Name_Id := No_Name; + File_Names : File_Names_Data; + end record; + type Unit_Index is access Unit_Data; + No_Unit_Index : constant Unit_Index := null; + -- Name and File and Path names of a unit, with a reference to its + -- GNAT Project File(s). type Source_Data is record Project : Project_Id := No_Project; @@ -624,13 +645,6 @@ package Prj is -- Index of the language. This is an index into -- Project_Tree.Languages_Data. - Lang_Kind : Language_Kind := File_Based; - -- Kind of the language - -- ??? Should be in Language itself - - Compiled : Boolean := True; - -- False when there is no compiler for the language - In_Interfaces : Boolean := True; -- False when the source is not included in interfaces, when attribute -- Interfaces is declared. @@ -645,14 +659,11 @@ package Prj is Kind : Source_Kind := Spec; -- Kind of the source: spec, body or subunit - Dependency : Dependency_File_Kind := None; - -- Kind of dependency: none, Makefile fragment or ALI file - Other_Part : Source_Id := No_Source; -- Source ID for the other part, if any: for a spec, indicates its body; -- for a body, indicates its spec. - Unit : Name_Id := No_Name; + Unit : Unit_Index := No_Unit_Index; -- Name of the unit, if language is unit based Index : Int := 0; @@ -686,13 +697,6 @@ package Prj is -- Project where the object file is. This might be different from -- Project when using extending project files. - Object_Exists : Boolean := True; - -- True if an object file exists - - Object_Linked : Boolean := True; - -- False if the object file is not use to link executables or included - -- in libraries. - Object : File_Name_Type := No_File; -- File name of the object file @@ -737,15 +741,12 @@ package Prj is No_Source_Data : constant Source_Data := (Project => No_Project, Language => No_Language_Index, - Lang_Kind => File_Based, - Compiled => True, In_Interfaces => True, Declared_In_Interfaces => False, Alternate_Languages => null, Kind => Spec, - Dependency => None, Other_Part => No_Source, - Unit => No_Name, + Unit => No_Unit_Index, Index => 0, Locally_Removed => False, Get_Object => False, @@ -755,8 +756,6 @@ package Prj is Path => No_Path_Information, Source_TS => Empty_Time_Stamp, Object_Project => No_Project, - Object_Exists => True, - Object_Linked => True, Object => No_File, Current_Object_Path => No_Path, Object_Path => No_Path, @@ -1345,25 +1344,6 @@ package Prj is Project_Error : exception; -- Raised by some subprograms in Prj.Attr - subtype Spec_Or_Body is Source_Kind range Spec .. Impl; - type File_Names_Data is array (Spec_Or_Body) of Source_Id; - type Unit_Index is new Nat; - No_Unit_Index : constant Unit_Index := 0; - type Unit_Data is record - Name : Name_Id := No_Name; - File_Names : File_Names_Data; - end record; - -- Name and File and Path names of a unit, with a reference to its - -- GNAT Project File(s). - - package Unit_Table is new GNAT.Dynamic_Tables - (Table_Component_Type => Unit_Data, - Table_Index_Type => Unit_Index, - Table_Low_Bound => 1, - Table_Initial => 100, - Table_Increment => 100); - -- Table of all units in a project tree - package Units_Htable is new Simple_HTable (Header_Num => Header_Num, Element => Unit_Index, @@ -1417,7 +1397,6 @@ package Prj is Arrays : Array_Table.Instance; Packages : Package_Table.Instance; Projects : Project_List; - Units : Unit_Table.Instance; Units_HT : Units_Htable.Instance; Source_Paths_HT : Source_Paths_Htable.Instance; Unit_Sources_HT : Unit_Sources_Htable.Instance; |