diff options
| -rw-r--r-- | gcc/ada/clean.adb | 103 | ||||
| -rw-r--r-- | gcc/ada/fmap.adb | 53 | ||||
| -rw-r--r-- | gcc/ada/gnatcmd.adb | 71 | ||||
| -rw-r--r-- | gcc/ada/gnatname.adb | 4 | ||||
| -rw-r--r-- | gcc/ada/makegpr.adb | 42 | ||||
| -rw-r--r-- | gcc/ada/makeutl.adb | 94 | ||||
| -rw-r--r-- | gcc/ada/makeutl.ads | 36 | ||||
| -rw-r--r-- | gcc/ada/mlib-prj.adb | 347 | ||||
| -rw-r--r-- | gcc/ada/mlib-tgt-aix.adb | 23 | ||||
| -rw-r--r-- | gcc/ada/mlib-tgt-darwin.adb | 97 | ||||
| -rw-r--r-- | gcc/ada/mlib-tgt-hpux.adb | 104 | ||||
| -rw-r--r-- | gcc/ada/mlib-tgt-irix.adb | 116 | ||||
| -rw-r--r-- | gcc/ada/mlib-tgt-linux.adb | 119 | ||||
| -rw-r--r-- | gcc/ada/mlib-tgt-lynxos.adb | 22 | ||||
| -rw-r--r-- | gcc/ada/mlib-tgt-mingw.adb | 35 | ||||
| -rw-r--r-- | gcc/ada/mlib-tgt-solaris.adb | 105 | ||||
| -rw-r--r-- | gcc/ada/mlib-tgt-tru64.adb | 109 | ||||
| -rw-r--r-- | gcc/ada/mlib-tgt-vms-alpha.adb | 18 | ||||
| -rw-r--r-- | gcc/ada/mlib-tgt-vms-ia64.adb | 20 | ||||
| -rw-r--r-- | gcc/ada/mlib-tgt-vms.adb | 14 | ||||
| -rw-r--r-- | gcc/ada/mlib-tgt-vxworks.adb | 25 | ||||
| -rw-r--r-- | gcc/ada/mlib-tgt.adb | 35 | ||||
| -rw-r--r-- | gcc/ada/mlib-tgt.ads | 59 | ||||
| -rw-r--r-- | gcc/ada/mlib.adb | 144 | ||||
| -rw-r--r-- | gcc/ada/mlib.ads | 17 | ||||
| -rw-r--r-- | gcc/ada/sinput-p.adb | 14 | ||||
| -rw-r--r-- | gcc/ada/sinput-p.ads | 7 |
27 files changed, 1015 insertions, 818 deletions
diff --git a/gcc/ada/clean.adb b/gcc/ada/clean.adb index 7bfc424..d4692ba 100644 --- a/gcc/ada/clean.adb +++ b/gcc/ada/clean.adb @@ -168,15 +168,13 @@ package body Clean is ----------------------------- procedure Add_Source_Dir (N : String); - -- Call Add_Src_Search_Dir. - -- Output one line when in verbose mode. + -- Call Add_Src_Search_Dir and output one line when in verbose mode procedure Add_Source_Directories is new Prj.Env.For_All_Source_Dirs (Action => Add_Source_Dir); procedure Add_Object_Dir (N : String); - -- Call Add_Lib_Search_Dir. - -- Output one line when in verbose mode. + -- Call Add_Lib_Search_Dir and output one line when in verbose mode procedure Add_Object_Directories is new Prj.Env.For_All_Object_Dirs (Action => Add_Object_Dir); @@ -187,9 +185,9 @@ package body Clean is function Assembly_File_Name (Source : File_Name_Type) return String; -- Returns the assembly file name corresponding to Source - procedure Clean_Archive (Project : Project_Id); - -- Delete a global archive or a fake library project archive and the - -- dependency file, if they exist. + procedure Clean_Archive (Project : Project_Id; Global : Boolean); + -- Delete a global archive or library project archive and the dependency + -- file, if they exist. procedure Clean_Executables; -- Do the cleaning work when no project file is specified @@ -199,14 +197,13 @@ package body Clean is -- a source of the project. procedure Clean_Library_Directory (Project : Project_Id); - -- Delete the library file in a library directory and any ALI file - -- of a source of the project in a library ALI directory. + -- Delete the library file in a library directory and any ALI file of a + -- source of the project in a library ALI directory. procedure Clean_Project (Project : Project_Id); - -- Do the cleaning work when a project file is specified. - -- This procedure calls itself recursively when there are several - -- project files in the tree rooted at the main project file and switch -r - -- has been specified. + -- Do the cleaning work when a project file is specified. This procedure + -- calls itself recursively when there are several project files in the + -- tree rooted at the main project file and switch -r has been specified. function Debug_File_Name (Source : File_Name_Type) return String; -- Name of the expanded source file corresponding to Source @@ -252,8 +249,8 @@ package body Clean is -- not itself extended. Returns No_Project if Project is No_Project. procedure Usage; - -- Display the usage. - -- If called several times, the usage is displayed only the first time. + -- Display the usage. If called several times, the usage is displayed only + -- the first time. -------------------- -- Add_Object_Dir -- @@ -337,19 +334,16 @@ package body Clean is -- Clean_Archive -- ------------------- - procedure Clean_Archive (Project : Project_Id) is - Current_Dir : constant Dir_Name_Str := Get_Current_Dir; - Data : constant Project_Data := - Project_Tree.Projects.Table (Project); - Lib_Prefix : constant String := - "lib" & Get_Name_String (Data.Display_Name); + procedure Clean_Archive (Project : Project_Id; Global : Boolean) is + Current_Dir : constant Dir_Name_Str := Get_Current_Dir; + + Data : constant Project_Data := Project_Tree.Projects.Table (Project); - Archive_Name : constant String := - Lib_Prefix & '.' & Archive_Ext; + Lib_Prefix : String_Access; + Archive_Name : String_Access; -- The name of the archive file for this project - Archive_Dep_Name : constant String := - Lib_Prefix & ".deps"; + Archive_Dep_Name : String_Access; -- The name of the archive dependency file for this project Obj_Dir : constant String := @@ -358,12 +352,29 @@ package body Clean is begin Change_Dir (Obj_Dir); - if Is_Regular_File (Archive_Name) then - Delete (Obj_Dir, Archive_Name); + -- First, get the lib prefix, the archive file name and the archive + -- dependency file name. + + if Global then + Lib_Prefix := + new String'("lib" & Get_Name_String (Data.Display_Name)); + else + Lib_Prefix := + new String'("lib" & Get_Name_String (Data.Library_Name)); end if; - if Is_Regular_File (Archive_Dep_Name) then - Delete (Obj_Dir, Archive_Dep_Name); + Archive_Name := new String'(Lib_Prefix.all & '.' & Archive_Ext); + Archive_Dep_Name := new String'(Lib_Prefix.all & ".deps"); + + -- Delete the archive file and the archive dependency file, if they + -- exist. + + if Is_Regular_File (Archive_Name.all) then + Delete (Obj_Dir, Archive_Name.all); + end if; + + if Is_Regular_File (Archive_Dep_Name.all) then + Delete (Obj_Dir, Archive_Dep_Name.all); end if; Change_Dir (Current_Dir); @@ -620,6 +631,8 @@ package body Clean is -- Clean_Library_Directory -- ----------------------------- + Empty_String : aliased String := ""; + procedure Clean_Library_Directory (Project : Project_Id) is Current : constant String := Get_Current_Dir; Data : constant Project_Data := Project_Tree.Projects.Table (Project); @@ -636,8 +649,19 @@ package body Clean is Delete_File : Boolean; + Minor : String_Access := Empty_String'Unchecked_Access; + Major : String_Access := Empty_String'Unchecked_Access; + begin if Data.Library then + if Data.Library_Kind /= Static + and then MLib.Tgt.Library_Major_Minor_Id_Supported + and then Data.Lib_Internal_Name /= No_Name + then + Minor := new String'(Get_Name_String (Data.Lib_Internal_Name)); + Major := new String'(MLib.Major_Id_Name (DLL_Name, Minor.all)); + end if; + declare Lib_Directory : constant String := Get_Name_String (Data.Display_Library_Dir); @@ -663,7 +687,9 @@ package body Clean is declare Filename : constant String := Name (1 .. Last); begin - if Is_Regular_File (Filename) then + if Is_Regular_File (Filename) + or else Is_Symbolic_Link (Filename) + then Canonical_Case_File_Name (Name (1 .. Last)); Delete_File := False; @@ -672,14 +698,16 @@ package body Clean is or else ((Data.Library_Kind = Dynamic or else Data.Library_Kind = Relocatable) - and then Name (1 .. Last) = DLL_Name) + and then + (Name (1 .. Last) = DLL_Name + or else Name (1 .. Last) = Minor.all + or else Name (1 .. Last) = Major.all)) then if not Do_Nothing then Set_Writable (Filename); end if; Delete (Lib_Directory, Filename); - exit; end if; end if; end; @@ -852,7 +880,7 @@ package body Clean is -- Source_Dirs or Source_Files is specified as an empty list, -- so always look for Ada units in extending projects. - if Data.Languages (Ada_Language_Index) + if Data.Langs (Ada_Language_Index) or else Data.Extends /= No_Project then for Unit in Unit_Table.First .. @@ -1011,7 +1039,7 @@ package body Clean is end loop; if Global_Archive then - Clean_Archive (Project); + Clean_Archive (Project, Global => True); end if; end if; @@ -1044,9 +1072,9 @@ package body Clean is -- the fake archive and the dependency file, if they exist. if Data.Library - and then not Data.Languages (Ada_Language_Index) + and then not Data.Langs (Ada_Language_Index) then - Clean_Archive (Project); + Clean_Archive (Project, Global => False); end if; end if; end; @@ -1072,7 +1100,7 @@ package body Clean is then Delete_Binder_Generated_Files (Get_Name_String (Data.Display_Object_Dir), - Data.Library_Name); + File_Name_Type (Data.Library_Name)); end if; end if; @@ -1226,6 +1254,7 @@ package body Clean is else if Force_Deletions or else Is_Writable_File (Full_Name (1 .. Last)) + or else Is_Symbolic_Link (Full_Name (1 .. Last)) then Delete_File (Full_Name (1 .. Last), Success); else diff --git a/gcc/ada/fmap.adb b/gcc/ada/fmap.adb index 381ef27..ea4a258 100644 --- a/gcc/ada/fmap.adb +++ b/gcc/ada/fmap.adb @@ -133,15 +133,26 @@ package body Fmap is File_Name : File_Name_Type; Path_Name : File_Name_Type) is + Unit_Entry : constant Int := Unit_Hash_Table.Get (Unit_Name); + File_Entry : constant Int := File_Hash_Table.Get (File_Name); begin - File_Mapping.Increment_Last; - Unit_Hash_Table.Set (Unit_Name, File_Mapping.Last); - File_Mapping.Table (File_Mapping.Last) := - (Uname => Unit_Name, Fname => File_Name); - Path_Mapping.Increment_Last; - File_Hash_Table.Set (File_Name, Path_Mapping.Last); - Path_Mapping.Table (Path_Mapping.Last) := - (Uname => Unit_Name, Fname => Path_Name); + if Unit_Entry = No_Entry or else + File_Mapping.Table (Unit_Entry).Fname /= File_Name + then + File_Mapping.Increment_Last; + Unit_Hash_Table.Set (Unit_Name, File_Mapping.Last); + File_Mapping.Table (File_Mapping.Last) := + (Uname => Unit_Name, Fname => File_Name); + end if; + + if File_Entry = No_Entry or else + Path_Mapping.Table (File_Entry).Fname /= Path_Name + then + Path_Mapping.Increment_Last; + File_Hash_Table.Set (File_Name, Path_Mapping.Last); + Path_Mapping.Table (Path_Mapping.Last) := + (Uname => Unit_Name, Fname => Path_Name); + end if; end Add_To_File_Map; ---------- @@ -352,18 +363,6 @@ package body Fmap is Name_Buffer (1 .. Name_Len) := SP (First .. Last); Pname := Find_File_Name; - -- Check for duplicate entries - - if Unit_Hash_Table.Get (Uname) /= No_Entry then - Empty_Tables; - return; - end if; - - if File_Hash_Table.Get (Fname) /= No_Entry then - Empty_Tables; - return; - end if; - -- Add the mappings for this unit name Add_To_File_Map (Uname, Fname, Pname); @@ -442,6 +441,8 @@ package body Fmap is File : File_Descriptor; N_Bytes : Integer; + File_Entry : Int; + Status : Boolean; -- For the call to Close @@ -509,13 +510,15 @@ package body Fmap is for Unit in Last_In_Table + 1 .. File_Mapping.Last loop Put_Line (Name_Id (File_Mapping.Table (Unit).Uname)); Put_Line (Name_Id (File_Mapping.Table (Unit).Fname)); - Put_Line (Name_Id (Path_Mapping.Table (Unit).Fname)); + File_Entry := + File_Hash_Table.Get (File_Mapping.Table (Unit).Fname); + Put_Line (Name_Id (Path_Mapping.Table (File_Entry).Fname)); end loop; - -- Before closing the file, write the buffer to the file. - -- It is guaranteed that the Buffer is not empty, because - -- Put_Line has been called at least 3 times, and after - -- a call to Put_Line, the Buffer is not empty. + -- Before closing the file, write the buffer to the file. It is + -- guaranteed that the Buffer is not empty, because Put_Line has + -- been called at least 3 times, and after a call to Put_Line, the + -- Buffer is not empty. N_Bytes := Write (File, Buffer (1)'Address, Buffer_Last); diff --git a/gcc/ada/gnatcmd.adb b/gcc/ada/gnatcmd.adb index 6135b40..a9c9b15 100644 --- a/gcc/ada/gnatcmd.adb +++ b/gcc/ada/gnatcmd.adb @@ -66,15 +66,16 @@ procedure GNATCmd is -- Prefix of binder generated file, changed to b__ for VMS Old_Project_File_Used : Boolean := False; - -- This flag indicates a switch -p (for gnatxref and gnatfind) for an old - -- fashioned project file. -p cannot be used in conjonction with -P. + -- This flag indicates a switch -p (for gnatxref and gnatfind) for + -- an old fashioned project file. -p cannot be used in conjonction + -- with -P. Max_Files_On_The_Command_Line : constant := 30; -- Arbitrary Temp_File_Name : String_Access := null; -- The name of the temporary text file to put a list of source/object - -- files to pass to a tool, when the number of files exceeds the value of - -- Max_Files_On_The_Command_Line. + -- files to pass to a tool, when there are more than + -- Max_Files_On_The_Command_Line files. ASIS_Main : String_Access := null; -- Main for commands Check, Metric and Pretty, when -U is used @@ -220,7 +221,7 @@ procedure GNATCmd is -- exec directory. This procedure is only used for GNAT LINK when a project -- file is specified. - function Configuration_Pragmas_File return Name_Id; + function Configuration_Pragmas_File return Path_Name_Type; -- Return an argument, if there is a configuration pragmas file to be -- specified for Project, otherwise return No_Name. Used for gnatstub (GNAT -- STUB), gnatpp (GNAT PRETTY), gnatelim (GNAT ELIM), and gnatmetric (GNAT @@ -398,12 +399,12 @@ procedure GNATCmd is -- There is a body, check if it is for this project if All_Projects or else - Unit_Data.File_Names (Body_Part).Project = Project + Unit_Data.File_Names (Body_Part).Project = Project then Subunit := False; - if Unit_Data.File_Names (Specification).Name = - No_File + if + Unit_Data.File_Names (Specification).Name = No_File then -- We have a body with no spec: we need to check if -- this is a subunit, because gnatls will complain @@ -687,11 +688,11 @@ procedure GNATCmd is -- Configuration_Pragmas_File -- -------------------------------- - function Configuration_Pragmas_File return Name_Id is + function Configuration_Pragmas_File return Path_Name_Type is begin Prj.Env.Create_Config_Pragmas_File (Project, Project, Project_Tree, Include_Config_Files => False); - return Name_Id (Project_Tree.Projects.Table (Project).Config_File_Name); + return Project_Tree.Projects.Table (Project).Config_File_Name; end Configuration_Pragmas_File; ------------------------------ @@ -776,7 +777,7 @@ procedure GNATCmd is Last : Natural; Udata : Unit_Data; - Path : File_Name_Type; + Path : Path_Name_Type; begin if GN_Path = null then @@ -832,7 +833,7 @@ procedure GNATCmd is while not End_Of_File (File) loop Get_Line (File, Line, Last); - Path := No_File; + Path := No_Path; for Unit in Unit_Table.First .. Unit_Table.Last (Project_Tree.Units) @@ -859,7 +860,7 @@ procedure GNATCmd is Last_Switches.Increment_Last; - if Path /= No_File then + if Path /= No_Path then Last_Switches.Table (Last_Switches.Last) := new String'(Get_Name_String (Path)); @@ -917,7 +918,7 @@ procedure GNATCmd is -- Check if there are library project files - if MLib.Tgt.Support_For_Libraries /= MLib.Tgt.None then + if MLib.Tgt.Support_For_Libraries /= None then Set_Libraries (Project, Project_Tree, There_Are_Libraries); end if; @@ -1354,6 +1355,8 @@ begin VMS_Conv.Initialize; + Set_Mode (Ada_Only); + -- Add the directory where the GNAT driver is invoked in front of the path, -- if the GNAT driver is invoked with directory information. Do not do this -- for VMS, where the notion of path does not really exist. @@ -2023,10 +2026,10 @@ begin end loop; declare - CP_File : constant Name_Id := Configuration_Pragmas_File; + CP_File : constant Path_Name_Type := Configuration_Pragmas_File; begin - if CP_File /= No_Name then + if CP_File /= No_Path then if The_Command = Elim then First_Switches.Increment_Last; First_Switches.Table (First_Switches.Last) := @@ -2093,8 +2096,8 @@ begin -- indicate to gnatstub the name of the body file with -- a -o switch. - if Data.Naming.Ada_Spec_Suffix /= - Prj.Default_Ada_Spec_Suffix + if Body_Suffix_Id_Of (Project_Tree, "ada", Data.Naming) /= + Prj.Default_Ada_Spec_Suffix then if File_Index /= 0 then declare @@ -2103,14 +2106,18 @@ begin Last : Natural := Spec'Last; begin - Get_Name_String (Data.Naming.Ada_Spec_Suffix); + Get_Name_String + (Spec_Suffix_Id_Of + (Project_Tree, "ada", Data.Naming)); if Spec'Length > Name_Len and then Spec (Last - Name_Len + 1 .. Last) = Name_Buffer (1 .. Name_Len) then Last := Last - Name_Len; - Get_Name_String (Data.Naming.Ada_Body_Suffix); + Get_Name_String + (Body_Suffix_Id_Of + (Project_Tree, "ada", Data.Naming)); Last_Switches.Increment_Last; Last_Switches.Table (Last_Switches.Last) := new String'("-o"); @@ -2218,6 +2225,17 @@ begin if ASIS_Main /= null then Get_Closure; + -- On VMS, set up again the env var for source dirs file. This is + -- because the call to gnatmake has set this env var to another + -- file that has now been deleted. + + if Hostparm.OpenVMS then + Setenv + (Project_Include_Path_File, + Prj.Env.Ada_Include_Path + (Project, Project_Tree, Recursive => True)); + end if; + -- For gnat check, gnat pretty, gnat metric, gnat list, and gnat -- stack, if no file has been put on the command line, call tool -- with all the sources of the main project. @@ -2298,13 +2316,18 @@ begin exception when Error_Exit => - Prj.Env.Delete_All_Path_Files (Project_Tree); - Delete_Temp_Config_Files; + if not Keep_Temporary_Files then + Prj.Env.Delete_All_Path_Files (Project_Tree); + Delete_Temp_Config_Files; + end if; + Set_Exit_Status (Failure); when Normal_Exit => - Prj.Env.Delete_All_Path_Files (Project_Tree); - Delete_Temp_Config_Files; + if not Keep_Temporary_Files then + Prj.Env.Delete_All_Path_Files (Project_Tree); + Delete_Temp_Config_Files; + end if; -- Since GNATCmd is normally called from DCL (the VMS shell), it must -- return an understandable VMS exit status. However the exit status diff --git a/gcc/ada/gnatname.adb b/gcc/ada/gnatname.adb index 714ba42..2e040fa 100644 --- a/gcc/ada/gnatname.adb +++ b/gcc/ada/gnatname.adb @@ -6,7 +6,7 @@ -- -- -- B o d y -- -- -- --- Copyright (C) 2001-2006, Free Software Foundation, Inc. -- +-- Copyright (C) 2001-2007, Free Software Foundation, Inc. -- -- -- -- GNAT is free software; you can redistribute it and/or modify it under -- -- terms of the GNU General Public License as published by the Free Soft- -- @@ -299,6 +299,8 @@ procedure Gnatname is -- Start of processing for Gnatname begin + Prj.Set_Mode (Prj.Ada_Only); + -- Add the directory where gnatname is invoked in front of the -- path, if gnatname is invoked with directory information. -- Only do this if the platform is not VMS, where the notion of path diff --git a/gcc/ada/makegpr.adb b/gcc/ada/makegpr.adb index 87dfd86..4925fa1 100644 --- a/gcc/ada/makegpr.adb +++ b/gcc/ada/makegpr.adb @@ -1404,12 +1404,12 @@ package body Makegpr is Source : Other_Source; Archive_Name : constant String := - "lib" & Get_Name_String (Data.Display_Name) + "lib" & Get_Name_String (Data.Library_Name) & '.' & Archive_Ext; -- The name of the archive file for this project Archive_Dep_Name : constant String := - "lib" & Get_Name_String (Data.Display_Name) + "lib" & Get_Name_String (Data.Library_Name) & ".deps"; -- The name of the archive dependency file for this project @@ -1425,6 +1425,12 @@ package body Makegpr is Lib_Opts : Argument_List_Access := No_Argument'Access; begin + -- Nothing to do if the project is externally built + + if Data.Externally_Built then + return; + end if; + Check_Archive_Builder; -- If Unconditionally is False, check if the archive need to be built @@ -1619,7 +1625,7 @@ package body Makegpr is -- If there are sources in Ada, then gnatmake will build the library, -- so nothing to do. - if not Data.Languages (Ada_Language_Index) then + if not Data.Langs (Ada_Language_Index) then -- Get all the object files of the project @@ -1637,7 +1643,6 @@ package body Makegpr is if Data.Library_Kind = Static then MLib.Build_Library (Ofiles => Arguments (1 .. Last_Argument), - Afiles => No_Argument, Output_File => Get_Name_String (Data.Library_Name), Output_Dir => Get_Name_String (Data.Display_Library_Dir)); @@ -1698,10 +1703,7 @@ package body Makegpr is MLib.Tgt.Build_Dynamic_Library (Ofiles => Arguments (1 .. Last_Argument), - Foreign => Arguments (1 .. Last_Argument), - Afiles => No_Argument, - Options => No_Argument, - Options_2 => Lib_Opts.all, + Options => Lib_Opts.all, Interfaces => No_Argument, Lib_Filename => Get_Name_String (Data.Library_Name), Lib_Dir => Get_Name_String (Data.Library_Dir), @@ -1817,6 +1819,7 @@ package body Makegpr is Source_Name : constant String := Get_Name_String (Source.File_Name); Source_Path : constant String := Get_Name_String (Source.Path_Name); Object_Name : constant String := Get_Name_String (Source.Object_Name); + C_Object_Name : String := Object_Name; Dep_Name : constant String := Get_Name_String (Source.Dep_Name); C_Source_Path : String := Source_Path; @@ -1832,6 +1835,7 @@ package body Makegpr is begin Canonical_Case_File_Name (C_Source_Path); + Canonical_Case_File_Name (C_Object_Name); -- Assume the worst, so that statement "return;" may be used if there -- is any problem. @@ -1957,10 +1961,14 @@ package body Makegpr is Start := 1; Finish := Index (Name_Buffer (1 .. Name_Len), ": "); + if Finish /= 0 then + Canonical_Case_File_Name (Name_Buffer (1 .. Finish - 1)); + end if; + -- First line must start with name of object file, followed by colon if Finish = 0 or else - Name_Buffer (1 .. Finish - 1) /= Object_Name + Name_Buffer (1 .. Finish - 1) /= C_Object_Name then if Verbose_Mode then Write_Str (" -> dependency file "); @@ -2155,7 +2163,7 @@ package body Makegpr is Project_Table.Last (Project_Tree.Projects) loop if - Project_Tree.Projects.Table (Project).Languages + Project_Tree.Projects.Table (Project).Langs (C_Plus_Plus_Language_Index) then C_Plus_Plus_Is_Used := True; @@ -2430,7 +2438,7 @@ package body Makegpr is Dummy : Boolean := False; Ada_Is_A_Language : constant Boolean := - Data.Languages (Ada_Language_Index); + Data.Langs (Ada_Language_Index); begin Ada_Mains.Init; @@ -2814,7 +2822,7 @@ package body Makegpr is if not Local_Errors and then Data.Library - and then not Data.Languages (Ada_Language_Index) + and then not Data.Langs (Ada_Language_Index) and then not Compile_Only then Build_Library (Project, Need_To_Rebuild_Archive); @@ -3349,6 +3357,8 @@ package body Makegpr is procedure Initialize is begin + Set_Mode (Ada_Only); + -- Do some necessary package initializations Csets.Initialize; @@ -3795,7 +3805,7 @@ package body Makegpr is -- Only Ada sources in the main project, and even maybe not - if not Data.Languages (Ada_Language_Index) then + if not Data.Langs (Ada_Language_Index) then -- Fail if the main project has no source of any language @@ -3825,7 +3835,7 @@ package body Makegpr is -- There are other language sources. First check if there are also -- sources in Ada. - if Data.Languages (Ada_Language_Index) then + if Data.Langs (Ada_Language_Index) then -- There is a mix of Ada and other language sources in the main -- project. Any main that is not a source of the other languages @@ -3953,7 +3963,7 @@ package body Makegpr is -- If C++ is one of the languages, add the --LINK switch to -- the linking switches. - if Data.Languages (C_Plus_Plus_Language_Index) then + if Data.Langs (C_Plus_Plus_Language_Index) then Add_Argument (Dash_largs, Verbose_Mode); Add_C_Plus_Plus_Link_For_Gnatmake; Add_Argument (Dash_margs, Verbose_Mode); @@ -3969,7 +3979,7 @@ package body Makegpr is -- First, get the linker to invoke - if Data.Languages (C_Plus_Plus_Language_Index) then + if Data.Langs (C_Plus_Plus_Language_Index) then Get_Compiler (C_Plus_Plus_Language_Index); Linker_Name := Compiler_Names (C_Plus_Plus_Language_Index); Linker_Path := Compiler_Paths (C_Plus_Plus_Language_Index); diff --git a/gcc/ada/makeutl.adb b/gcc/ada/makeutl.adb index 0a95873..af1326c 100644 --- a/gcc/ada/makeutl.adb +++ b/gcc/ada/makeutl.adb @@ -24,9 +24,9 @@ -- -- ------------------------------------------------------------------------------ -with Ada.Command_Line; use Ada.Command_Line; - +with Ada.Command_Line; use Ada.Command_Line; with Osint; use Osint; +with Output; use Output; with Prj.Ext; with Prj.Util; with Snames; use Snames; @@ -83,6 +83,46 @@ package body Makeutl is procedure Add_Linker_Option (Option : String); + --------- + -- Add -- + --------- + + procedure Add + (Option : String_Access; + To : in out String_List_Access; + Last : in out Natural) + is + begin + if Last = To'Last then + declare + New_Options : constant String_List_Access := + new String_List (1 .. To'Last * 2); + begin + New_Options (To'Range) := To.all; + + -- Set all elements of the original options to null to avoid + -- deallocation of copies. + + To.all := (others => null); + + Free (To); + To := New_Options; + end; + end if; + + Last := Last + 1; + To (Last) := Option; + end Add; + + procedure Add + (Option : String; + To : in out String_List_Access; + Last : in out Natural) + is + begin + Add (Option => new String'(Option), To => To, Last => Last); + end Add; + ----------------------- -- Add_Linker_Option -- ----------------------- @@ -110,6 +150,31 @@ package body Makeutl is end if; end Add_Linker_Option; + ----------------- + -- Create_Name -- + ----------------- + + function Create_Name (Name : String) return File_Name_Type is + begin + Name_Len := 0; + Add_Str_To_Name_Buffer (Name); + return Name_Find; + end Create_Name; + + function Create_Name (Name : String) return Name_Id is + begin + Name_Len := 0; + Add_Str_To_Name_Buffer (Name); + return Name_Find; + end Create_Name; + + function Create_Name (Name : String) return Path_Name_Type is + begin + Name_Len := 0; + Add_Str_To_Name_Buffer (Name); + return Name_Find; + end Create_Name; + ---------------------- -- Delete_All_Marks -- ---------------------- @@ -190,6 +255,31 @@ package body Makeutl is return Union_Id (Key.File) mod Max_Mask_Num; end Hash; + ------------ + -- Inform -- + ------------ + + procedure Inform (N : File_Name_Type; Msg : String) is + begin + Inform (Name_Id (N), Msg); + end Inform; + + procedure Inform (N : Name_Id := No_Name; Msg : String) is + begin + Osint.Write_Program_Name; + + Write_Str (": "); + + if N /= No_Name then + Write_Str (""""); + Write_Name (N); + Write_Str (""" "); + end if; + + Write_Str (Msg); + Write_Eol; + end Inform; + ---------------------------- -- Is_External_Assignment -- ---------------------------- diff --git a/gcc/ada/makeutl.ads b/gcc/ada/makeutl.ads index d0d443b..29a3895 100644 --- a/gcc/ada/makeutl.ads +++ b/gcc/ada/makeutl.ads @@ -38,17 +38,39 @@ package Makeutl is S2 : String := ""; S3 : String := ""); Do_Fail : Fail_Proc := Osint.Fail'Access; - -- Comment required ??? - - function Unit_Index_Of (ALI_File : File_Name_Type) return Int; - -- Find the index of a unit in a source file. Return zero if the file - -- is not a multi-unit source file. + -- Failing procedure called from procedure Test_If_Relative_Path below. + -- May be redirected. + + Project_Tree : constant Project_Tree_Ref := new Project_Tree_Data; + -- The project tree + + Main_Config_Project : Project_Id; + -- The project id of the main configuration project + + procedure Add + (Option : String_Access; + To : in out String_List_Access; + Last : in out Natural); + procedure Add + (Option : String; + To : in out String_List_Access; + Last : in out Natural); + -- Add a string to a list of strings + + function Create_Name (Name : String) return File_Name_Type; + function Create_Name (Name : String) return Name_Id; + function Create_Name (Name : String) return Path_Name_Type; + -- Get the Name_Id of a name function Executable_Prefix_Path return String; -- Return the absolute path parent directory of the directory where the -- current executable resides, if its directory is named "bin", otherwise -- return an empty string. + procedure Inform (N : Name_Id := No_Name; Msg : String); + procedure Inform (N : File_Name_Type; Msg : String); + -- Prints out the program name followed by a colon, N and S + function Is_External_Assignment (Argv : String) return Boolean; -- Verify that an external assignment switch is syntactically correct -- @@ -73,6 +95,10 @@ package Makeutl is -- and to retrieve them when a project file is used, to verify that the -- files exist and that they belong to a project file. + function Unit_Index_Of (ALI_File : File_Name_Type) return Int; + -- Find the index of a unit in a source file. Return zero if the file + -- is not a multi-unit source file. + package Mains is -- Mains are stored in a table. An index is used to retrieve the mains diff --git a/gcc/ada/mlib-prj.adb b/gcc/ada/mlib-prj.adb index 83d1406..8aeb853 100644 --- a/gcc/ada/mlib-prj.adb +++ b/gcc/ada/mlib-prj.adb @@ -2,7 +2,7 @@ -- -- -- GNAT COMPILER COMPONENTS -- -- -- --- M L I B . P R J -- +-- M L I B . P R J -- -- -- -- B o d y -- -- -- @@ -46,7 +46,6 @@ with Ada.Characters.Handling; with GNAT.Directory_Operations; use GNAT.Directory_Operations; with GNAT.HTable; - with Interfaces.C_Streams; use Interfaces.C_Streams; with System; use System; with System.Case_Util; use System.Case_Util; @@ -74,9 +73,6 @@ package body MLib.Prj is G_Trasym_Ads : File_Name_Type := No_File; -- Name_Id for "g-trasym.ads" - No_Argument_List : aliased String_List := (1 .. 0 => null); - No_Argument : constant String_List_Access := No_Argument_List'Access; - Arguments : String_List_Access := No_Argument; -- Used to accumulate arguments for the invocation of gnatbind and of -- the compiler. Also used to collect the interface ALI when copying @@ -118,18 +114,6 @@ package body MLib.Prj is Hash => Hash, Equal => "="); - -- List of non-Ada object files - - Foreign_Objects : Argument_List_Access; - - package Foreigns is new Table.Table - (Table_Name => "Mlib.Prj.Foreigns", - Table_Component_Type => String_Access, - Table_Index_Type => Natural, - Table_Low_Bound => 1, - Table_Initial => 20, - Table_Increment => 100); - -- List of ALI files Ali_Files : Argument_List_Access; @@ -240,7 +224,7 @@ package body MLib.Prj is procedure Reset_Tables; -- Make sure that all the above tables are empty - -- (Objects, ALIs, Options, ...). + -- (Objects, Ali_Files, Options). function SALs_Use_Constructors return Boolean; -- Indicate if Stand-Alone Libraries are automatically initialized using @@ -326,10 +310,6 @@ package body MLib.Prj is -- Set to True for the first warning about a unit missing from the -- interface set. - Gtrasymobj_Needed : Boolean := False; - -- On OpenVMS, set to True if library needs to be linked with - -- g-trasym.obj. - Data : Project_Data := In_Tree.Projects.Table (For_Project); Libgnarl_Needed : Yes_No_Unknown := Data.Libgnarl_Needed; @@ -338,8 +318,12 @@ package body MLib.Prj is Libdecgnat_Needed : Boolean := False; -- On OpenVMS, set to True if library needs to be linked with libdecgnat + Gtrasymobj_Needed : Boolean := False; + -- On OpenVMS, set to True if library needs to be linked with + -- g-trasym.obj. + Object_Directory_Path : constant String := - Get_Name_String (Data.Display_Object_Dir); + Get_Name_String (Data.Display_Object_Dir); Standalone : constant Boolean := Data.Standalone_Library; @@ -362,6 +346,8 @@ package body MLib.Prj is In_Main_Object_Directory : Boolean := True; + There_Are_Foreign_Sources : Boolean; + Rpath : String_Access := null; -- Allocated only if Path Option is supported @@ -379,7 +365,8 @@ package body MLib.Prj is -- Store the ALI file name of a source of the library (the first found) procedure Add_ALI_For (Source : File_Name_Type); - -- Add the name of the ALI file corresponding to Source to the arguments + -- Add the name of the ALI file corresponding to Source to the + -- Arguments. procedure Add_Rpath (Path : String); -- Add a path name to Rpath @@ -553,7 +540,7 @@ package body MLib.Prj is ALI.ALIs.Table (Id).Last_Sdep loop if ALI.Sdep.Table (Index).Sfile = S_Osinte_Ads then - Libgnarl_Needed := Yes; + Libgnarl_Needed := Yes; if Main_Project then In_Tree.Projects.Table (For_Project).Libgnarl_Needed := @@ -806,10 +793,8 @@ package body MLib.Prj is Process_Project (For_Project); -- Add the -L and -l switches and, if the Rpath option is supported, - -- add the directory to the Rpath. - - -- As the library projects are in the wrong order, process from the - -- last to the first. + -- add the directory to the Rpath. As the library projects are in the + -- wrong order, process from the last to the first. for Index in reverse 1 .. Library_Projs.Last loop Current := Library_Projs.Table (Index); @@ -846,7 +831,7 @@ package body MLib.Prj is end if; -- If this is the first time Build_Library is called, get the Name_Id - -- values of "s-osinte.ads", "dec.ads", and "g-trasym.ads". + -- of "s-osinte.ads". if S_Osinte_Ads = No_File then Name_Len := 0; @@ -988,12 +973,13 @@ package body MLib.Prj is begin Src_Ind := Sinput.P.Load_Project_File (Get_Name_String - (Unit.File_Names (Body_Part).Path)); + (Unit.File_Names + (Body_Part).Path)); -- Add the ALI file only if it is not a subunit - if - not Sinput.P.Source_File_Is_Subunit (Src_Ind) + if not + Sinput.P.Source_File_Is_Subunit (Src_Ind) then Add_ALI_For (Unit.File_Names (Body_Part).Name); @@ -1075,8 +1061,6 @@ package body MLib.Prj is Display (Gnatbind); - -- Check the size of the arguments - Size := 0; for J in 1 .. Argument_Number loop Size := Size + Arguments (J)'Length + 1; @@ -1240,8 +1224,8 @@ package body MLib.Prj is -- Read it - A := Scan_ALI - (First_ALI, T, Ignore_ED => False, Err => False); + A := + Scan_ALI (First_ALI, T, Ignore_ED => False, Err => False); if A /= No_ALI_Id then for Index in @@ -1272,7 +1256,7 @@ package body MLib.Prj is -- generated file. Display (Gcc); - GNAT.OS_Lib.Spawn + Spawn (Gcc_Path.all, Arguments (1 .. Argument_Number), Success); if not Success then @@ -1290,6 +1274,7 @@ package body MLib.Prj is -- Build the library only if Link is True if Link then + -- If attribute Library_GCC was specified, get the driver name Library_GCC := @@ -1307,13 +1292,13 @@ package body MLib.Prj is if not Library_Options.Default then declare - Current : String_List_Id := Library_Options.Values; + Current : String_List_Id; Element : String_Element; begin + Current := Library_Options.Values; while Current /= Nil_String loop - Element := - In_Tree.String_Elements.Table (Current); + Element := In_Tree.String_Elements.Table (Current); Get_Name_String (Element.Value); if Name_Len /= 0 then @@ -1327,10 +1312,9 @@ package body MLib.Prj is end; end if; - Lib_Dirpath := + Lib_Dirpath := new String'(Get_Name_String (Data.Display_Library_Dir)); - Lib_Filename := - new String'(Get_Name_String (Data.Library_Name)); + Lib_Filename := new String'(Get_Name_String (Data.Library_Name)); case Data.Library_Kind is when Static => @@ -1350,7 +1334,7 @@ package body MLib.Prj is -- Get the library version, if any - if Data.Lib_Internal_Name /= No_File then + if Data.Lib_Internal_Name /= No_Name then Lib_Version := new String'(Get_Name_String (Data.Lib_Internal_Name)); end if; @@ -1358,12 +1342,13 @@ package body MLib.Prj is -- Add the objects found in the object directory and the object -- directories of the extended files, if any, except for generated -- object files (b~.. or B__..) from extended projects. - -- When there are one or more extended files, only add an object file -- if no object file with the same name have already been added. In_Main_Object_Directory := True; + There_Are_Foreign_Sources := Data.Other_Sources_Present; + loop declare Object_Dir_Path : constant String := @@ -1404,7 +1389,7 @@ package body MLib.Prj is if In_Main_Object_Directory or else Last < 5 or else C_Filename (1 .. B_Start'Length) /= - B_Start.all + B_Start.all then Name_Len := Last; Name_Buffer (1 .. Name_Len) := @@ -1412,39 +1397,112 @@ package body MLib.Prj is Id := Name_Find; if not Objects_Htable.Get (Id) then - - -- Record this object file - - Objects_Htable.Set (Id, True); - Objects.Increment_Last; - Objects.Table (Objects.Last) := - new String'(Object_Path); - declare ALI_File : constant String := + Ext_To + (Filename (1 .. Last), "ali"); + ALI_Path : constant String := Ext_To (Object_Path, "ali"); + Add_It : Boolean := + There_Are_Foreign_Sources + or else + (Last > 5 + and then + C_Filename + (1 .. B_Start'Length) = + B_Start.all); + Fname : File_Name_Type; + Proj : Project_Id; begin - if Is_Regular_File (ALI_File) then + if Is_Regular_File (ALI_Path) then + + -- If there is an ALI file, check if the + -- object file should be added to the + -- library. If there are foreign sources + -- we put all object files in 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 + (Body_Part).Name /= No_File + then + Proj := + In_Tree.Units.Table (Index). + File_Names + (Body_Part).Project; + Fname := + In_Tree.Units.Table (Index). + File_Names (Body_Part).Name; + + elsif + In_Tree.Units.Table + (Index).File_Names + (Specification).Name /= No_File + then + Proj := + In_Tree.Units.Table + (Index).File_Names + (Specification).Project; + Fname := + In_Tree.Units.Table + (Index).File_Names + (Specification).Name; + + else + Proj := No_Project; + end if; + + Add_It := Proj /= No_Project; + + -- If the source is in the project + -- or a project it extends, we may + -- put it in the library. + + if Add_It then + Add_It := Check_Project (Proj); + end if; + + -- But we don't, if the ALI file + -- does not correspond to the unit. + + if Add_It then + declare + F : constant String := + Ext_To + (Get_Name_String + (Fname), "ali"); + begin + Add_It := F = ALI_File; + end; + end if; + + exit when Add_It; + end loop; + end if; - -- Record the ALI file + if Add_It then + Objects_Htable.Set (Id, True); + Objects.Append + (new String'(Object_Path)); - ALIs.Increment_Last; - ALIs.Table (ALIs.Last) := - new String'(ALI_File); + -- Record the ALI file - -- Find out if for this ALI file, libgnarl - -- or libdecgnat or g-trasym.obj (on - -- OpenVMS) is necessary. + ALIs.Append (new String'(ALI_Path)); - Check_Libs (ALI_File, True); + -- Find out if for this ALI file, + -- libgnarl or libdecgnat or + -- g-trasym.obj (on OpenVMS) is + -- necessary. - else - -- Object file is a foreign object file + Check_Libs (ALI_Path, True); + end if; - Foreigns.Increment_Last; - Foreigns.Table (Foreigns.Last) := - new String'(Object_Path); + elsif There_Are_Foreign_Sources then + Objects.Append (new String'(Object_Path)); end if; end; end if; @@ -1518,9 +1576,6 @@ package body MLib.Prj is else Opts.Table (Opts.Last) := new String'(Shared_Lib ("gnarl")); end if; - - else - In_Tree.Projects.Table (For_Project).Libgnarl_Needed := No; end if; if Gtrasymobj_Needed then @@ -1568,18 +1623,14 @@ package body MLib.Prj is new Argument_List' (Argument_List (Objects.Table (1 .. Objects.Last))); - Foreign_Objects := - new Argument_List'(Argument_List - (Foreigns.Table (1 .. Foreigns.Last))); - Ali_Files := new Argument_List'(Argument_List (ALIs.Table (1 .. ALIs.Last))); Options := new Argument_List'(Argument_List (Opts.Table (1 .. Opts.Last))); - -- We fail if there are no object to put in the library (Ada or - -- foreign objects). + -- We fail if there are no object to put in the library + -- (Ada or foreign objects). if Object_Files'Length = 0 then Com.Fail ("no object files for library """ & @@ -1682,11 +1733,10 @@ package body MLib.Prj is Data := In_Tree.Projects.Table (For_Project); declare - Iface : String_List_Id; + Iface : String_List_Id := Data.Lib_Interface_ALIs; ALI : File_Name_Type; begin - Iface := Data.Lib_Interface_ALIs; while Iface /= Nil_String loop ALI := File_Name_Type @@ -1719,15 +1769,20 @@ package body MLib.Prj is declare Current_Dir : constant String := Get_Current_Dir; - DLL_Name : aliased constant String := - Lib_Filename.all & "." & DLL_Ext; + Dir : Dir_Type; + + Name : String (1 .. 200); + Last : Natural; + + Disregard : Boolean; + + DLL_Name : aliased constant String := + Lib_Filename.all & "." & DLL_Ext; + Archive_Name : aliased constant String := Lib_Filename.all & "." & Archive_Ext; - Dir : Dir_Type; - Name : String (1 .. 200); - Last : Natural; - Disregard : Boolean; - Delete : Boolean := False; + + Delete : Boolean := False; begin -- Clean the library directory: remove any file with the name of @@ -1810,7 +1865,8 @@ package body MLib.Prj is then Get_Name_String (Unit.File_Names (Specification).Name); - Name_Len := Name_Len - + Name_Len := + Name_Len - File_Extension (Name (1 .. Name_Len))'Length; @@ -1844,10 +1900,7 @@ package body MLib.Prj is when Dynamic | Relocatable => Build_Dynamic_Library (Ofiles => Object_Files.all, - Foreign => Foreign_Objects.all, - Afiles => Ali_Files.all, Options => Options.all, - Options_2 => No_Argument_List, Interfaces => Arguments (1 .. Argument_Number), Lib_Filename => Lib_Filename.all, Lib_Dir => Lib_Dirpath.all, @@ -1859,7 +1912,6 @@ package body MLib.Prj is when Static => MLib.Build_Library (Object_Files.all, - Ali_Files.all, Lib_Filename.all, Lib_Dirpath.all); @@ -1867,19 +1919,18 @@ package body MLib.Prj is null; end case; - -- We need to copy the ALI files from the object directory to - -- the library ALI directory, so that the linker find them there, - -- and does not need to look in the object directory where it - -- would also find the object files; and we don't want that: - -- we want the linker to use the library. + -- We need to copy the ALI files from the object directory to the + -- library ALI directory, so that the linker find them there, and + -- does not need to look in the object directory where it would also + -- find the object files; and we don't want that: we want the linker + -- to use the library. -- Copy the ALI files and make the copies read-only. For interfaces, -- mark the copies as interfaces. Copy_ALI_Files (Files => Ali_Files.all, - To => In_Tree.Projects.Table - (For_Project).Display_Library_ALI_Dir, + To => In_Tree.Projects.Table (For_Project).Library_ALI_Dir, Interfaces => Arguments (1 .. Argument_Number)); -- Copy interface sources if Library_Src_Dir specified @@ -1905,11 +1956,13 @@ package body MLib.Prj is end; declare - Dir : Dir_Type; - Delete : Boolean := False; - Unit : Unit_Data; - Name : String (1 .. 200); - Last : Natural; + Dir : Dir_Type; + Delete : Boolean := False; + Unit : Unit_Data; + + Name : String (1 .. 200); + Last : Natural; + Disregard : Boolean; begin @@ -1919,50 +1972,45 @@ package body MLib.Prj is Read (Dir, Name, Last); exit when Last = 0; - declare - Filename : constant String := Name (1 .. Last); + if Is_Regular_File (Name (1 .. Last)) then + Canonical_Case_File_Name (Name (1 .. Last)); + Delete := False; - begin - if Is_Regular_File (Filename) then - Canonical_Case_File_Name (Name (1 .. Last)); - Delete := False; - - -- 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); - - if Ultimate_Extension_Of - (Unit.File_Names (Body_Part).Project, In_Tree) = - For_Project - and then - Get_Name_String - (Unit.File_Names (Body_Part).Name) = - Name (1 .. Last) - then - Delete := True; - exit; - end if; + -- Compare with source file names of the project - if Ultimate_Extension_Of - (Unit.File_Names - (Specification).Project, In_Tree) = For_Project - and then - Get_Name_String - (Unit.File_Names (Specification).Name) = - Name (1 .. Last) - then - Delete := True; - exit; - end if; - end loop; - end if; + for Index in 1 .. Unit_Table.Last (In_Tree.Units) loop + Unit := In_Tree.Units.Table (Index); - if Delete then - Set_Writable (Filename); - Delete_File (Filename, Disregard); - end if; - end; + if Ultimate_Extension_Of + (Unit.File_Names (Body_Part).Project, In_Tree) = + For_Project + and then + Get_Name_String + (Unit.File_Names (Body_Part).Name) = + Name (1 .. Last) + then + Delete := True; + exit; + end if; + + if Ultimate_Extension_Of + (Unit.File_Names (Specification).Project, In_Tree) = + For_Project + and then + Get_Name_String + (Unit.File_Names (Specification).Name) = + Name (1 .. Last) + then + Delete := True; + exit; + end if; + end loop; + end if; + + if Delete then + Set_Writable (Name (1 .. Last)); + Delete_File (Name (1 .. Last), Disregard); + end if; end loop; Close (Dir); @@ -2011,8 +2059,7 @@ package body MLib.Prj is ------------------- procedure Check_Library - (For_Project : Project_Id; - In_Tree : Project_Tree_Ref) + (For_Project : Project_Id; In_Tree : Project_Tree_Ref) is Data : constant Project_Data := In_Tree.Projects.Table (For_Project); @@ -2026,7 +2073,7 @@ package body MLib.Prj is if Data.Library then declare Lib_Name : constant File_Name_Type := - Library_File_Name_For (For_Project, In_Tree); + Library_File_Name_For (For_Project, In_Tree); begin Change_Dir (Get_Name_String (Data.Library_Dir)); Lib_TS := File_Stamp (Lib_Name); @@ -2171,9 +2218,10 @@ package body MLib.Prj is (Extending : Project_Id; Extended : Project_Id) return Boolean is - Ext : Project_Id := Extending; + Ext : Project_Id; begin + Ext := Extending; while Ext /= No_Project loop if Ext = Extended then return True; @@ -2451,7 +2499,6 @@ package body MLib.Prj is begin Objects.Init; Objects_Htable.Reset; - Foreigns.Init; ALIs.Init; Opts.Init; Processed_Projects.Reset; diff --git a/gcc/ada/mlib-tgt-aix.adb b/gcc/ada/mlib-tgt-aix.adb index 9545e8a..55fa4d1 100644 --- a/gcc/ada/mlib-tgt-aix.adb +++ b/gcc/ada/mlib-tgt-aix.adb @@ -42,10 +42,7 @@ package body MLib.Tgt.Specific is procedure Build_Dynamic_Library (Ofiles : Argument_List; - Foreign : Argument_List; - Afiles : Argument_List; Options : Argument_List; - Options_2 : Argument_List; Interfaces : Argument_List; Lib_Filename : String; Lib_Dir : String; @@ -56,6 +53,8 @@ package body MLib.Tgt.Specific is function DLL_Ext return String; + function Library_Major_Minor_Id_Supported return Boolean; + function Support_For_Libraries return Library_Support; -- Local variables @@ -90,10 +89,7 @@ package body MLib.Tgt.Specific is procedure Build_Dynamic_Library (Ofiles : Argument_List; - Foreign : Argument_List; - Afiles : Argument_List; Options : Argument_List; - Options_2 : Argument_List; Interfaces : Argument_List; Lib_Filename : String; Lib_Dir : String; @@ -102,8 +98,6 @@ package body MLib.Tgt.Specific is Lib_Version : String := ""; Auto_Init : Boolean := False) is - pragma Unreferenced (Foreign); - pragma Unreferenced (Afiles); pragma Unreferenced (Interfaces); pragma Unreferenced (Symbol_Data); pragma Unreferenced (Lib_Version); @@ -178,7 +172,7 @@ package body MLib.Tgt.Specific is Objects => Ofiles, Options => Options & Bexpall_Option, Driver_Name => Driver_Name, - Options_2 => Options_2 & Thread_Opts.all); + Options_2 => Thread_Opts.all); end Build_Dynamic_Library; ------------- @@ -190,6 +184,15 @@ package body MLib.Tgt.Specific is return "a"; end DLL_Ext; + -------------------------------------- + -- Library_Major_Minor_Id_Supported -- + -------------------------------------- + + function Library_Major_Minor_Id_Supported return Boolean is + begin + return False; + end Library_Major_Minor_Id_Supported; + --------------------------- -- Support_For_Libraries -- --------------------------- @@ -202,6 +205,8 @@ package body MLib.Tgt.Specific is begin Build_Dynamic_Library_Ptr := Build_Dynamic_Library'Access; DLL_Ext_Ptr := DLL_Ext'Access; + Library_Major_Minor_Id_Supported_Ptr := + Library_Major_Minor_Id_Supported'Access; Support_For_Libraries_Ptr := Support_For_Libraries'Access; end MLib.Tgt.Specific; diff --git a/gcc/ada/mlib-tgt-darwin.adb b/gcc/ada/mlib-tgt-darwin.adb index 3ae2fcf..aa71be0 100644 --- a/gcc/ada/mlib-tgt-darwin.adb +++ b/gcc/ada/mlib-tgt-darwin.adb @@ -33,8 +33,6 @@ with MLib.Utl; with Opt; use Opt; with Output; use Output; -with System; - package body MLib.Tgt.Specific is -- Non default subprograms @@ -43,10 +41,7 @@ package body MLib.Tgt.Specific is procedure Build_Dynamic_Library (Ofiles : Argument_List; - Foreign : Argument_List; - Afiles : Argument_List; Options : Argument_List; - Options_2 : Argument_List; Interfaces : Argument_List; Lib_Filename : String; Lib_Dir : String; @@ -70,8 +65,8 @@ package body MLib.Tgt.Specific is Shared_Libgcc : aliased String := "-shared-libgcc"; Shared_Options : constant Argument_List := - (1 => Flat_Namespace'Access, - 2 => Shared_Libgcc'Access); + (1 => Flat_Namespace'Access, + 2 => Shared_Libgcc'Access); ----------------------------- -- Archive_Indexer_Options -- @@ -88,10 +83,7 @@ package body MLib.Tgt.Specific is procedure Build_Dynamic_Library (Ofiles : Argument_List; - Foreign : Argument_List; - Afiles : Argument_List; Options : Argument_List; - Options_2 : Argument_List; Interfaces : Argument_List; Lib_Filename : String; Lib_Dir : String; @@ -100,15 +92,15 @@ package body MLib.Tgt.Specific is Lib_Version : String := ""; Auto_Init : Boolean := False) is - pragma Unreferenced (Foreign); - pragma Unreferenced (Afiles); pragma Unreferenced (Interfaces); pragma Unreferenced (Symbol_Data); pragma Unreferenced (Auto_Init); Lib_File : constant String := - Lib_Dir & Directory_Separator & "lib" & - Fil.Append_To (Lib_Filename, DLL_Ext); + "lib" & Fil.Append_To (Lib_Filename, DLL_Ext); + + Lib_Path : constant String := + Lib_Dir & Directory_Separator & Lib_File; Symbolic_Link_Needed : Boolean := False; @@ -126,55 +118,38 @@ package body MLib.Tgt.Specific is Objects => Ofiles, Options => Options & Shared_Options, Driver_Name => Driver_Name, - Options_2 => Options_2); + Options_2 => No_Argument_List); else - - if Is_Absolute_Path (Lib_Version) then - Utl.Gcc - (Output_File => Lib_Version, - Objects => Ofiles, - Options => Options & Shared_Options, - Driver_Name => Driver_Name, - Options_2 => Options_2); - Symbolic_Link_Needed := Lib_Version /= Lib_File; - - else - Utl.Gcc - (Output_File => Lib_Dir & Directory_Separator & Lib_Version, - Objects => Ofiles, - Options => Options & Shared_Options, - Driver_Name => Driver_Name, - Options_2 => Options_2); - Symbolic_Link_Needed := - Lib_Dir & Directory_Separator & Lib_Version /= Lib_File; - end if; - - if Symbolic_Link_Needed then - declare - Success : Boolean; - Oldpath : String (1 .. Lib_Version'Length + 1); - Newpath : String (1 .. Lib_File'Length + 1); - - Result : Integer; - pragma Unreferenced (Result); - - function Symlink - (Oldpath : System.Address; - Newpath : System.Address) return Integer; - pragma Import (C, Symlink, "__gnat_symlink"); - - begin - Oldpath (1 .. Lib_Version'Length) := Lib_Version; - Oldpath (Oldpath'Last) := ASCII.NUL; - Newpath (1 .. Lib_File'Length) := Lib_File; - Newpath (Newpath'Last) := ASCII.NUL; - - Delete_File (Lib_File, Success); - - Result := Symlink (Oldpath'Address, Newpath'Address); - end; - end if; + declare + Maj_Version : constant String := + Major_Id_Name (Lib_File, Lib_Version); + begin + if Is_Absolute_Path (Lib_Version) then + Utl.Gcc + (Output_File => Lib_Version, + Objects => Ofiles, + Options => Options & Shared_Options, + Driver_Name => Driver_Name, + Options_2 => No_Argument_List); + Symbolic_Link_Needed := Lib_Version /= Lib_File; + + else + Utl.Gcc + (Output_File => Lib_Dir & Directory_Separator & Lib_Version, + Objects => Ofiles, + Options => Options & Shared_Options, + Driver_Name => Driver_Name, + Options_2 => No_Argument_List); + Symbolic_Link_Needed := + Lib_Dir & Directory_Separator & Lib_Version /= Lib_File; + end if; + + if Symbolic_Link_Needed then + Create_Sym_Links + (Lib_Path, Lib_Version, Lib_Dir, Maj_Version); + end if; + end; end if; end Build_Dynamic_Library; diff --git a/gcc/ada/mlib-tgt-hpux.adb b/gcc/ada/mlib-tgt-hpux.adb index 63ff69e..8aac837 100644 --- a/gcc/ada/mlib-tgt-hpux.adb +++ b/gcc/ada/mlib-tgt-hpux.adb @@ -31,7 +31,6 @@ with MLib.Fil; with MLib.Utl; with Opt; with Output; use Output; -with System; package body MLib.Tgt.Specific is @@ -39,10 +38,7 @@ package body MLib.Tgt.Specific is procedure Build_Dynamic_Library (Ofiles : Argument_List; - Foreign : Argument_List; - Afiles : Argument_List; Options : Argument_List; - Options_2 : Argument_List; Interfaces : Argument_List; Lib_Filename : String; Lib_Dir : String; @@ -61,10 +57,7 @@ package body MLib.Tgt.Specific is procedure Build_Dynamic_Library (Ofiles : Argument_List; - Foreign : Argument_List; - Afiles : Argument_List; Options : Argument_List; - Options_2 : Argument_List; Interfaces : Argument_List; Lib_Filename : String; Lib_Dir : String; @@ -73,15 +66,15 @@ package body MLib.Tgt.Specific is Lib_Version : String := ""; Auto_Init : Boolean := False) is - pragma Unreferenced (Foreign); - pragma Unreferenced (Afiles); pragma Unreferenced (Interfaces); pragma Unreferenced (Symbol_Data); pragma Unreferenced (Auto_Init); Lib_File : constant String := - Lib_Dir & Directory_Separator & "lib" & - MLib.Fil.Append_To (Lib_Filename, DLL_Ext); + "lib" & Fil.Append_To (Lib_Filename, DLL_Ext); + + Lib_Path : constant String := + Lib_Dir & Directory_Separator & Lib_File; Version_Arg : String_Access; Symbolic_Link_Needed : Boolean := False; @@ -96,65 +89,54 @@ package body MLib.Tgt.Specific is begin if Opt.Verbose_Mode then Write_Str ("building relocatable shared library "); - Write_Line (Lib_File); + Write_Line (Lib_Path); end if; if Lib_Version = "" then MLib.Utl.Gcc - (Output_File => Lib_File, + (Output_File => Lib_Path, Objects => Ofiles, Options => Common_Options, - Options_2 => Options_2, + Options_2 => No_Argument_List, Driver_Name => Driver_Name); else - Version_Arg := new String'("-Wl,+h," & Lib_Version); - - if Is_Absolute_Path (Lib_Version) then - MLib.Utl.Gcc - (Output_File => Lib_Version, - Objects => Ofiles, - Options => Common_Options & Version_Arg, - Options_2 => Options_2, - Driver_Name => Driver_Name); - Symbolic_Link_Needed := Lib_Version /= Lib_File; - - else - MLib.Utl.Gcc - (Output_File => Lib_Dir & Directory_Separator & Lib_Version, - Objects => Ofiles, - Options => Common_Options & Version_Arg, - Options_2 => Options_2, - Driver_Name => Driver_Name); - Symbolic_Link_Needed := - Lib_Dir & Directory_Separator & Lib_Version /= Lib_File; - end if; - - if Symbolic_Link_Needed then - declare - Success : Boolean; - Oldpath : String (1 .. Lib_Version'Length + 1); - Newpath : String (1 .. Lib_File'Length + 1); - - Result : Integer; - pragma Unreferenced (Result); - - function Symlink - (Oldpath : System.Address; - Newpath : System.Address) return Integer; - pragma Import (C, Symlink, "__gnat_symlink"); - - begin - Oldpath (1 .. Lib_Version'Length) := Lib_Version; - Oldpath (Oldpath'Last) := ASCII.NUL; - Newpath (1 .. Lib_File'Length) := Lib_File; - Newpath (Newpath'Last) := ASCII.NUL; - - Delete_File (Lib_File, Success); - - Result := Symlink (Oldpath'Address, Newpath'Address); - end; - end if; + declare + Maj_Version : constant String := + Major_Id_Name (Lib_File, Lib_Version); + begin + if Maj_Version'Length /= 0 then + Version_Arg := new String'("-Wl,+h," & Maj_Version); + + else + Version_Arg := new String'("-Wl,+h," & Lib_Version); + end if; + + if Is_Absolute_Path (Lib_Version) then + MLib.Utl.Gcc + (Output_File => Lib_Version, + Objects => Ofiles, + Options => Common_Options & Version_Arg, + Options_2 => No_Argument_List, + Driver_Name => Driver_Name); + Symbolic_Link_Needed := Lib_Version /= Lib_Path; + + else + MLib.Utl.Gcc + (Output_File => Lib_Dir & Directory_Separator & Lib_Version, + Objects => Ofiles, + Options => Common_Options & Version_Arg, + Options_2 => No_Argument_List, + Driver_Name => Driver_Name); + Symbolic_Link_Needed := + Lib_Dir & Directory_Separator & Lib_Version /= Lib_Path; + end if; + + if Symbolic_Link_Needed then + Create_Sym_Links + (Lib_Path, Lib_Version, Lib_Dir, Maj_Version); + end if; + end; end if; end Build_Dynamic_Library; diff --git a/gcc/ada/mlib-tgt-irix.adb b/gcc/ada/mlib-tgt-irix.adb index 3b45aea..fdab352 100644 --- a/gcc/ada/mlib-tgt-irix.adb +++ b/gcc/ada/mlib-tgt-irix.adb @@ -31,7 +31,6 @@ with MLib.Fil; with MLib.Utl; with Opt; with Output; use Output; -with System; package body MLib.Tgt.Specific is @@ -39,10 +38,7 @@ package body MLib.Tgt.Specific is procedure Build_Dynamic_Library (Ofiles : Argument_List; - Foreign : Argument_List; - Afiles : Argument_List; Options : Argument_List; - Options_2 : Argument_List; Interfaces : Argument_List; Lib_Filename : String; Lib_Dir : String; @@ -59,10 +55,7 @@ package body MLib.Tgt.Specific is procedure Build_Dynamic_Library (Ofiles : Argument_List; - Foreign : Argument_List; - Afiles : Argument_List; Options : Argument_List; - Options_2 : Argument_List; Interfaces : Argument_List; Lib_Filename : String; Lib_Dir : String; @@ -71,15 +64,15 @@ package body MLib.Tgt.Specific is Lib_Version : String := ""; Auto_Init : Boolean := False) is - pragma Unreferenced (Foreign); - pragma Unreferenced (Afiles); pragma Unreferenced (Interfaces); pragma Unreferenced (Symbol_Data); pragma Unreferenced (Auto_Init); Lib_File : constant String := - Lib_Dir & Directory_Separator & "lib" & - MLib.Fil.Append_To (Lib_Filename, DLL_Ext); + "lib" & MLib.Fil.Append_To (Lib_Filename, DLL_Ext); + + Lib_Path : constant String := + Lib_Dir & Directory_Separator & Lib_File; Version_Arg : String_Access; Symbolic_Link_Needed : Boolean := False; @@ -89,7 +82,7 @@ package body MLib.Tgt.Specific is -- After moving -lxxx to Options_2, N_Options up to index Options_Last -- will contain the Options to pass to MLib.Utl.Gcc. - Real_Options_2 : Argument_List (1 .. Options'Length + Options_2'Length); + Real_Options_2 : Argument_List (1 .. Options'Length); Real_Options_2_Last : Natural := 0; -- Real_Options_2 up to index Real_Options_2_Last will contain the -- Options_2 to pass to MLib.Utl.Gcc. @@ -97,7 +90,7 @@ package body MLib.Tgt.Specific is begin if Opt.Verbose_Mode then Write_Str ("building relocatable shared library "); - Write_Line (Lib_File); + Write_Line (Lib_Path); end if; -- Move all -lxxx to Options_2 @@ -125,72 +118,53 @@ package body MLib.Tgt.Specific is end loop; end; - -- Add to Real_Options_2 the argument Options_2 - - Real_Options_2 - (Real_Options_2_Last + 1 .. Real_Options_2_Last + Options_2'Length) := - Options_2; - Real_Options_2_Last := Real_Options_2_Last + Options_2'Length; - if Lib_Version = "" then MLib.Utl.Gcc - (Output_File => Lib_File, + (Output_File => Lib_Path, Objects => Ofiles, Options => N_Options (N_Options'First .. Options_Last), Driver_Name => Driver_Name, Options_2 => Real_Options_2 (1 .. Real_Options_2_Last)); else - Version_Arg := new String'("-Wl,-soname," & Lib_Version); - - if Is_Absolute_Path (Lib_Version) then - MLib.Utl.Gcc - (Output_File => Lib_Version, - Objects => Ofiles, - Options => N_Options (N_Options'First .. Options_Last) & - Version_Arg, - Driver_Name => Driver_Name, - Options_2 => Real_Options_2 (1 .. Real_Options_2_Last)); - Symbolic_Link_Needed := Lib_Version /= Lib_File; - - else - MLib.Utl.Gcc - (Output_File => Lib_Dir & Directory_Separator & Lib_Version, - Objects => Ofiles, - Options => N_Options (N_Options'First .. Options_Last) & - Version_Arg, - Driver_Name => Driver_Name, - Options_2 => Real_Options_2 (1 .. Real_Options_2_Last)); - Symbolic_Link_Needed := - Lib_Dir & Directory_Separator & Lib_Version /= Lib_File; - end if; - - if Symbolic_Link_Needed then - declare - Success : Boolean; - Oldpath : String (1 .. Lib_Version'Length + 1); - Newpath : String (1 .. Lib_File'Length + 1); - - Result : Integer; - pragma Unreferenced (Result); - - function Symlink - (Oldpath : System.Address; - Newpath : System.Address) - return Integer; - pragma Import (C, Symlink, "__gnat_symlink"); - - begin - Oldpath (1 .. Lib_Version'Length) := Lib_Version; - Oldpath (Oldpath'Last) := ASCII.NUL; - Newpath (1 .. Lib_File'Length) := Lib_File; - Newpath (Newpath'Last) := ASCII.NUL; - - Delete_File (Lib_File, Success); - - Result := Symlink (Oldpath'Address, Newpath'Address); - end; - end if; + declare + Maj_Version : constant String := + Major_Id_Name (Lib_File, Lib_Version); + begin + if Maj_Version'Length /= 0 then + Version_Arg := new String'("-Wl,-soname," & Maj_Version); + + else + Version_Arg := new String'("-Wl,-soname," & Lib_Version); + end if; + + if Is_Absolute_Path (Lib_Version) then + MLib.Utl.Gcc + (Output_File => Lib_Version, + Objects => Ofiles, + Options => N_Options (N_Options'First .. Options_Last) & + Version_Arg, + Driver_Name => Driver_Name, + Options_2 => Real_Options_2 (1 .. Real_Options_2_Last)); + Symbolic_Link_Needed := Lib_Version /= Lib_Path; + + else + MLib.Utl.Gcc + (Output_File => Lib_Dir & Directory_Separator & Lib_Version, + Objects => Ofiles, + Options => N_Options (N_Options'First .. Options_Last) & + Version_Arg, + Driver_Name => Driver_Name, + Options_2 => Real_Options_2 (1 .. Real_Options_2_Last)); + Symbolic_Link_Needed := + Lib_Dir & Directory_Separator & Lib_Version /= Lib_Path; + end if; + + if Symbolic_Link_Needed then + Create_Sym_Links + (Lib_Path, Lib_Version, Lib_Dir, Maj_Version); + end if; + end; end if; end Build_Dynamic_Library; diff --git a/gcc/ada/mlib-tgt-linux.adb b/gcc/ada/mlib-tgt-linux.adb index 848a11c..001e1a4 100644 --- a/gcc/ada/mlib-tgt-linux.adb +++ b/gcc/ada/mlib-tgt-linux.adb @@ -31,7 +31,6 @@ with MLib.Fil; with MLib.Utl; with Opt; with Output; use Output; -with System; package body MLib.Tgt.Specific is @@ -41,10 +40,7 @@ package body MLib.Tgt.Specific is procedure Build_Dynamic_Library (Ofiles : Argument_List; - Foreign : Argument_List; - Afiles : Argument_List; Options : Argument_List; - Options_2 : Argument_List; Interfaces : Argument_List; Lib_Filename : String; Lib_Dir : String; @@ -61,10 +57,7 @@ package body MLib.Tgt.Specific is procedure Build_Dynamic_Library (Ofiles : Argument_List; - Foreign : Argument_List; - Afiles : Argument_List; Options : Argument_List; - Options_2 : Argument_List; Interfaces : Argument_List; Lib_Filename : String; Lib_Dir : String; @@ -73,8 +66,6 @@ package body MLib.Tgt.Specific is Lib_Version : String := ""; Auto_Init : Boolean := False) is - pragma Unreferenced (Foreign); - pragma Unreferenced (Afiles); pragma Unreferenced (Interfaces); pragma Unreferenced (Symbol_Data); pragma Unreferenced (Auto_Init); @@ -101,56 +92,15 @@ package body MLib.Tgt.Specific is Objects => Ofiles, Options => Options, Driver_Name => Driver_Name, - Options_2 => Options_2); + Options_2 => No_Argument_List); else declare - Maj_Version : constant String := Lib_Version; - Last_Maj : Positive := Maj_Version'Last; - Last : Positive; - Ok_Maj : Boolean := False; + Maj_Version : constant String := + Major_Id_Name (Lib_File, Lib_Version); begin - while Last_Maj > Maj_Version'First loop - if Maj_Version (Last_Maj) in '0' .. '9' then - Last_Maj := Last_Maj - 1; - - else - Ok_Maj := Last_Maj /= Maj_Version'Last and then - Maj_Version (Last_Maj) = '.'; - - if Ok_Maj then - Last_Maj := Last_Maj - 1; - end if; - - exit; - end if; - end loop; - - if Ok_Maj then - Last := Last_Maj; - - while Last > Maj_Version'First loop - if Maj_Version (Last) in '0' .. '9' then - Last := Last - 1; - - else - Ok_Maj := Last /= Last_Maj and then - Maj_Version (Last) = '.'; - - if Ok_Maj then - Last := Last - 1; - - Ok_Maj := Maj_Version (1 .. Last) = Lib_File; - end if; - - exit; - end if; - end loop; - end if; - - if Ok_Maj then - Version_Arg := new String'("-Wl,-soname," & - Maj_Version (1 .. Last_Maj)); + if Maj_Version'Length /= 0 then + Version_Arg := new String'("-Wl,-soname," & Maj_Version); else Version_Arg := new String'("-Wl,-soname," & Lib_Version); @@ -162,7 +112,7 @@ package body MLib.Tgt.Specific is Objects => Ofiles, Options => Options & Version_Arg, Driver_Name => Driver_Name, - Options_2 => Options_2); + Options_2 => No_Argument_List); Symbolic_Link_Needed := Lib_Version /= Lib_Path; else @@ -171,65 +121,14 @@ package body MLib.Tgt.Specific is Objects => Ofiles, Options => Options & Version_Arg, Driver_Name => Driver_Name, - Options_2 => Options_2); + Options_2 => No_Argument_List); Symbolic_Link_Needed := Lib_Dir & Directory_Separator & Lib_Version /= Lib_Path; end if; if Symbolic_Link_Needed then - declare - Success : Boolean; - Oldpath : String (1 .. Lib_Version'Length + 1); - Newpath : String (1 .. Lib_Path'Length + 1); - - Result : Integer; - pragma Unreferenced (Result); - - function Symlink - (Oldpath : System.Address; - Newpath : System.Address) return Integer; - pragma Import (C, Symlink, "__gnat_symlink"); - - begin - Oldpath (1 .. Lib_Version'Length) := Lib_Version; - Oldpath (Oldpath'Last) := ASCII.NUL; - Newpath (1 .. Lib_Path'Length) := Lib_Path; - Newpath (Newpath'Last) := ASCII.NUL; - - Delete_File (Lib_Path, Success); - - Result := Symlink (Oldpath'Address, Newpath'Address); - end; - - if Ok_Maj then - declare - Success : Boolean; - Oldpath : String (1 .. Lib_Version'Length + 1); - Maj_Path : constant String := - Lib_Dir & Directory_Separator & - Maj_Version (1 .. Last_Maj); - Newpath : String (1 .. Maj_Path'Length + 1); - - Result : Integer; - pragma Unreferenced (Result); - - function Symlink - (Oldpath : System.Address; - Newpath : System.Address) return Integer; - pragma Import (C, Symlink, "__gnat_symlink"); - - begin - Oldpath (1 .. Lib_Version'Length) := Lib_Version; - Oldpath (Oldpath'Last) := ASCII.NUL; - Newpath (1 .. Maj_Path'Length) := Maj_Path; - Newpath (Newpath'Last) := ASCII.NUL; - - Delete_File (Maj_Path, Success); - - Result := Symlink (Oldpath'Address, Newpath'Address); - end; - end if; - + Create_Sym_Links + (Lib_Path, Lib_Version, Lib_Dir, Maj_Version); end if; end; end if; diff --git a/gcc/ada/mlib-tgt-lynxos.adb b/gcc/ada/mlib-tgt-lynxos.adb index 0a667d5..999a320 100644 --- a/gcc/ada/mlib-tgt-lynxos.adb +++ b/gcc/ada/mlib-tgt-lynxos.adb @@ -33,10 +33,7 @@ package body MLib.Tgt.Specific is procedure Build_Dynamic_Library (Ofiles : Argument_List; - Foreign : Argument_List; - Afiles : Argument_List; Options : Argument_List; - Options_2 : Argument_List; Interfaces : Argument_List; Lib_Filename : String; Lib_Dir : String; @@ -51,6 +48,8 @@ package body MLib.Tgt.Specific is function PIC_Option return String; + function Library_Major_Minor_Id_Supported return Boolean; + function Standalone_Library_Auto_Init_Is_Supported return Boolean; function Support_For_Libraries return Library_Support; @@ -61,10 +60,7 @@ package body MLib.Tgt.Specific is procedure Build_Dynamic_Library (Ofiles : Argument_List; - Foreign : Argument_List; - Afiles : Argument_List; Options : Argument_List; - Options_2 : Argument_List; Interfaces : Argument_List; Lib_Filename : String; Lib_Dir : String; @@ -74,10 +70,7 @@ package body MLib.Tgt.Specific is Auto_Init : Boolean := False) is pragma Unreferenced (Ofiles); - pragma Unreferenced (Foreign); - pragma Unreferenced (Afiles); pragma Unreferenced (Options); - pragma Unreferenced (Options_2); pragma Unreferenced (Interfaces); pragma Unreferenced (Lib_Filename); pragma Unreferenced (Lib_Dir); @@ -108,6 +101,15 @@ package body MLib.Tgt.Specific is return ""; end Dynamic_Option; + -------------------------------------- + -- Library_Major_Minor_Id_Supported -- + -------------------------------------- + + function Library_Major_Minor_Id_Supported return Boolean is + begin + return False; + end Library_Major_Minor_Id_Supported; + ---------------- -- PIC_Option -- ---------------- @@ -139,6 +141,8 @@ begin Build_Dynamic_Library_Ptr := Build_Dynamic_Library'Access; DLL_Ext_Ptr := DLL_Ext'Access; Dynamic_Option_Ptr := Dynamic_Option'Access; + Library_Major_Minor_Id_Supported_Ptr := + Library_Major_Minor_Id_Supported'Access; PIC_Option_Ptr := PIC_Option'Access; Standalone_Library_Auto_Init_Is_Supported_Ptr := Standalone_Library_Auto_Init_Is_Supported'Access; diff --git a/gcc/ada/mlib-tgt-mingw.adb b/gcc/ada/mlib-tgt-mingw.adb index cba87e5..56c607a 100644 --- a/gcc/ada/mlib-tgt-mingw.adb +++ b/gcc/ada/mlib-tgt-mingw.adb @@ -43,10 +43,7 @@ package body MLib.Tgt.Specific is procedure Build_Dynamic_Library (Ofiles : Argument_List; - Foreign : Argument_List; - Afiles : Argument_List; Options : Argument_List; - Options_2 : Argument_List; Interfaces : Argument_List; Lib_Filename : String; Lib_Dir : String; @@ -61,6 +58,8 @@ package body MLib.Tgt.Specific is function Is_Archive_Ext (Ext : String) return Boolean; + function Library_Major_Minor_Id_Supported return Boolean; + function PIC_Option return String; No_Argument_List : constant String_List := (1 .. 0 => null); @@ -72,10 +71,7 @@ package body MLib.Tgt.Specific is procedure Build_Dynamic_Library (Ofiles : Argument_List; - Foreign : Argument_List; - Afiles : Argument_List; Options : Argument_List; - Options_2 : Argument_List; Interfaces : Argument_List; Lib_Filename : String; Lib_Dir : String; @@ -84,8 +80,6 @@ package body MLib.Tgt.Specific is Lib_Version : String := ""; Auto_Init : Boolean := False) is - pragma Unreferenced (Foreign); - pragma Unreferenced (Afiles); pragma Unreferenced (Symbol_Data); pragma Unreferenced (Interfaces); pragma Unreferenced (Lib_Version); @@ -93,7 +87,7 @@ package body MLib.Tgt.Specific is Lib_File : constant String := Lib_Dir & Directory_Separator & - Files.Append_To (Lib_Filename, DLL_Ext); + DLL_Prefix & Files.Append_To (Lib_Filename, DLL_Ext); -- Start of processing for Build_Dynamic_Library @@ -107,7 +101,7 @@ package body MLib.Tgt.Specific is (Output_File => Lib_File, Objects => Ofiles, Options => No_Argument_List, - Options_2 => Options & Options_2, + Options_2 => Options, Driver_Name => Driver_Name); end Build_Dynamic_Library; @@ -126,7 +120,7 @@ package body MLib.Tgt.Specific is function DLL_Prefix return String is begin - return ""; + return "lib"; end DLL_Prefix; -------------------- @@ -138,6 +132,15 @@ package body MLib.Tgt.Specific is return Ext = ".a" or else Ext = ".dll"; end Is_Archive_Ext; + -------------------------------------- + -- Library_Major_Minor_Id_Supported -- + -------------------------------------- + + function Library_Major_Minor_Id_Supported return Boolean is + begin + return False; + end Library_Major_Minor_Id_Supported; + ---------------- -- PIC_Option -- ---------------- @@ -149,8 +152,10 @@ package body MLib.Tgt.Specific is begin Build_Dynamic_Library_Ptr := Build_Dynamic_Library'Access; - DLL_Ext_Ptr := DLL_Ext'Access; - DLL_Prefix_Ptr := DLL_Prefix'Access; - Is_Archive_Ext_Ptr := Is_Archive_Ext'Access; - PIC_Option_Ptr := PIC_Option'Access; + DLL_Ext_Ptr := DLL_Ext'Access; + DLL_Prefix_Ptr := DLL_Prefix'Access; + Is_Archive_Ext_Ptr := Is_Archive_Ext'Access; + PIC_Option_Ptr := PIC_Option'Access; + Library_Major_Minor_Id_Supported_Ptr := + Library_Major_Minor_Id_Supported'Access; end MLib.Tgt.Specific; diff --git a/gcc/ada/mlib-tgt-solaris.adb b/gcc/ada/mlib-tgt-solaris.adb index 1692ccd..d0489b7 100644 --- a/gcc/ada/mlib-tgt-solaris.adb +++ b/gcc/ada/mlib-tgt-solaris.adb @@ -31,7 +31,6 @@ with MLib.Fil; with MLib.Utl; with Opt; with Output; use Output; -with System; package body MLib.Tgt.Specific is @@ -39,10 +38,7 @@ package body MLib.Tgt.Specific is procedure Build_Dynamic_Library (Ofiles : Argument_List; - Foreign : Argument_List; - Afiles : Argument_List; Options : Argument_List; - Options_2 : Argument_List; Interfaces : Argument_List; Lib_Filename : String; Lib_Dir : String; @@ -59,10 +55,7 @@ package body MLib.Tgt.Specific is procedure Build_Dynamic_Library (Ofiles : Argument_List; - Foreign : Argument_List; - Afiles : Argument_List; Options : Argument_List; - Options_2 : Argument_List; Interfaces : Argument_List; Lib_Filename : String; Lib_Dir : String; @@ -71,15 +64,15 @@ package body MLib.Tgt.Specific is Lib_Version : String := ""; Auto_Init : Boolean := False) is - pragma Unreferenced (Foreign); - pragma Unreferenced (Afiles); pragma Unreferenced (Interfaces); pragma Unreferenced (Symbol_Data); pragma Unreferenced (Auto_Init); Lib_File : constant String := - Lib_Dir & Directory_Separator & "lib" & - Fil.Append_To (Lib_Filename, DLL_Ext); + "lib" & Fil.Append_To (Lib_Filename, DLL_Ext); + + Lib_Path : constant String := + Lib_Dir & Directory_Separator & Lib_File; Version_Arg : String_Access; Symbolic_Link_Needed : Boolean := False; @@ -87,66 +80,54 @@ package body MLib.Tgt.Specific is begin if Opt.Verbose_Mode then Write_Str ("building relocatable shared library "); - Write_Line (Lib_File); + Write_Line (Lib_Path); end if; if Lib_Version = "" then Utl.Gcc - (Output_File => Lib_File, + (Output_File => Lib_Path, Objects => Ofiles, Options => Options, - Options_2 => Options_2, + Options_2 => No_Argument_List, Driver_Name => Driver_Name); else - Version_Arg := new String'("-Wl,-h," & Lib_Version); - - if Is_Absolute_Path (Lib_Version) then - Utl.Gcc - (Output_File => Lib_Version, - Objects => Ofiles, - Options => Options & Version_Arg, - Options_2 => Options_2, - Driver_Name => Driver_Name); - Symbolic_Link_Needed := Lib_Version /= Lib_File; - - else - Utl.Gcc - (Output_File => Lib_Dir & Directory_Separator & Lib_Version, - Objects => Ofiles, - Options => Options & Version_Arg, - Options_2 => Options_2, - Driver_Name => Driver_Name); - Symbolic_Link_Needed := - Lib_Dir & Directory_Separator & Lib_Version /= Lib_File; - end if; - - if Symbolic_Link_Needed then - declare - Success : Boolean; - Oldpath : String (1 .. Lib_Version'Length + 1); - Newpath : String (1 .. Lib_File'Length + 1); - - Result : Integer; - pragma Unreferenced (Result); - - function Symlink - (Oldpath : System.Address; - Newpath : System.Address) - return Integer; - pragma Import (C, Symlink, "__gnat_symlink"); - - begin - Oldpath (1 .. Lib_Version'Length) := Lib_Version; - Oldpath (Oldpath'Last) := ASCII.NUL; - Newpath (1 .. Lib_File'Length) := Lib_File; - Newpath (Newpath'Last) := ASCII.NUL; - - Delete_File (Lib_File, Success); - - Result := Symlink (Oldpath'Address, Newpath'Address); - end; - end if; + declare + Maj_Version : constant String := + Major_Id_Name (Lib_File, Lib_Version); + begin + if Maj_Version'Length /= 0 then + Version_Arg := new String'("-Wl,-h," & Maj_Version); + + else + Version_Arg := new String'("-Wl,-h," & Lib_Version); + end if; + + if Is_Absolute_Path (Lib_Version) then + Utl.Gcc + (Output_File => Lib_Version, + Objects => Ofiles, + Options => Options & Version_Arg, + Options_2 => No_Argument_List, + Driver_Name => Driver_Name); + Symbolic_Link_Needed := Lib_Version /= Lib_Path; + + else + Utl.Gcc + (Output_File => Lib_Dir & Directory_Separator & Lib_Version, + Objects => Ofiles, + Options => Options & Version_Arg, + Options_2 => No_Argument_List, + Driver_Name => Driver_Name); + Symbolic_Link_Needed := + Lib_Dir & Directory_Separator & Lib_Version /= Lib_Path; + end if; + + if Symbolic_Link_Needed then + Create_Sym_Links + (Lib_Path, Lib_Version, Lib_Dir, Maj_Version); + end if; + end; end if; end Build_Dynamic_Library; diff --git a/gcc/ada/mlib-tgt-tru64.adb b/gcc/ada/mlib-tgt-tru64.adb index 50290d2..4ee9b72 100644 --- a/gcc/ada/mlib-tgt-tru64.adb +++ b/gcc/ada/mlib-tgt-tru64.adb @@ -31,7 +31,6 @@ with MLib.Fil; with MLib.Utl; with Opt; with Output; use Output; -with System; package body MLib.Tgt.Specific is @@ -41,10 +40,7 @@ package body MLib.Tgt.Specific is procedure Build_Dynamic_Library (Ofiles : Argument_List; - Foreign : Argument_List; - Afiles : Argument_List; Options : Argument_List; - Options_2 : Argument_List; Interfaces : Argument_List; Lib_Filename : String; Lib_Dir : String; @@ -67,10 +63,7 @@ package body MLib.Tgt.Specific is procedure Build_Dynamic_Library (Ofiles : Argument_List; - Foreign : Argument_List; - Afiles : Argument_List; Options : Argument_List; - Options_2 : Argument_List; Interfaces : Argument_List; Lib_Filename : String; Lib_Dir : String; @@ -79,16 +72,16 @@ package body MLib.Tgt.Specific is Lib_Version : String := ""; Auto_Init : Boolean := False) is - pragma Unreferenced (Foreign); - pragma Unreferenced (Afiles); pragma Unreferenced (Interfaces); pragma Unreferenced (Symbol_Data); pragma Unreferenced (Auto_Init); -- Initialization is done through the contructor mechanism Lib_File : constant String := - Lib_Dir & Directory_Separator & "lib" & - Fil.Append_To (Lib_Filename, DLL_Ext); + "lib" & Fil.Append_To (Lib_Filename, DLL_Ext); + + Lib_Path : constant String := + Lib_Dir & Directory_Separator & Lib_File; Version_Arg : String_Access; Symbolic_Link_Needed : Boolean := False; @@ -96,70 +89,58 @@ package body MLib.Tgt.Specific is begin if Opt.Verbose_Mode then Write_Str ("building relocatable shared library "); - Write_Line (Lib_File); + Write_Line (Lib_Path); end if; -- If specified, add automatic elaboration/finalization if Lib_Version = "" then Utl.Gcc - (Output_File => Lib_File, + (Output_File => Lib_Path, Objects => Ofiles, Options => Options & Expect_Unresolved'Access, - Options_2 => Options_2, + Options_2 => No_Argument_List, Driver_Name => Driver_Name); else - Version_Arg := new String'("-Wl,-soname," & Lib_Version); - - if Is_Absolute_Path (Lib_Version) then - Utl.Gcc - (Output_File => Lib_Version, - Objects => Ofiles, - Options => - Options & Version_Arg & Expect_Unresolved'Access, - Options_2 => Options_2, - Driver_Name => Driver_Name); - Symbolic_Link_Needed := Lib_Version /= Lib_File; - - else - Utl.Gcc - (Output_File => Lib_Dir & Directory_Separator & Lib_Version, - Objects => Ofiles, - Options => - Options & Version_Arg & Expect_Unresolved'Access, - Options_2 => Options_2, - Driver_Name => Driver_Name); - Symbolic_Link_Needed := - Lib_Dir & Directory_Separator & Lib_Version /= Lib_File; - end if; - - if Symbolic_Link_Needed then - declare - Success : Boolean; - Oldpath : String (1 .. Lib_Version'Length + 1); - Newpath : String (1 .. Lib_File'Length + 1); - - Result : Integer; - pragma Unreferenced (Result); - - function Symlink - (Oldpath : System.Address; - Newpath : System.Address) - return Integer; - pragma Import (C, Symlink, "__gnat_symlink"); - - begin - Oldpath (1 .. Lib_Version'Length) := Lib_Version; - Oldpath (Oldpath'Last) := ASCII.NUL; - Newpath (1 .. Lib_File'Length) := Lib_File; - Newpath (Newpath'Last) := ASCII.NUL; - - Delete_File (Lib_File, Success); - - Result := Symlink (Oldpath'Address, Newpath'Address); - end; - end if; + declare + Maj_Version : constant String := + Major_Id_Name (Lib_File, Lib_Version); + begin + if Maj_Version'Length /= 0 then + Version_Arg := new String'("-Wl,-soname," & Maj_Version); + + else + Version_Arg := new String'("-Wl,-soname," & Lib_Version); + end if; + + if Is_Absolute_Path (Lib_Version) then + Utl.Gcc + (Output_File => Lib_Version, + Objects => Ofiles, + Options => + Options & Version_Arg & Expect_Unresolved'Access, + Options_2 => No_Argument_List, + Driver_Name => Driver_Name); + Symbolic_Link_Needed := Lib_Version /= Lib_Path; + + else + Utl.Gcc + (Output_File => Lib_Dir & Directory_Separator & Lib_Version, + Objects => Ofiles, + Options => + Options & Version_Arg & Expect_Unresolved'Access, + Options_2 => No_Argument_List, + Driver_Name => Driver_Name); + Symbolic_Link_Needed := + Lib_Dir & Directory_Separator & Lib_Version /= Lib_Path; + end if; + + if Symbolic_Link_Needed then + Create_Sym_Links + (Lib_Path, Lib_Version, Lib_Dir, Maj_Version); + end if; + end; end if; end Build_Dynamic_Library; diff --git a/gcc/ada/mlib-tgt-vms-alpha.adb b/gcc/ada/mlib-tgt-vms-alpha.adb index b091799..b771c9e 100644 --- a/gcc/ada/mlib-tgt-vms-alpha.adb +++ b/gcc/ada/mlib-tgt-vms-alpha.adb @@ -36,8 +36,8 @@ with MLib.Tgt.VMS; pragma Warnings (Off, MLib.Tgt.VMS); -- MLib.Tgt.VMS is with'ed only for elaboration purposes -with Opt; use Opt; -with Output; use Output; +with Opt; use Opt; +with Output; use Output; with GNAT.Directory_Operations; use GNAT.Directory_Operations; @@ -51,10 +51,7 @@ package body MLib.Tgt.Specific is procedure Build_Dynamic_Library (Ofiles : Argument_List; - Foreign : Argument_List; - Afiles : Argument_List; Options : Argument_List; - Options_2 : Argument_List; Interfaces : Argument_List; Lib_Filename : String; Lib_Dir : String; @@ -95,10 +92,7 @@ package body MLib.Tgt.Specific is procedure Build_Dynamic_Library (Ofiles : Argument_List; - Foreign : Argument_List; - Afiles : Argument_List; Options : Argument_List; - Options_2 : Argument_List; Interfaces : Argument_List; Lib_Filename : String; Lib_Dir : String; @@ -107,8 +101,6 @@ package body MLib.Tgt.Specific is Lib_Version : String := ""; Auto_Init : Boolean := False) is - pragma Unreferenced (Foreign); - pragma Unreferenced (Afiles); Lib_File : constant String := Lib_Dir & Directory_Separator & "lib" & @@ -171,7 +163,7 @@ package body MLib.Tgt.Specific is function Option_File_Name return String is begin - if Symbol_Data.Symbol_File = No_Name then + if Symbol_Data.Symbol_File = No_Path then return "symvec.opt"; else Get_Name_String (Symbol_Data.Symbol_File); @@ -386,7 +378,7 @@ package body MLib.Tgt.Specific is -- Reference Symbol File - if Symbol_Data.Reference /= No_Name then + if Symbol_Data.Reference /= No_Path then Last_Argument := Last_Argument + 1; Arguments (Last_Argument) := new String'("-r"); Last_Argument := Last_Argument + 1; @@ -477,7 +469,7 @@ package body MLib.Tgt.Specific is Options => VMS_Options, Options_2 => Shared_Libgcc_Switch & Opts (Opts'First .. Last_Opt) & - Opts2 (Opts2'First .. Last_Opt2) & Options_2, + Opts2 (Opts2'First .. Last_Opt2), Driver_Name => Driver_Name); -- The auto-init object file need to be deleted, so that it will not diff --git a/gcc/ada/mlib-tgt-vms-ia64.adb b/gcc/ada/mlib-tgt-vms-ia64.adb index 9aad7b8..404b905 100644 --- a/gcc/ada/mlib-tgt-vms-ia64.adb +++ b/gcc/ada/mlib-tgt-vms-ia64.adb @@ -36,8 +36,8 @@ with MLib.Tgt.VMS; pragma Warnings (Off, MLib.Tgt.VMS); -- MLib.Tgt.VMS is with'ed only for elaboration purposes -with Opt; use Opt; -with Output; use Output; +with Opt; use Opt; +with Output; use Output; with GNAT.Directory_Operations; use GNAT.Directory_Operations; @@ -47,14 +47,11 @@ with System.CRTL; use System.CRTL; package body MLib.Tgt.Specific is - -- Non default subprogram. See comment in mlib-tgt.ads + -- Non default subprogram. See comment in mlib-tgt.ads. procedure Build_Dynamic_Library (Ofiles : Argument_List; - Foreign : Argument_List; - Afiles : Argument_List; Options : Argument_List; - Options_2 : Argument_List; Interfaces : Argument_List; Lib_Filename : String; Lib_Dir : String; @@ -95,10 +92,7 @@ package body MLib.Tgt.Specific is procedure Build_Dynamic_Library (Ofiles : Argument_List; - Foreign : Argument_List; - Afiles : Argument_List; Options : Argument_List; - Options_2 : Argument_List; Interfaces : Argument_List; Lib_Filename : String; Lib_Dir : String; @@ -107,8 +101,6 @@ package body MLib.Tgt.Specific is Lib_Version : String := ""; Auto_Init : Boolean := False) is - pragma Unreferenced (Foreign); - pragma Unreferenced (Afiles); Lib_File : constant String := Lib_Dir & Directory_Separator & "lib" & @@ -171,7 +163,7 @@ package body MLib.Tgt.Specific is function Option_File_Name return String is begin - if Symbol_Data.Symbol_File = No_Name then + if Symbol_Data.Symbol_File = No_Path then return "symvec.opt"; else Get_Name_String (Symbol_Data.Symbol_File); @@ -420,7 +412,7 @@ package body MLib.Tgt.Specific is -- Reference Symbol File - if Symbol_Data.Reference /= No_Name then + if Symbol_Data.Reference /= No_Path then Last_Argument := Last_Argument + 1; Arguments (Last_Argument) := new String'("-r"); Last_Argument := Last_Argument + 1; @@ -510,7 +502,7 @@ package body MLib.Tgt.Specific is Options => VMS_Options, Options_2 => Shared_Libgcc_Switch & Opts (Opts'First .. Last_Opt) & - Opts2 (Opts2'First .. Last_Opt2) & Options_2, + Opts2 (Opts2'First .. Last_Opt2), Driver_Name => Driver_Name); -- The auto-init object file need to be deleted, so that it will not diff --git a/gcc/ada/mlib-tgt-vms.adb b/gcc/ada/mlib-tgt-vms.adb index b01ea9d..4fb787c 100644 --- a/gcc/ada/mlib-tgt-vms.adb +++ b/gcc/ada/mlib-tgt-vms.adb @@ -44,6 +44,8 @@ package body MLib.Tgt.VMS is function Object_Ext return String; + function Library_Major_Minor_Id_Supported return Boolean; + function PIC_Option return String; ----------------- @@ -110,6 +112,15 @@ package body MLib.Tgt.VMS is end if; end Libgnat; + -------------------------------------- + -- Library_Major_Minor_Id_Supported -- + -------------------------------------- + + function Library_Major_Minor_Id_Supported return Boolean is + begin + return False; + end Library_Major_Minor_Id_Supported; + ---------------- -- Object_Ext -- ---------------- @@ -139,4 +150,7 @@ begin Libgnat_Ptr := Libgnat'Access; Object_Ext_Ptr := Object_Ext'Access; PIC_Option_Ptr := PIC_Option'Access; + Library_Major_Minor_Id_Supported_Ptr := + Library_Major_Minor_Id_Supported'Access; + end MLib.Tgt.VMS; diff --git a/gcc/ada/mlib-tgt-vxworks.adb b/gcc/ada/mlib-tgt-vxworks.adb index d658d47..bad799e 100644 --- a/gcc/ada/mlib-tgt-vxworks.adb +++ b/gcc/ada/mlib-tgt-vxworks.adb @@ -28,7 +28,6 @@ -- This is the VxWorks version of the body with Sdefault; -with Types; use Types; package body MLib.Tgt.Specific is @@ -48,10 +47,7 @@ package body MLib.Tgt.Specific is procedure Build_Dynamic_Library (Ofiles : Argument_List; - Foreign : Argument_List; - Afiles : Argument_List; Options : Argument_List; - Options_2 : Argument_List; Interfaces : Argument_List; Lib_Filename : String; Lib_Dir : String; @@ -64,6 +60,8 @@ package body MLib.Tgt.Specific is function Dynamic_Option return String; + function Library_Major_Minor_Id_Supported return Boolean; + function PIC_Option return String; function Standalone_Library_Auto_Init_Is_Supported return Boolean; @@ -94,10 +92,7 @@ package body MLib.Tgt.Specific is procedure Build_Dynamic_Library (Ofiles : Argument_List; - Foreign : Argument_List; - Afiles : Argument_List; Options : Argument_List; - Options_2 : Argument_List; Interfaces : Argument_List; Lib_Filename : String; Lib_Dir : String; @@ -107,10 +102,7 @@ package body MLib.Tgt.Specific is Auto_Init : Boolean := False) is pragma Unreferenced (Ofiles); - pragma Unreferenced (Foreign); - pragma Unreferenced (Afiles); pragma Unreferenced (Options); - pragma Unreferenced (Options_2); pragma Unreferenced (Interfaces); pragma Unreferenced (Lib_Filename); pragma Unreferenced (Lib_Dir); @@ -146,7 +138,7 @@ package body MLib.Tgt.Specific is ----------------------------- function Get_Target_Suffix return String is - Target_Name : constant String_Ptr := Sdefault.Target_Name; + Target_Name : constant String := Sdefault.Target_Name.all; Index : Positive := Target_Name'First; begin @@ -175,6 +167,15 @@ package body MLib.Tgt.Specific is end if; end Get_Target_Suffix; + -------------------------------------- + -- Library_Major_Minor_Id_Supported -- + -------------------------------------- + + function Library_Major_Minor_Id_Supported return Boolean is + begin + return False; + end Library_Major_Minor_Id_Supported; + ---------------- -- PIC_Option -- ---------------- @@ -209,6 +210,8 @@ begin DLL_Ext_Ptr := DLL_Ext'Access; Dynamic_Option_Ptr := Dynamic_Option'Access; PIC_Option_Ptr := PIC_Option'Access; + Library_Major_Minor_Id_Supported_Ptr := + Library_Major_Minor_Id_Supported'Access; Standalone_Library_Auto_Init_Is_Supported_Ptr := Standalone_Library_Auto_Init_Is_Supported'Access; Support_For_Libraries_Ptr := Support_For_Libraries'Access; diff --git a/gcc/ada/mlib-tgt.adb b/gcc/ada/mlib-tgt.adb index 8a242bc..f2cc87e 100644 --- a/gcc/ada/mlib-tgt.adb +++ b/gcc/ada/mlib-tgt.adb @@ -151,25 +151,19 @@ package body MLib.Tgt is procedure Build_Dynamic_Library (Ofiles : Argument_List; - Foreign : Argument_List; - Afiles : Argument_List; Options : Argument_List; - Options_2 : Argument_List; Interfaces : Argument_List; Lib_Filename : String; Lib_Dir : String; Symbol_Data : Symbol_Record; - Driver_Name : Name_Id := No_Name; - Lib_Version : String := ""; - Auto_Init : Boolean := False) + Driver_Name : Name_Id := No_Name; + Lib_Version : String := ""; + Auto_Init : Boolean := False) is begin Build_Dynamic_Library_Ptr (Ofiles, - Foreign, - Afiles, Options, - Options_2, Interfaces, Lib_Filename, Lib_Dir, @@ -404,7 +398,9 @@ package body MLib.Tgt is (In_Tree.Projects.Table (Project).Library_Name); begin - if In_Tree.Projects.Table (Project).Library_Kind = Static then + if In_Tree.Projects.Table (Project).Library_Kind = + Static + then Name_Len := 3; Name_Buffer (1 .. Name_Len) := "lib"; Add_Str_To_Name_Buffer (Fil.Append_To (Lib_Name, Archive_Ext)); @@ -419,6 +415,24 @@ package body MLib.Tgt is end if; end Library_File_Name_For_Default; + -------------------------------------- + -- Library_Major_Minor_Id_Supported -- + -------------------------------------- + + function Library_Major_Minor_Id_Supported return Boolean is + begin + return Library_Major_Minor_Id_Supported_Ptr.all; + end Library_Major_Minor_Id_Supported; + + ---------------------------------------------- + -- Library_Major_Minor_Id_Supported_Default -- + ---------------------------------------------- + + function Library_Major_Minor_Id_Supported_Default return Boolean is + begin + return True; + end Library_Major_Minor_Id_Supported_Default; + ---------------- -- Object_Ext -- ---------------- @@ -490,5 +504,4 @@ package body MLib.Tgt is begin return Full; end Support_For_Libraries_Default; - end MLib.Tgt; diff --git a/gcc/ada/mlib-tgt.ads b/gcc/ada/mlib-tgt.ads index 670db45..24198e1 100644 --- a/gcc/ada/mlib-tgt.ads +++ b/gcc/ada/mlib-tgt.ads @@ -36,14 +36,6 @@ with Prj; use Prj; package MLib.Tgt is - type Library_Support is (None, Static_Only, Full); - -- Support for Library Project File. - -- - None: Library Project Files are not supported at all - -- - Static_Only: Library Project Files are only supported for static - -- libraries. - -- - Full: Library Project Files are supported for static and dynamic - -- (shared) libraries. - function Support_For_Libraries return Library_Support; -- Indicates how building libraries by gnatmake is supported by the GNAT -- implementation for the platform. @@ -113,29 +105,20 @@ package MLib.Tgt is procedure Build_Dynamic_Library (Ofiles : Argument_List; - Foreign : Argument_List; - Afiles : Argument_List; Options : Argument_List; - Options_2 : Argument_List; Interfaces : Argument_List; Lib_Filename : String; Lib_Dir : String; Symbol_Data : Symbol_Record; - Driver_Name : Name_Id := No_Name; - Lib_Version : String := ""; - Auto_Init : Boolean := False); + Driver_Name : Name_Id := No_Name; + Lib_Version : String := ""; + Auto_Init : Boolean := False); -- Build a dynamic/relocatable library -- -- Ofiles is the list of all object files in the library -- - -- Foreign is the list of non Ada object files (also included in Ofiles) - -- - -- Afiles is the list of ALI files for the Ada object files - -- - -- Options and Options_2 are lists of options to be passed to the tool - -- (gcc or other) that effectively builds the dynamic library. Options - -- are passed before the object files, Options_2 are passed after the - -- object files. + -- Options is a list of options to be passed to the tool + -- (gcc or other) that effectively builds the dynamic library. -- -- Interfaces is the list of ALI files for the interfaces of a SAL. -- It is empty if the library is not a SAL. @@ -155,9 +138,9 @@ package MLib.Tgt is -- Symbol_Data is used for some patforms, including VMS, to generate -- the symbols to be exported by the library. -- - -- Note: Depending on the OS, some of the parameters may not be taken - -- into account. For example, on Linux, Foreign, Afiles Lib_Address and - -- Relocatable are ignored. + -- Note: Depending on the OS, some of the parameters may not be taken into + -- account. For example, on Linux, Interfaces, Symbol_Data and Auto_Init + -- are ignored. function Library_Exists_For (Project : Project_Id; In_Tree : Project_Tree_Ref) return Boolean; @@ -170,7 +153,16 @@ package MLib.Tgt is -- Returns the file name of the library file of a library project. -- This function can only be called for library projects. + function Library_Major_Minor_Id_Supported return Boolean; + -- Indicates if major and minor ids are supported for libraries. + -- If they are supported, then a Library_Version such as libtoto.so.1.2 + -- will have a major id of 1 and a minor id of 2. Then litoto.so, + -- libtoto.so.1 and libtoto.so.1.2 will be created, all three designating + -- the same file. + private + No_Argument_List : constant Argument_List := (1 .. 0 => null); + -- Access to subprogram types for indirection type String_Function is access function return String; @@ -179,10 +171,7 @@ private return String_List_Access; type Build_Dynamic_Library_Function is access procedure (Ofiles : Argument_List; - Foreign : Argument_List; - Afiles : Argument_List; Options : Argument_List; - Options_2 : Argument_List; Interfaces : Argument_List; Lib_Filename : String; Lib_Dir : String; @@ -190,16 +179,12 @@ private Driver_Name : Name_Id := No_Name; Lib_Version : String := ""; Auto_Init : Boolean := False); - type Library_Exists_For_Function is access function (Project : Project_Id; In_Tree : Project_Tree_Ref) return Boolean; - type Library_File_Name_For_Function is access function (Project : Project_Id; In_Tree : Project_Tree_Ref) return File_Name_Type; - type Boolean_Function is access function return Boolean; - type Library_Support_Function is access function return Library_Support; function Archive_Builder_Default return String; @@ -210,10 +195,8 @@ private Archive_Builder_Options_Default'Access; function Archive_Builder_Append_Options_Default return String_List_Access; - - Archive_Builder_Append_Options_Ptr : - String_List_Access_Function := - Archive_Builder_Append_Options_Default'Access; + Archive_Builder_Append_Options_Ptr : String_List_Access_Function := + Archive_Builder_Append_Options_Default'Access; function Archive_Ext_Default return String; Archive_Ext_Ptr : String_Function := Archive_Ext_Default'Access; @@ -276,4 +259,8 @@ private function Support_For_Libraries_Default return Library_Support; Support_For_Libraries_Ptr : Library_Support_Function := Support_For_Libraries_Default'Access; + + function Library_Major_Minor_Id_Supported_Default return Boolean; + Library_Major_Minor_Id_Supported_Ptr : Boolean_Function := + Library_Major_Minor_Id_Supported_Default'Access; end MLib.Tgt; diff --git a/gcc/ada/mlib.adb b/gcc/ada/mlib.adb index d2aeaab..3d261b7 100644 --- a/gcc/ada/mlib.adb +++ b/gcc/ada/mlib.adb @@ -26,6 +26,7 @@ with Ada.Characters.Handling; use Ada.Characters.Handling; with Interfaces.C.Strings; +with System; with Hostparm; with Opt; @@ -45,12 +46,9 @@ package body MLib is procedure Build_Library (Ofiles : Argument_List; - Afiles : Argument_List; Output_File : String; Output_Dir : String) is - pragma Warnings (Off, Afiles); - begin if Opt.Verbose_Mode and not Opt.Quiet_Output then Write_Line ("building a library..."); @@ -123,6 +121,8 @@ package body MLib is end if; end Verbose_Copy; + -- Start of processing for Copy_ALI_Files + begin if Interfaces'Length = 0 then @@ -152,6 +152,7 @@ package body MLib is declare File_Name : String := Base_Name (Files (Index).all); + begin Canonical_Case_File_Name (File_Name); @@ -214,9 +215,9 @@ package body MLib is end loop; -- We are done with the input file, so we close it + -- ignoring any bad status. Close (FD, Status); - -- We simply ignore any bad status P_Line_Found := False; @@ -274,11 +275,10 @@ package body MLib is end if; end; - else - -- This is not an interface ALI + -- This is not an interface ALI + else Success := True; - end if; end; @@ -289,6 +289,76 @@ package body MLib is end if; end Copy_ALI_Files; + ---------------------- + -- Create_Sym_Links -- + ---------------------- + + procedure Create_Sym_Links + (Lib_Path : String; + Lib_Version : String; + Lib_Dir : String; + Maj_Version : String) + is + function Symlink + (Oldpath : System.Address; + Newpath : System.Address) return Integer; + pragma Import (C, Symlink, "__gnat_symlink"); + + Success : Boolean; + Version_Path : String_Access; + + Result : Integer; + pragma Unreferenced (Result); + + begin + if Is_Absolute_Path (Lib_Version) then + Version_Path := new String (1 .. Lib_Version'Length + 1); + Version_Path (1 .. Lib_Version'Length) := Lib_Version; + + else + Version_Path := + new String (1 .. Lib_Dir'Length + 1 + Lib_Version'Length + 1); + Version_Path (1 .. Version_Path'Last - 1) := + Lib_Dir & Directory_Separator & Lib_Version; + end if; + + Version_Path (Version_Path'Last) := ASCII.NUL; + + if Maj_Version'Length = 0 then + declare + Newpath : String (1 .. Lib_Path'Length + 1); + begin + Newpath (1 .. Lib_Path'Length) := Lib_Path; + Newpath (Newpath'Last) := ASCII.NUL; + Delete_File (Lib_Path, Success); + Result := Symlink (Version_Path (1)'Address, Newpath'Address); + end; + + else + declare + Newpath1 : String (1 .. Lib_Path'Length + 1); + Maj_Path : constant String := + Lib_Dir & Directory_Separator & Maj_Version; + Newpath2 : String (1 .. Maj_Path'Length + 1); + + begin + Newpath1 (1 .. Lib_Path'Length) := Lib_Path; + Newpath1 (Newpath1'Last) := ASCII.NUL; + + Newpath2 (1 .. Maj_Path'Length) := Maj_Path; + Newpath2 (Newpath2'Last) := ASCII.NUL; + + Delete_File (Maj_Path, Success); + + Result := Symlink (Version_Path (1)'Address, Newpath2'Address); + + Delete_File (Lib_Path, Success); + + Result := Symlink (Newpath2'Address, Newpath1'Address); + end; + end if; + end Create_Sym_Links; + -------------------------------- -- Linker_Library_Path_Option -- -------------------------------- @@ -311,6 +381,66 @@ package body MLib is end if; end Linker_Library_Path_Option; + ------------------- + -- Major_Id_Name -- + ------------------- + + function Major_Id_Name + (Lib_Filename : String; + Lib_Version : String) + return String + is + Maj_Version : constant String := Lib_Version; + Last_Maj : Positive; + Last : Positive; + Ok_Maj : Boolean := False; + + begin + Last_Maj := Maj_Version'Last; + while Last_Maj > Maj_Version'First loop + if Maj_Version (Last_Maj) in '0' .. '9' then + Last_Maj := Last_Maj - 1; + + else + Ok_Maj := Last_Maj /= Maj_Version'Last and then + Maj_Version (Last_Maj) = '.'; + + if Ok_Maj then + Last_Maj := Last_Maj - 1; + end if; + + exit; + end if; + end loop; + + if Ok_Maj then + Last := Last_Maj; + while Last > Maj_Version'First loop + if Maj_Version (Last) in '0' .. '9' then + Last := Last - 1; + + else + Ok_Maj := Last /= Last_Maj and then + Maj_Version (Last) = '.'; + + if Ok_Maj then + Last := Last - 1; + Ok_Maj := + Maj_Version (Maj_Version'First .. Last) = Lib_Filename; + end if; + + exit; + end if; + end loop; + end if; + + if Ok_Maj then + return Maj_Version (Maj_Version'First .. Last_Maj); + else + return ""; + end if; + end Major_Id_Name; + -- Package elaboration begin diff --git a/gcc/ada/mlib.ads b/gcc/ada/mlib.ads index 2c020fd..dec1167 100644 --- a/gcc/ada/mlib.ads +++ b/gcc/ada/mlib.ads @@ -34,6 +34,9 @@ with GNAT.OS_Lib; use GNAT.OS_Lib; package MLib is + No_Argument_List : aliased String_List := (1 .. 0 => null); + No_Argument : constant String_List_Access := No_Argument_List'Access; + Max_Characters_In_Library_Name : constant := 20; -- Maximum number of characters in a library name. -- Used by Check_Library_Name below. @@ -54,7 +57,6 @@ package MLib is procedure Build_Library (Ofiles : Argument_List; - Afiles : Argument_List; Output_File : String; Output_Dir : String); -- Build a static library from a set of object files @@ -66,11 +68,24 @@ package MLib is -- Copy all ALI files Files to directory To. -- Mark Interfaces ALI files as interfaces, if any. + procedure Create_Sym_Links + (Lib_Path : String; + Lib_Version : String; + Lib_Dir : String; + Maj_Version : String); + function Linker_Library_Path_Option return String_Access; -- Linker option to specify to the linker the library directory path. -- If non null, the library directory path is to be appended. -- Should be deallocated by the caller, when no longer needed. + function Major_Id_Name + (Lib_Filename : String; + Lib_Version : String) return String; + -- Returns the major id library file name, if it exists. + -- For example, if Lib_Filename is "libtoto.so" and Lib_Version is + -- "libtoto.so.1.2", then "libtoto.so.1" is returned. + private Preserve : Attribute := Time_Stamps; diff --git a/gcc/ada/sinput-p.adb b/gcc/ada/sinput-p.adb index 4718952..91acd0e 100644 --- a/gcc/ada/sinput-p.adb +++ b/gcc/ada/sinput-p.adb @@ -6,7 +6,7 @@ -- -- -- B o d y -- -- -- --- Copyright (C) 1992-2006, Free Software Foundation, Inc. -- +-- Copyright (C) 1992-2007, Free Software Foundation, Inc. -- -- -- -- GNAT is free software; you can redistribute it and/or modify it under -- -- terms of the GNU General Public License as published by the Free Soft- -- @@ -32,7 +32,8 @@ package body Sinput.P is First : Boolean := True; -- Flag used when Load_Project_File is called the first time, -- to set Main_Source_File. - -- The flag is reset to False at the first call to Load_Project_File + -- The flag is reset to False at the first call to Load_Project_File. + -- Calling Reset_First sets it back to True. ----------------------- -- Load_Project_File -- @@ -52,6 +53,15 @@ package body Sinput.P is return X; end Load_Project_File; + ----------------- + -- Reset_First -- + ----------------- + + procedure Reset_First is + begin + First := True; + end Reset_First; + -------------------------------- -- Restore_Project_Scan_State -- -------------------------------- diff --git a/gcc/ada/sinput-p.ads b/gcc/ada/sinput-p.ads index fdcb3cf..83cba80 100644 --- a/gcc/ada/sinput-p.ads +++ b/gcc/ada/sinput-p.ads @@ -6,7 +6,7 @@ -- -- -- S p e c -- -- -- --- Copyright (C) 1992-2002, Free Software Foundation, Inc. -- +-- Copyright (C) 1992-2007, Free Software Foundation, Inc. -- -- -- -- GNAT is free software; you can redistribute it and/or modify it under -- -- terms of the GNU General Public License as published by the Free Soft- -- @@ -36,6 +36,11 @@ package Sinput.P is -- Load into memory the source of a project source file. -- Initialize the Scans state. + procedure Reset_First; + -- Indicate that the next project loaded should be considered as the first + -- one, so that Sinput.Main_Source_File is set for this project file. This + -- is to get the correct number of lines when error finalization is called. + function Source_File_Is_Subunit (X : Source_File_Index) return Boolean; -- This function determines if a source file represents a subunit. It -- works by scanning for the first compilation unit token, and returning |