1 ------------------------------------------------------------------------------
3 -- GNAT COMPILER COMPONENTS --
10 -- Copyright (C) 2003-2005, Ada Core Technologies, Inc. --
12 -- GNAT is free software; you can redistribute it and/or modify it under --
13 -- terms of the GNU General Public License as published by the Free Soft- --
14 -- ware Foundation; either version 2, or (at your option) any later ver- --
15 -- sion. GNAT is distributed in the hope that it will be useful, but WITH- --
16 -- OUT ANY WARRANTY; without even the implied warranty of MERCHANTABILITY --
17 -- or FITNESS FOR A PARTICULAR PURPOSE. See the GNU General Public License --
18 -- for more details. You should have received a copy of the GNU General --
19 -- Public License distributed with GNAT; see file COPYING. If not, write --
20 -- to the Free Software Foundation, 51 Franklin Street, Fifth Floor, --
21 -- Boston, MA 02110-1301, USA. --
23 -- GNAT was originally developed by the GNAT team at New York University. --
24 -- Extensive contributions were provided by Ada Core Technologies Inc. --
26 ------------------------------------------------------------------------------
28 -- This package provides a set of target dependent routines to build
29 -- libraries (static only on HP-UX).
31 -- This is the HP-UX version of the body.
35 with Namet
; use Namet
;
37 with Output
; use Output
;
41 package body MLib
.Tgt
is
47 function Archive_Builder
return String is
52 -----------------------------
53 -- Archive_Builder_Options --
54 -----------------------------
56 function Archive_Builder_Options
return String_List_Access
is
58 return new String_List
'(1 => new String'("cr"));
59 end Archive_Builder_Options
;
65 function Archive_Ext
return String is
74 function Archive_Indexer
return String is
79 -----------------------------
80 -- Archive_Indexer_Options --
81 -----------------------------
83 function Archive_Indexer_Options
return String_List_Access
is
85 return new String_List
(1 .. 0);
86 end Archive_Indexer_Options
;
88 ---------------------------
89 -- Build_Dynamic_Library --
90 ---------------------------
92 procedure Build_Dynamic_Library
93 (Ofiles
: Argument_List
;
94 Foreign
: Argument_List
;
95 Afiles
: Argument_List
;
96 Options
: Argument_List
;
97 Options_2
: Argument_List
;
98 Interfaces
: Argument_List
;
99 Lib_Filename
: String;
101 Symbol_Data
: Symbol_Record
;
102 Driver_Name
: Name_Id
:= No_Name
;
103 Lib_Version
: String := "";
104 Auto_Init
: Boolean := False)
106 pragma Unreferenced
(Foreign
);
107 pragma Unreferenced
(Afiles
);
108 pragma Unreferenced
(Interfaces
);
109 pragma Unreferenced
(Symbol_Data
);
110 pragma Unreferenced
(Auto_Init
);
112 Lib_File
: constant String :=
113 Lib_Dir
& Directory_Separator
& "lib" &
114 MLib
.Fil
.Ext_To
(Lib_Filename
, DLL_Ext
);
116 Version_Arg
: String_Access
;
117 Symbolic_Link_Needed
: Boolean := False;
119 Common_Options
: constant Argument_List
:=
120 Options
& new String'(PIC_Option);
121 -- Common set of options to the gcc command performing the link.
122 -- On HPUX, this command eventually resorts to collect2, which may
123 -- generate a C file and compile it on the fly. This compilation shall
124 -- also generate position independant code for the final link to
127 if Opt.Verbose_Mode then
128 Write_Str ("building relocatable shared library ");
129 Write_Line (Lib_File);
132 if Lib_Version = "" then
134 (Output_File => Lib_File,
136 Options => Common_Options,
137 Options_2 => Options_2,
138 Driver_Name => Driver_Name);
141 Version_Arg := new String'("-Wl,+h," & Lib_Version
);
143 if Is_Absolute_Path
(Lib_Version
) then
145 (Output_File
=> Lib_Version
,
147 Options
=> Common_Options
& Version_Arg
,
148 Options_2
=> Options_2
,
149 Driver_Name
=> Driver_Name
);
150 Symbolic_Link_Needed
:= Lib_Version
/= Lib_File
;
154 (Output_File
=> Lib_Dir
& Directory_Separator
& Lib_Version
,
156 Options
=> Common_Options
& Version_Arg
,
157 Options_2
=> Options_2
,
158 Driver_Name
=> Driver_Name
);
159 Symbolic_Link_Needed
:=
160 Lib_Dir
& Directory_Separator
& Lib_Version
/= Lib_File
;
163 if Symbolic_Link_Needed
then
166 Oldpath
: String (1 .. Lib_Version
'Length + 1);
167 Newpath
: String (1 .. Lib_File
'Length + 1);
170 pragma Unreferenced
(Result
);
173 (Oldpath
: System
.Address
;
174 Newpath
: System
.Address
) return Integer;
175 pragma Import
(C
, Symlink
, "__gnat_symlink");
178 Oldpath
(1 .. Lib_Version
'Length) := Lib_Version
;
179 Oldpath
(Oldpath
'Last) := ASCII
.NUL
;
180 Newpath
(1 .. Lib_File
'Length) := Lib_File
;
181 Newpath
(Newpath
'Last) := ASCII
.NUL
;
183 Delete_File
(Lib_File
, Success
);
185 Result
:= Symlink
(Oldpath
'Address, Newpath
'Address);
189 end Build_Dynamic_Library
;
195 function DLL_Ext
return String is
204 function Dynamic_Option
return String is
213 function Is_Object_Ext
(Ext
: String) return Boolean is
222 function Is_C_Ext
(Ext
: String) return Boolean is
231 function Is_Archive_Ext
(Ext
: String) return Boolean is
233 return Ext
= ".a" or else Ext
= ".so";
240 function Libgnat
return String is
245 ------------------------
246 -- Library_Exists_For --
247 ------------------------
249 function Library_Exists_For
250 (Project
: Project_Id
; In_Tree
: Project_Tree_Ref
) return Boolean
253 if not In_Tree
.Projects
.Table
(Project
).Library
then
254 Prj
.Com
.Fail
("INTERNAL ERROR: Library_Exists_For called " &
255 "for non library project");
260 Lib_Dir
: constant String :=
262 (In_Tree
.Projects
.Table
(Project
).Library_Dir
);
263 Lib_Name
: constant String :=
265 (In_Tree
.Projects
.Table
(Project
).Library_Name
);
268 if In_Tree
.Projects
.Table
(Project
).Library_Kind
=
271 return Is_Regular_File
272 (Lib_Dir
& Directory_Separator
& "lib" &
273 Fil
.Ext_To
(Lib_Name
, Archive_Ext
));
276 return Is_Regular_File
277 (Lib_Dir
& Directory_Separator
& "lib" &
278 Fil
.Ext_To
(Lib_Name
, DLL_Ext
));
282 end Library_Exists_For
;
284 ---------------------------
285 -- Library_File_Name_For --
286 ---------------------------
288 function Library_File_Name_For
289 (Project
: Project_Id
;
290 In_Tree
: Project_Tree_Ref
) return Name_Id
293 if not In_Tree
.Projects
.Table
(Project
).Library
then
294 Prj
.Com
.Fail
("INTERNAL ERROR: Library_File_Name_For called " &
295 "for non library project");
300 Lib_Name
: constant String :=
302 (In_Tree
.Projects
.Table
(Project
).Library_Name
);
306 Name_Buffer
(1 .. Name_Len
) := "lib";
308 if In_Tree
.Projects
.Table
(Project
).Library_Kind
=
311 Add_Str_To_Name_Buffer
(Fil
.Ext_To
(Lib_Name
, Archive_Ext
));
314 Add_Str_To_Name_Buffer
(Fil
.Ext_To
(Lib_Name
, DLL_Ext
));
320 end Library_File_Name_For
;
326 function Object_Ext
return String is
335 function PIC_Option
return String is
340 -----------------------------------------------
341 -- Standalone_Library_Auto_Init_Is_Supported --
342 -----------------------------------------------
344 function Standalone_Library_Auto_Init_Is_Supported
return Boolean is
347 end Standalone_Library_Auto_Init_Is_Supported
;
349 ---------------------------
350 -- Support_For_Libraries --
351 ---------------------------
353 function Support_For_Libraries
return Library_Support
is
356 end Support_For_Libraries
;