]>
Commit | Line | Data |
---|---|---|
84481f76 RK |
1 | ------------------------------------------------------------------------------ |
2 | -- -- | |
3 | -- GNAT COMPILER COMPONENTS -- | |
4 | -- -- | |
5 | -- M L I B . P R J -- | |
6 | -- -- | |
7 | -- B o d y -- | |
8 | -- -- | |
84481f76 RK |
9 | -- Copyright (C) 2001, Ada Core Technologies, Inc. -- |
10 | -- -- | |
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. -- | |
21 | -- -- | |
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). -- | |
24 | -- -- | |
25 | ------------------------------------------------------------------------------ | |
26 | ||
27 | with Ada.Characters.Handling; | |
28 | ||
29 | with GNAT.Directory_Operations; use GNAT.Directory_Operations; | |
30 | with GNAT.OS_Lib; use GNAT.OS_Lib; | |
31 | with MLib.Fil; | |
32 | with MLib.Tgt; | |
33 | with Opt; | |
34 | with Output; use Output; | |
35 | with Osint; use Osint; | |
36 | with Namet; use Namet; | |
37 | with Table; | |
38 | with Types; use Types; | |
39 | ||
40 | package body MLib.Prj is | |
41 | ||
42 | package Files renames MLib.Fil; | |
43 | package Target renames MLib.Tgt; | |
44 | ||
45 | -- List of objects to put inside the library | |
46 | ||
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, | |
52 | Table_Low_Bound => 1, | |
53 | Table_Initial => 50, | |
54 | Table_Increment => 50); | |
55 | ||
56 | -- List of non-Ada object files | |
57 | ||
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, | |
63 | Table_Low_Bound => 1, | |
64 | Table_Initial => 20, | |
65 | Table_Increment => 20); | |
66 | ||
67 | -- List of ALI files | |
68 | ||
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, | |
74 | Table_Low_Bound => 1, | |
75 | Table_Initial => 50, | |
76 | Table_Increment => 50); | |
77 | ||
78 | -- List of options set in the command line. | |
79 | ||
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, | |
85 | Table_Low_Bound => 1, | |
86 | Table_Initial => 5, | |
87 | Table_Increment => 5); | |
88 | ||
89 | type Build_Mode_State is | |
90 | (None, Static, Dynamic, Relocatable); | |
91 | ||
92 | procedure Check (Filename : String); | |
93 | -- Check if filename is a regular file. Fail if it is not. | |
94 | ||
95 | procedure Check_Context; | |
96 | -- Check each object files in table Object_Files | |
97 | -- Fail if any of them is not a regular file | |
98 | ||
99 | procedure Reset_Tables; | |
100 | -- Make sure that all the above tables are empty | |
101 | -- (Objects, Foreign_Objects, Ali_Files, Options) | |
102 | ||
103 | ------------------- | |
104 | -- Build_Library -- | |
105 | ------------------- | |
106 | ||
107 | procedure Build_Library (For_Project : Project_Id) is | |
108 | Data : constant Project_Data := Projects.Table (For_Project); | |
109 | ||
110 | Project_Name : constant String := | |
111 | Get_Name_String (Data.Name); | |
112 | ||
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'(""); | |
117 | ||
118 | The_Build_Mode : Build_Mode_State := None; | |
119 | ||
120 | begin | |
121 | Reset_Tables; | |
122 | ||
123 | -- Fail if project is not a library project | |
124 | ||
125 | if not Data.Library then | |
126 | Fail ("project """, Project_Name, """ has no library"); | |
127 | end if; | |
128 | ||
129 | Lib_Dirpath := new String'(Get_Name_String (Data.Library_Dir)); | |
130 | Lib_Filename := new String'(Get_Name_String (Data.Library_Name)); | |
131 | ||
132 | case Data.Library_Kind is | |
133 | when Static => | |
134 | The_Build_Mode := Static; | |
135 | ||
136 | when Dynamic => | |
137 | The_Build_Mode := Dynamic; | |
138 | ||
139 | when Relocatable => | |
140 | The_Build_Mode := Relocatable; | |
141 | ||
142 | if Target.PIC_Option /= "" then | |
143 | Opts.Increment_Last; | |
144 | Opts.Table (Opts.Last) := new String'(Target.PIC_Option); | |
145 | end if; | |
146 | end case; | |
147 | ||
148 | -- Get the library version, if any | |
149 | ||
150 | if Data.Lib_Internal_Name /= No_Name then | |
151 | Lib_Version := new String'(Get_Name_String (Data.Lib_Internal_Name)); | |
152 | end if; | |
153 | ||
154 | -- Add the objects found in the object directory | |
155 | ||
156 | declare | |
157 | Object_Dir : Dir_Type; | |
158 | Filename : String (1 .. 255); | |
159 | Last : Natural; | |
160 | Object_Dir_Path : constant String := | |
161 | Get_Name_String (Data.Object_Directory); | |
162 | begin | |
163 | Open (Dir => Object_Dir, Dir_Name => Object_Dir_Path); | |
164 | ||
165 | -- For all entries in the object directory | |
166 | ||
167 | loop | |
168 | Read (Object_Dir, Filename, Last); | |
169 | ||
170 | exit when Last = 0; | |
171 | ||
172 | -- Check if it is an object file | |
173 | ||
174 | if Files.Is_Obj (Filename (1 .. Last)) then | |
175 | -- record this object file | |
176 | ||
177 | Objects.Increment_Last; | |
178 | Objects.Table (Objects.Last) := | |
179 | new String' (Object_Dir_Path & Directory_Separator & | |
180 | Filename (1 .. Last)); | |
181 | ||
182 | if Is_Regular_File | |
183 | (Object_Dir_Path & | |
184 | Files.Ext_To (Object_Dir_Path & | |
185 | Filename (1 .. Last), "ali")) | |
186 | then | |
187 | -- Record the corresponding ali file | |
188 | ||
189 | Alis.Increment_Last; | |
190 | Alis.Table (Alis.Last) := | |
191 | new String' (Object_Dir_Path & | |
192 | Files.Ext_To | |
193 | (Filename (1 .. Last), "ali")); | |
194 | ||
195 | else | |
196 | -- The object file is a foreign object file | |
197 | ||
198 | Foreigns.Increment_Last; | |
199 | Foreigns.Table (Foreigns.Last) := | |
200 | new String'(Object_Dir_Path & | |
201 | Filename (1 .. Last)); | |
202 | ||
203 | end if; | |
204 | end if; | |
205 | end loop; | |
206 | ||
207 | Close (Dir => Object_Dir); | |
208 | ||
209 | exception | |
210 | when Directory_Error => | |
211 | Fail ("cannot find object directory """, | |
212 | Get_Name_String (Data.Object_Directory), | |
213 | """"); | |
214 | end; | |
215 | ||
216 | -- We want to link some Ada files, so we need to link with | |
217 | -- the GNAT runtime (libgnat & libgnarl) | |
218 | ||
219 | if The_Build_Mode = Dynamic or else The_Build_Mode = Relocatable then | |
220 | Opts.Increment_Last; | |
221 | Opts.Table (Opts.Last) := new String' ("-lgnarl"); | |
222 | Opts.Increment_Last; | |
223 | Opts.Table (Opts.Last) := new String' ("-lgnat"); | |
224 | end if; | |
225 | ||
226 | Object_Files := | |
227 | new Argument_List'(Argument_List (Objects.Table (1 .. Objects.Last))); | |
228 | ||
229 | Foreign_Objects := | |
230 | new Argument_List'(Argument_List | |
231 | (Foreigns.Table (1 .. Foreigns.Last))); | |
232 | ||
233 | Ali_Files := | |
234 | new Argument_List'(Argument_List (Alis.Table (1 .. Alis.Last))); | |
235 | ||
236 | Options := | |
237 | new Argument_List'(Argument_List (Opts.Table (1 .. Opts.Last))); | |
238 | ||
239 | -- We fail if there are no object to put in the library | |
240 | -- (Ada or foreign objects) | |
241 | ||
242 | if Object_Files'Length = 0 then | |
243 | Fail ("no object files"); | |
244 | ||
245 | end if; | |
246 | ||
247 | if not Opt.Quiet_Output then | |
248 | Write_Eol; | |
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); | |
254 | Write_Eol; | |
255 | end if; | |
256 | ||
257 | -- We check that all object files are regular files | |
258 | ||
259 | Check_Context; | |
260 | ||
261 | -- And we call the procedure to build the library, | |
262 | -- depending on the build mode | |
263 | ||
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); | |
276 | ||
277 | when Static => | |
278 | MLib.Build_Library | |
279 | (Object_Files.all, | |
280 | Ali_Files.all, | |
281 | Lib_Filename.all, | |
282 | Lib_Dirpath.all); | |
283 | ||
284 | when None => | |
285 | null; | |
286 | end case; | |
287 | ||
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. | |
293 | ||
294 | Target.Copy_ALI_Files | |
295 | (From => Projects.Table (For_Project).Object_Directory, | |
296 | To => Projects.Table (For_Project).Library_Dir); | |
297 | ||
298 | end Build_Library; | |
299 | ||
300 | ----------- | |
301 | -- Check -- | |
302 | ----------- | |
303 | ||
304 | procedure Check (Filename : String) is | |
305 | begin | |
306 | if not Is_Regular_File (Filename) then | |
307 | Fail (Filename, " not found."); | |
308 | ||
309 | end if; | |
310 | end Check; | |
311 | ||
312 | ------------------- | |
313 | -- Check_Context -- | |
314 | ------------------- | |
315 | ||
316 | procedure Check_Context is | |
317 | begin | |
318 | -- check that each object file exist | |
319 | ||
320 | for F in Object_Files'Range loop | |
321 | Check (Object_Files (F).all); | |
322 | end loop; | |
323 | end Check_Context; | |
324 | ||
325 | ------------------ | |
326 | -- Reset_Tables -- | |
327 | ------------------ | |
328 | ||
329 | procedure Reset_Tables is | |
330 | begin | |
331 | Objects.Init; | |
332 | Foreigns.Init; | |
333 | Alis.Init; | |
334 | Opts.Init; | |
335 | end Reset_Tables; | |
336 | ||
337 | end MLib.Prj; |