diff options
Diffstat (limited to 'gcc-4.2.1/gcc/ada/mlib.adb')
| -rw-r--r-- | gcc-4.2.1/gcc/ada/mlib.adb | 314 |
1 files changed, 314 insertions, 0 deletions
diff --git a/gcc-4.2.1/gcc/ada/mlib.adb b/gcc-4.2.1/gcc/ada/mlib.adb new file mode 100644 index 000000000..549578a25 --- /dev/null +++ b/gcc-4.2.1/gcc/ada/mlib.adb @@ -0,0 +1,314 @@ +------------------------------------------------------------------------------ +-- -- +-- GNAT COMPILER COMPONENTS -- +-- -- +-- M L I B -- +-- -- +-- B o d y -- +-- -- +-- Copyright (C) 1999-2005, 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 2, 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 COPYING. If not, write -- +-- to the Free Software Foundation, 51 Franklin Street, Fifth Floor, -- +-- Boston, MA 02110-1301, USA. -- +-- -- +-- 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 Hostparm; +with Opt; +with Output; use Output; +with Namet; use Namet; + +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; + Afiles : Argument_List; + Output_File : String; + Output_Dir : String) + is + pragma Warnings (Off, Afiles); + + begin + if not Opt.Quiet_Output then + Write_Line ("building a library..."); + Write_Str (" make "); + Write_Line (Output_File); + end if; + + Ar (Output_Dir & "/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 : Name_Id; + 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; + + 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); + 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); + + 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 + + Close (FD, Status); + -- We simply ignore any bad 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 Actual_Len = Len + 3; + + if Success then + Set_Read_Only ( + Name_Buffer (1 .. Name_Len - 1)); + end if; + end if; + end if; + end if; + end; + + else + -- This is not an interface ALI + + 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; + + -------------------------------- + -- 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; + +-- Package elaboration + +begin + -- Copy_Attributes always fails on VMS + + if Hostparm.OpenVMS then + Preserve := None; + end if; +end MLib; |