From 6bb81bc17c6c2c8eeec2218abc5189f798e2ecbe Mon Sep 17 00:00:00 2001 From: Vincent Celier Date: Wed, 6 Jun 2007 12:15:24 +0200 Subject: mlib-tgt-specific.adb, [...]: New files. 2007-04-20 Vincent Celier * mlib-tgt-specific.adb, mlib-tgt-specific.ads, mlib-tgt-vms.adb, mlib-tgt-vms.ads: New files. * mlib-tgt.adb, mlib-tgt.ads, mlib-tgt-darwin.adb, mlib-tgt-vxworks.adb, mlib-tgt-mingw.adb, mlib-tgt-lynxos.adb, mlib-tgt-linux.adb, mlib-tgt-solaris.adb, mlib-tgt-vms-alpha.adb, mlib-tgt-vms-ia64.adb, mlib-tgt-aix.adb, mlib-tgt-irix.adb, mlib-tgt-hpux.adb, mlib-tgt-tru64.adb: Make a common body for package MLib.Tgt, containing the default versions of the exported subprograms. For each platforms, create a specific version of the body of new child package MLib.Tgt.Specific that contains only the bodies of subprograms that are different from the default. (Archive_Builder_Append_Options): New function From-SVN: r125366 --- gcc/ada/mlib-tgt-linux.adb | 289 ++++++++++----------------------------------- 1 file changed, 63 insertions(+), 226 deletions(-) (limited to 'gcc/ada/mlib-tgt-linux.adb') diff --git a/gcc/ada/mlib-tgt-linux.adb b/gcc/ada/mlib-tgt-linux.adb index 737a40a..848a11c 100644 --- a/gcc/ada/mlib-tgt-linux.adb +++ b/gcc/ada/mlib-tgt-linux.adb @@ -2,12 +2,12 @@ -- -- -- GNAT COMPILER COMPONENTS -- -- -- --- M L I B . T G T -- +-- M L I B . T G T . S P E C I F I C -- -- (GNU/Linux Version) -- -- -- -- 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- -- @@ -25,68 +25,35 @@ -- -- ------------------------------------------------------------------------------ --- This package provides a set of target dependent routines to build --- static, dynamic and shared libraries. - -- This is the GNU/Linux version of the body with MLib.Fil; with MLib.Utl; -with Namet; use Namet; with Opt; with Output; use Output; -with Prj.Com; with System; -package body MLib.Tgt is +package body MLib.Tgt.Specific is - use GNAT; use MLib; - --------------------- - -- Archive_Builder -- - --------------------- - - function Archive_Builder return String is - begin - return "ar"; - end Archive_Builder; - - ----------------------------- - -- Archive_Builder_Options -- - ----------------------------- - - function Archive_Builder_Options return String_List_Access is - begin - return new String_List'(1 => new String'("cr")); - end Archive_Builder_Options; - - ----------------- - -- Archive_Ext -- - ----------------- - - function Archive_Ext return String is - begin - return "a"; - end Archive_Ext; - - --------------------- - -- Archive_Indexer -- - --------------------- + -- Non default subprograms - function Archive_Indexer return String is - begin - return "ranlib"; - end Archive_Indexer; + 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); - ----------------------------- - -- Archive_Indexer_Options -- - ----------------------------- - - function Archive_Indexer_Options return String_List_Access is - begin - return new String_List (1 .. 0); - end Archive_Indexer_Options; + function Is_Archive_Ext (Ext : String) return Boolean; --------------------------- -- Build_Dynamic_Library -- @@ -114,8 +81,10 @@ package body MLib.Tgt is -- 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; @@ -123,12 +92,12 @@ package body MLib.Tgt 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, Driver_Name => Driver_Name, @@ -194,7 +163,7 @@ package body MLib.Tgt is Options => Options & Version_Arg, Driver_Name => Driver_Name, Options_2 => Options_2); - Symbolic_Link_Needed := Lib_Version /= Lib_File; + Symbolic_Link_Needed := Lib_Version /= Lib_Path; else Utl.Gcc @@ -204,14 +173,14 @@ package body MLib.Tgt is Driver_Name => Driver_Name, Options_2 => Options_2); Symbolic_Link_Needed := - Lib_Dir & Directory_Separator & Lib_Version /= Lib_File; + 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_File'Length + 1); + Newpath : String (1 .. Lib_Path'Length + 1); Result : Integer; pragma Unreferenced (Result); @@ -224,63 +193,48 @@ package body MLib.Tgt is begin Oldpath (1 .. Lib_Version'Length) := Lib_Version; Oldpath (Oldpath'Last) := ASCII.NUL; - Newpath (1 .. Lib_File'Length) := Lib_File; + Newpath (1 .. Lib_Path'Length) := Lib_Path; Newpath (Newpath'Last) := ASCII.NUL; - Delete_File (Lib_File, Success); + 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; + end if; end; end if; end Build_Dynamic_Library; - ------------- - -- DLL_Ext -- - ------------- - - function DLL_Ext return String is - begin - return "so"; - end DLL_Ext; - - ---------------- - -- DLL_Prefix -- - ---------------- - - function DLL_Prefix return String is - begin - return "lib"; - end DLL_Prefix; - - -------------------- - -- Dynamic_Option -- - -------------------- - - function Dynamic_Option return String is - begin - return "-shared"; - end Dynamic_Option; - - ------------------- - -- Is_Object_Ext -- - ------------------- - - function Is_Object_Ext (Ext : String) return Boolean is - begin - return Ext = ".o"; - end Is_Object_Ext; - - -------------- - -- Is_C_Ext -- - -------------- - - function Is_C_Ext (Ext : String) return Boolean is - begin - return Ext = ".c"; - end Is_C_Ext; - -------------------- -- Is_Archive_Ext -- -------------------- @@ -290,124 +244,7 @@ package body MLib.Tgt is return Ext = ".a" or else Ext = ".so"; end Is_Archive_Ext; - ------------- - -- Libgnat -- - ------------- - - function Libgnat return String is - begin - return "libgnat.a"; - end Libgnat; - - ------------------------ - -- Library_Exists_For -- - ------------------------ - - function Library_Exists_For - (Project : Project_Id; - In_Tree : Project_Tree_Ref) return Boolean - is - begin - if not In_Tree.Projects.Table (Project).Library then - Prj.Com.Fail ("INTERNAL ERROR: Library_Exists_For called " & - "for non library project"); - return False; - - else - declare - Lib_Dir : constant String := - Get_Name_String - (In_Tree.Projects.Table (Project).Library_Dir); - Lib_Name : constant String := - Get_Name_String - (In_Tree.Projects.Table (Project).Library_Name); - - begin - if In_Tree.Projects.Table (Project).Library_Kind = Static then - return Is_Regular_File - (Lib_Dir & Directory_Separator & "lib" & - Fil.Append_To (Lib_Name, Archive_Ext)); - - else - return Is_Regular_File - (Lib_Dir & Directory_Separator & "lib" & - Fil.Append_To (Lib_Name, DLL_Ext)); - end if; - end; - end if; - end Library_Exists_For; - - --------------------------- - -- Library_File_Name_For -- - --------------------------- - - function Library_File_Name_For - (Project : Project_Id; - In_Tree : Project_Tree_Ref) return Name_Id - is - begin - if not In_Tree.Projects.Table (Project).Library then - Prj.Com.Fail ("INTERNAL ERROR: Library_File_Name_For called " & - "for non library project"); - return No_Name; - - else - declare - Lib_Name : constant String := - Get_Name_String - (In_Tree.Projects.Table (Project).Library_Name); - - begin - Name_Len := 3; - Name_Buffer (1 .. Name_Len) := "lib"; - - if In_Tree.Projects.Table (Project).Library_Kind = - Static - then - Add_Str_To_Name_Buffer (Fil.Append_To (Lib_Name, Archive_Ext)); - else - Add_Str_To_Name_Buffer (Fil.Append_To (Lib_Name, DLL_Ext)); - end if; - - return Name_Find; - end; - end if; - end Library_File_Name_For; - - ---------------- - -- Object_Ext -- - ---------------- - - function Object_Ext return String is - begin - return "o"; - end Object_Ext; - - ---------------- - -- PIC_Option -- - ---------------- - - function PIC_Option return String is - begin - return "-fPIC"; - end PIC_Option; - - ----------------------------------------------- - -- Standalone_Library_Auto_Init_Is_Supported -- - ----------------------------------------------- - - function Standalone_Library_Auto_Init_Is_Supported return Boolean is - begin - return True; - end Standalone_Library_Auto_Init_Is_Supported; - - --------------------------- - -- Support_For_Libraries -- - --------------------------- - - function Support_For_Libraries return Library_Support is - begin - return Full; - end Support_For_Libraries; - -end MLib.Tgt; +begin + Build_Dynamic_Library_Ptr := Build_Dynamic_Library'Access; + Is_Archive_Ext_Ptr := Is_Archive_Ext'Access; +end MLib.Tgt.Specific; -- cgit v1.1