1 ------------------------------------------------------------------------------
3 -- GNAT COMPILER COMPONENTS --
9 -- Copyright (C) 2001, Ada Core Technologies, Inc. --
11 -- GNAT is free software; you can redistribute it and/or modify it under --
12 -- terms of the GNU General Public License as published by the Free Soft- --
13 -- ware Foundation; either version 2, or (at your option) any later ver- --
14 -- sion. GNAT is distributed in the hope that it will be useful, but WITH- --
15 -- OUT ANY WARRANTY; without even the implied warranty of MERCHANTABILITY --
16 -- or FITNESS FOR A PARTICULAR PURPOSE. See the GNU General Public License --
17 -- for more details. You should have received a copy of the GNU General --
18 -- Public License distributed with GNAT; see file COPYING. If not, write --
19 -- to the Free Software Foundation, 59 Temple Place - Suite 330, Boston, --
20 -- MA 02111-1307, USA. --
22 -- GNAT was originally developed by the GNAT team at New York University. --
23 -- It is now maintained by Ada Core Technologies Inc (http://www.gnat.com). --
25 ------------------------------------------------------------------------------
27 with Ada
.Characters
.Handling
;
29 with GNAT
.Directory_Operations
; use GNAT
.Directory_Operations
;
30 with GNAT
.OS_Lib
; use GNAT
.OS_Lib
;
34 with Output
; use Output
;
35 with Osint
; use Osint
;
36 with Namet
; use Namet
;
38 with Types
; use Types
;
40 package body MLib
.Prj
is
42 package Files
renames MLib
.Fil
;
43 package Target
renames MLib
.Tgt
;
45 -- List of objects to put inside the library
47 Object_Files
: Argument_List_Access
;
48 package Objects
is new Table
.Table
49 (Table_Name
=> "Mlib.Prj.Objects",
50 Table_Component_Type
=> String_Access
,
51 Table_Index_Type
=> Natural,
54 Table_Increment
=> 50);
56 -- List of non-Ada object files
58 Foreign_Objects
: Argument_List_Access
;
59 package Foreigns
is new Table
.Table
60 (Table_Name
=> "Mlib.Prj.Foreigns",
61 Table_Component_Type
=> String_Access
,
62 Table_Index_Type
=> Natural,
65 Table_Increment
=> 20);
69 Ali_Files
: Argument_List_Access
;
70 package Alis
is new Table
.Table
71 (Table_Name
=> "Mlib.Prj.Alis",
72 Table_Component_Type
=> String_Access
,
73 Table_Index_Type
=> Natural,
76 Table_Increment
=> 50);
78 -- List of options set in the command line.
80 Options
: Argument_List_Access
;
81 package Opts
is new Table
.Table
82 (Table_Name
=> "Mlib.Prj.Opts",
83 Table_Component_Type
=> String_Access
,
84 Table_Index_Type
=> Natural,
87 Table_Increment
=> 5);
89 type Build_Mode_State
is
90 (None
, Static
, Dynamic
, Relocatable
);
92 procedure Check
(Filename
: String);
93 -- Check if filename is a regular file. Fail if it is not.
95 procedure Check_Context
;
96 -- Check each object files in table Object_Files
97 -- Fail if any of them is not a regular file
99 procedure Reset_Tables
;
100 -- Make sure that all the above tables are empty
101 -- (Objects, Foreign_Objects, Ali_Files, Options)
107 procedure Build_Library
(For_Project
: Project_Id
) is
108 Data
: constant Project_Data
:= Projects
.Table
(For_Project
);
110 Project_Name
: constant String :=
111 Get_Name_String
(Data
.Name
);
113 Lib_Filename
: String_Access
;
114 Lib_Dirpath
: String_Access
:= new String'(".");
115 DLL_Address : String_Access := new String'(Target
.Default_DLL_Address
);
116 Lib_Version
: String_Access
:= new String'("");
118 The_Build_Mode : Build_Mode_State := None;
123 -- Fail if project is not a library project
125 if not Data.Library then
126 Fail ("project """, Project_Name, """ has no library");
129 Lib_Dirpath := new String'(Get_Name_String
(Data
.Library_Dir
));
130 Lib_Filename
:= new String'(Get_Name_String (Data.Library_Name));
132 case Data.Library_Kind is
134 The_Build_Mode := Static;
137 The_Build_Mode := Dynamic;
140 The_Build_Mode := Relocatable;
142 if Target.PIC_Option /= "" then
144 Opts.Table (Opts.Last) := new String'(Target
.PIC_Option
);
148 -- Get the library version, if any
150 if Data
.Lib_Internal_Name
/= No_Name
then
151 Lib_Version
:= new String'(Get_Name_String (Data.Lib_Internal_Name));
154 -- Add the objects found in the object directory
157 Object_Dir : Dir_Type;
158 Filename : String (1 .. 255);
160 Object_Dir_Path : constant String :=
161 Get_Name_String (Data.Object_Directory);
163 Open (Dir => Object_Dir, Dir_Name => Object_Dir_Path);
165 -- For all entries in the object directory
168 Read (Object_Dir, Filename, Last);
172 -- Check if it is an object file
174 if Files.Is_Obj (Filename (1 .. Last)) then
175 -- record this object file
177 Objects.Increment_Last;
178 Objects.Table (Objects.Last) :=
179 new String' (Object_Dir_Path
& Directory_Separator
&
180 Filename
(1 .. Last
));
184 Files
.Ext_To
(Object_Dir_Path
&
185 Filename
(1 .. Last
), "ali"))
187 -- Record the corresponding ali file
190 Alis
.Table
(Alis
.Last
) :=
191 new String' (Object_Dir_Path &
193 (Filename (1 .. Last), "ali"));
196 -- The object file is a foreign object file
198 Foreigns.Increment_Last;
199 Foreigns.Table (Foreigns.Last) :=
200 new String'(Object_Dir_Path
&
201 Filename
(1 .. Last
));
207 Close
(Dir
=> Object_Dir
);
210 when Directory_Error
=>
211 Fail
("cannot find object directory """,
212 Get_Name_String
(Data
.Object_Directory
),
216 -- We want to link some Ada files, so we need to link with
217 -- the GNAT runtime (libgnat & libgnarl)
219 if The_Build_Mode
= Dynamic
or else The_Build_Mode
= Relocatable
then
221 Opts
.Table
(Opts
.Last
) := new String' ("-lgnarl");
223 Opts.Table (Opts.Last) := new String' ("-lgnat");
227 new Argument_List
'(Argument_List (Objects.Table (1 .. Objects.Last)));
230 new Argument_List'(Argument_List
231 (Foreigns
.Table
(1 .. Foreigns
.Last
)));
234 new Argument_List
'(Argument_List (Alis.Table (1 .. Alis.Last)));
237 new Argument_List'(Argument_List
(Opts
.Table
(1 .. Opts
.Last
)));
239 -- We fail if there are no object to put in the library
240 -- (Ada or foreign objects)
242 if Object_Files
'Length = 0 then
243 Fail
("no object files");
247 if not Opt
.Quiet_Output
then
249 Write_Str
("building ");
250 Write_Str
(Ada
.Characters
.Handling
.To_Lower
251 (Build_Mode_State
'Image (The_Build_Mode
)));
252 Write_Str
(" library for project ");
253 Write_Line
(Project_Name
);
257 -- We check that all object files are regular files
261 -- And we call the procedure to build the library,
262 -- depending on the build mode
264 case The_Build_Mode
is
265 when Dynamic | Relocatable
=>
266 Target
.Build_Dynamic_Library
267 (Ofiles
=> Object_Files
.all,
268 Foreign
=> Foreign_Objects
.all,
269 Afiles
=> Ali_Files
.all,
270 Options
=> Options
.all,
271 Lib_Filename
=> Lib_Filename
.all,
272 Lib_Dir
=> Lib_Dirpath
.all,
273 Lib_Address
=> DLL_Address
.all,
274 Lib_Version
=> Lib_Version
.all,
275 Relocatable
=> The_Build_Mode
= Relocatable
);
288 -- We need to copy the ALI files from the object directory
289 -- to the library directory, so that the linker find them
290 -- there, and does not need to look in the object directory
291 -- where it would also find the object files; and we don't want
292 -- that: we want the linker to use the library.
294 Target
.Copy_ALI_Files
295 (From
=> Projects
.Table
(For_Project
).Object_Directory
,
296 To
=> Projects
.Table
(For_Project
).Library_Dir
);
304 procedure Check
(Filename
: String) is
306 if not Is_Regular_File
(Filename
) then
307 Fail
(Filename
, " not found.");
316 procedure Check_Context
is
318 -- check that each object file exist
320 for F
in Object_Files
'Range loop
321 Check
(Object_Files
(F
).all);
329 procedure Reset_Tables
is