diff options
Diffstat (limited to 'gcc/ada/mlib.adb')
| -rw-r--r-- | gcc/ada/mlib.adb | 228 |
1 files changed, 216 insertions, 12 deletions
diff --git a/gcc/ada/mlib.adb b/gcc/ada/mlib.adb index 1b2997fadc6..5016587d5f8 100644 --- a/gcc/ada/mlib.adb +++ b/gcc/ada/mlib.adb @@ -6,7 +6,7 @@ -- -- -- B o d y -- -- -- --- Copyright (C) 1999-2001, Ada Core Technologies, Inc. -- +-- Copyright (C) 1999-2003, Ada Core Technologies, 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- -- @@ -20,19 +20,25 @@ -- MA 02111-1307, USA. -- -- -- -- GNAT was originally developed by the GNAT team at New York University. -- --- It is now maintained by Ada Core Technologies Inc (http://www.gnat.com). -- +-- Extensive contributions were provided by Ada Core Technologies Inc. -- -- -- ------------------------------------------------------------------------------ with Ada.Characters.Handling; use Ada.Characters.Handling; + +with Hostparm; with Opt; -with Osint; use Osint; -with Output; use Output; -with MLib.Utl; +with Output; use Output; +with Namet; use Namet; -package body MLib is +with MLib.Utl; use MLib.Utl; + +with GNAT.Directory_Operations; use GNAT.Directory_Operations; +with GNAT.OS_Lib; use GNAT.OS_Lib; + +with System; - package Tools renames MLib.Utl; +package body MLib is ------------------- -- Build_Library -- @@ -55,8 +61,7 @@ package body MLib is Write_Line (Output_File); end if; - Tools.Ar (Output_Dir & "/lib" & Output_File & ".a", Objects => Ofiles); - + Ar (Output_Dir & "/lib" & Output_File & ".a", Objects => Ofiles); end Build_Library; ------------------------ @@ -70,9 +75,7 @@ package body MLib is end if; if Name'Length > Max_Characters_In_Library_Name then - Fail ("illegal library name """, - Name, - """: too long"); + Fail ("illegal library name """, Name, """: too long"); end if; if not Is_Letter (Name (Name'First)) then @@ -90,4 +93,205 @@ package body MLib is 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); + Interface : Boolean := False; + + procedure Set_Readonly (Name : System.Address); + pragma Import (C, Set_Readonly, "__gnat_set_readonly"); + + 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 + + Interface := False; + + for Index in Interfaces'Range loop + if File_Name = Interfaces (Index).all then + 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 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_Readonly (Name_Buffer'Address); + 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 + Fail ("could not copy ALI files to library dir"); + end if; + end loop; + end if; + end Copy_ALI_Files; + +-- Package elaboration + +begin + if Hostparm.OpenVMS then + + -- Copy_Attributes always fails on VMS + + Preserve := None; + end if; end MLib; |