diff options
Diffstat (limited to 'gcc-4.4.3/gcc/ada/mlib.adb')
| -rw-r--r-- | gcc-4.4.3/gcc/ada/mlib.adb | 451 |
1 files changed, 0 insertions, 451 deletions
diff --git a/gcc-4.4.3/gcc/ada/mlib.adb b/gcc-4.4.3/gcc/ada/mlib.adb deleted file mode 100644 index f037bdb14..000000000 --- a/gcc-4.4.3/gcc/ada/mlib.adb +++ /dev/null @@ -1,451 +0,0 @@ ------------------------------------------------------------------------------- --- -- --- GNAT COMPILER COMPONENTS -- --- -- --- M L I B -- --- -- --- B o d y -- --- -- --- Copyright (C) 1999-2008, AdaCore -- --- -- --- 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- -- --- ware Foundation; either version 3, or (at your option) any later ver- -- --- sion. GNAT is distributed in the hope that it will be useful, but WITH- -- --- OUT ANY WARRANTY; without even the implied warranty of MERCHANTABILITY -- --- or FITNESS FOR A PARTICULAR PURPOSE. See the GNU General Public License -- --- for more details. You should have received a copy of the GNU General -- --- Public License distributed with GNAT; see file COPYING3. If not, go to -- --- http://www.gnu.org/licenses for a complete copy of the license. -- --- -- --- GNAT was originally developed by the GNAT team at New York University. -- --- Extensive contributions were provided by Ada Core Technologies Inc. -- --- -- ------------------------------------------------------------------------------- - -with Ada.Characters.Handling; use Ada.Characters.Handling; -with Interfaces.C.Strings; -with System; - -with Hostparm; -with Opt; -with Output; use Output; - -with MLib.Utl; use MLib.Utl; - -with Prj.Com; - -with GNAT.Directory_Operations; use GNAT.Directory_Operations; - -package body MLib is - - ------------------- - -- Build_Library -- - ------------------- - - procedure Build_Library - (Ofiles : Argument_List; - Output_File : String; - Output_Dir : String) - is - begin - if Opt.Verbose_Mode and not Opt.Quiet_Output then - Write_Line ("building a library..."); - Write_Str (" make "); - Write_Line (Output_File); - end if; - - Ar (Output_Dir & Directory_Separator & - "lib" & Output_File & ".a", Objects => Ofiles); - end Build_Library; - - ------------------------ - -- Check_Library_Name -- - ------------------------ - - procedure Check_Library_Name (Name : String) is - begin - if Name'Length = 0 then - Prj.Com.Fail ("library name cannot be empty"); - end if; - - if Name'Length > Max_Characters_In_Library_Name then - Prj.Com.Fail ("illegal library name """, Name, """: too long"); - end if; - - if not Is_Letter (Name (Name'First)) then - Prj.Com.Fail ("illegal library name """, - Name, - """: should start with a letter"); - end if; - - for Index in Name'Range loop - if not Is_Alphanumeric (Name (Index)) then - Prj.Com.Fail ("illegal library name """, - Name, - """: should include only letters and digits"); - end if; - end loop; - end Check_Library_Name; - - -------------------- - -- Copy_ALI_Files -- - -------------------- - - procedure Copy_ALI_Files - (Files : Argument_List; - To : Path_Name_Type; - Interfaces : String_List) - is - Success : Boolean := False; - To_Dir : constant String := Get_Name_String (To); - Is_Interface : Boolean := False; - - procedure Verbose_Copy (Index : Positive); - -- In verbose mode, output a message that the indexed file is copied - -- to the destination directory. - - ------------------ - -- Verbose_Copy -- - ------------------ - - procedure Verbose_Copy (Index : Positive) is - begin - if Opt.Verbose_Mode then - Write_Str ("Copying """); - Write_Str (Files (Index).all); - Write_Str (""" to """); - Write_Str (To_Dir); - Write_Line (""""); - end if; - end Verbose_Copy; - - -- Start of processing for Copy_ALI_Files - - begin - if Interfaces'Length = 0 then - - -- If there are no Interfaces, copy all the ALI files as is - - for Index in Files'Range loop - Verbose_Copy (Index); - Set_Writable - (To_Dir & - Directory_Separator & - Base_Name (Files (Index).all)); - Copy_File - (Files (Index).all, - To_Dir, - Success, - Mode => Overwrite, - Preserve => Preserve); - - exit when not Success; - end loop; - - else - -- Copy only the interface ALI file, and put the special indicator - -- "SL" on the P line. - - for Index in Files'Range loop - - declare - File_Name : String := Base_Name (Files (Index).all); - - begin - Canonical_Case_File_Name (File_Name); - - -- Check if this is one of the interface ALIs - - Is_Interface := False; - - for Index in Interfaces'Range loop - if File_Name = Interfaces (Index).all then - Is_Interface := True; - exit; - end if; - end loop; - - -- If it is an interface ALI, copy line by line. Insert - -- the interface indication at the end of the P line. - -- Do not copy ALI files that are not Interfaces. - - if Is_Interface then - Success := False; - Verbose_Copy (Index); - Set_Writable - (To_Dir & - Directory_Separator & - Base_Name (Files (Index).all)); - - declare - FD : File_Descriptor; - Len : Integer; - Actual_Len : Integer; - S : String_Access; - Curr : Natural; - P_Line_Found : Boolean; - Status : Boolean; - - begin - -- Open the file - - Name_Len := Files (Index)'Length; - Name_Buffer (1 .. Name_Len) := Files (Index).all; - Name_Len := Name_Len + 1; - Name_Buffer (Name_Len) := ASCII.NUL; - - FD := Open_Read (Name_Buffer'Address, Binary); - - if FD /= Invalid_FD then - Len := Integer (File_Length (FD)); - - S := new String (1 .. Len + 3); - - -- Read the file. Note that the loop is not necessary - -- since the whole file is read at once except on VMS. - - Curr := 1; - Actual_Len := Len; - - while Actual_Len /= 0 loop - Actual_Len := Read (FD, S (Curr)'Address, Len); - Curr := Curr + Actual_Len; - end loop; - - -- We are done with the input file, so we close it - -- ignoring any bad status. - - Close (FD, Status); - - P_Line_Found := False; - - -- Look for the P line. When found, add marker SL - -- at the beginning of the P line. - - for Index in 1 .. Len - 3 loop - if (S (Index) = ASCII.LF or else - S (Index) = ASCII.CR) - and then - S (Index + 1) = 'P' - then - S (Index + 5 .. Len + 3) := S (Index + 2 .. Len); - S (Index + 2 .. Index + 4) := " SL"; - P_Line_Found := True; - exit; - end if; - end loop; - - if P_Line_Found then - - -- Create new modified ALI file - - Name_Len := To_Dir'Length; - Name_Buffer (1 .. Name_Len) := To_Dir; - Name_Len := Name_Len + 1; - Name_Buffer (Name_Len) := Directory_Separator; - Name_Buffer - (Name_Len + 1 .. Name_Len + File_Name'Length) := - File_Name; - Name_Len := Name_Len + File_Name'Length + 1; - Name_Buffer (Name_Len) := ASCII.NUL; - - FD := Create_File (Name_Buffer'Address, Binary); - - -- Write the modified text and close the newly - -- created file. - - if FD /= Invalid_FD then - Actual_Len := Write (FD, S (1)'Address, Len + 3); - - Close (FD, Status); - - -- Set Success to True only if the newly - -- created file has been correctly written. - - Success := Status and then Actual_Len = Len + 3; - - if Success then - - -- Set_Read_Only is used here, rather than - -- Set_Non_Writable, so that gprbuild can - -- he compiled with older compilers. - - Set_Read_Only - (Name_Buffer (1 .. Name_Len - 1)); - end if; - end if; - end if; - end if; - end; - - -- This is not an interface ALI - - else - Success := True; - end if; - end; - - if not Success then - Prj.Com.Fail ("could not copy ALI files to library dir"); - end if; - end loop; - 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"); - - Version_Path : String_Access; - - Success : Boolean; - Result : Integer; - pragma Unreferenced (Success, Result); - - begin - Version_Path := new String (1 .. Lib_Version'Length + 1); - Version_Path (1 .. Lib_Version'Length) := Lib_Version; - 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); - Maj_Ver : String (1 .. Maj_Version'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; - - Maj_Ver (1 .. Maj_Version'Length) := Maj_Version; - Maj_Ver (Maj_Ver'Last) := ASCII.NUL; - - Delete_File (Maj_Path, Success); - - Result := Symlink (Version_Path (1)'Address, Newpath2'Address); - - Delete_File (Lib_Path, Success); - - Result := Symlink (Maj_Ver'Address, Newpath1'Address); - end; - end if; - end Create_Sym_Links; - - -------------------------------- - -- Linker_Library_Path_Option -- - -------------------------------- - - function Linker_Library_Path_Option return String_Access is - - Run_Path_Option_Ptr : Interfaces.C.Strings.chars_ptr; - pragma Import (C, Run_Path_Option_Ptr, "__gnat_run_path_option"); - -- Pointer to string representing the native linker option which - -- specifies the path where the dynamic loader should find shared - -- libraries. Equal to null string if this system doesn't support it. - - S : constant String := Interfaces.C.Strings.Value (Run_Path_Option_Ptr); - - begin - if S'Length = 0 then - return null; - else - return new String'(S); - 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 - -- Copy_Attributes always fails on VMS - - if Hostparm.OpenVMS then - Preserve := None; - end if; -end MLib; |