]>
Commit | Line | Data |
---|---|---|
fbf5a39b AC |
1 | ------------------------------------------------------------------------------ |
2 | -- -- | |
3 | -- GNAT COMPILER COMPONENTS -- | |
4 | -- -- | |
6bb81bc1 | 5 | -- M L I B . T G T . S P E C I F I C -- |
0ab80019 | 6 | -- (Alpha VMS Version) -- |
fbf5a39b AC |
7 | -- -- |
8 | -- B o d y -- | |
9 | -- -- | |
90d04a44 | 10 | -- Copyright (C) 2003-2011, Free Software Foundation, Inc. -- |
fbf5a39b AC |
11 | -- -- |
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- -- | |
b5c84c3c | 14 | -- ware Foundation; either version 3, or (at your option) any later ver- -- |
fbf5a39b AC |
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 -- | |
b5c84c3c RD |
19 | -- Public License distributed with GNAT; see file COPYING3. If not, go to -- |
20 | -- http://www.gnu.org/licenses for a complete copy of the license. -- | |
fbf5a39b AC |
21 | -- -- |
22 | -- GNAT was originally developed by the GNAT team at New York University. -- | |
23 | -- Extensive contributions were provided by Ada Core Technologies Inc. -- | |
24 | -- -- | |
25 | ------------------------------------------------------------------------------ | |
26 | ||
0ab80019 | 27 | -- This is the Alpha VMS version of the body |
fbf5a39b AC |
28 | |
29 | with Ada.Characters.Handling; use Ada.Characters.Handling; | |
fbf5a39b | 30 | |
fbf5a39b AC |
31 | with MLib.Fil; |
32 | with MLib.Utl; | |
6bb81bc1 | 33 | |
c228a069 | 34 | with MLib.Tgt.VMS_Common; use MLib.Tgt.VMS_Common; |
6bb81bc1 | 35 | |
2cd44f5a VC |
36 | with Opt; use Opt; |
37 | with Output; use Output; | |
6bb81bc1 VC |
38 | |
39 | with GNAT.Directory_Operations; use GNAT.Directory_Operations; | |
7e98a4c6 VC |
40 | |
41 | with System; use System; | |
42 | with System.Case_Util; use System.Case_Util; | |
43 | with System.CRTL; use System.CRTL; | |
fbf5a39b | 44 | |
6bb81bc1 VC |
45 | package body MLib.Tgt.Specific is |
46 | ||
dcd8728b | 47 | -- Non default subprogram. See comment in mlib-tgt.ads |
6bb81bc1 VC |
48 | |
49 | procedure Build_Dynamic_Library | |
50 | (Ofiles : Argument_List; | |
6bb81bc1 | 51 | Options : Argument_List; |
6bb81bc1 VC |
52 | Interfaces : Argument_List; |
53 | Lib_Filename : String; | |
54 | Lib_Dir : String; | |
55 | Symbol_Data : Symbol_Record; | |
56 | Driver_Name : Name_Id := No_Name; | |
57 | Lib_Version : String := ""; | |
58 | Auto_Init : Boolean := False); | |
fbf5a39b | 59 | |
6bb81bc1 | 60 | -- Local variables |
fbf5a39b AC |
61 | |
62 | Empty_Argument_List : aliased Argument_List := (1 .. 0 => null); | |
63 | Additional_Objects : Argument_List_Access := Empty_Argument_List'Access; | |
64 | -- Used to add the generated auto-init object files for auto-initializing | |
65 | -- stand-alone libraries. | |
66 | ||
7e98a4c6 | 67 | Macro_Name : constant String := "mcr gnu:[bin]gcc -c -x assembler"; |
fbf5a39b AC |
68 | -- The name of the command to invoke the macro-assembler |
69 | ||
af152989 | 70 | VMS_Options : Argument_List := (1 .. 1 => null); |
fbf5a39b AC |
71 | |
72 | Gnatsym_Name : constant String := "gnatsym"; | |
73 | ||
74 | Gnatsym_Path : String_Access; | |
75 | ||
76 | Arguments : Argument_List_Access := null; | |
77 | Last_Argument : Natural := 0; | |
78 | ||
79 | Success : Boolean := False; | |
80 | ||
b7e429ab AC |
81 | Shared_Libgcc : aliased String := "-shared-libgcc"; |
82 | ||
6bb81bc1 VC |
83 | Shared_Libgcc_Switch : constant Argument_List := |
84 | (1 => Shared_Libgcc'Access); | |
c4820158 | 85 | |
fbf5a39b AC |
86 | --------------------------- |
87 | -- Build_Dynamic_Library -- | |
88 | --------------------------- | |
89 | ||
90 | procedure Build_Dynamic_Library | |
91 | (Ofiles : Argument_List; | |
fbf5a39b AC |
92 | Options : Argument_List; |
93 | Interfaces : Argument_List; | |
94 | Lib_Filename : String; | |
95 | Lib_Dir : String; | |
19f0526a | 96 | Symbol_Data : Symbol_Record; |
fbf5a39b | 97 | Driver_Name : Name_Id := No_Name; |
fbf5a39b | 98 | Lib_Version : String := ""; |
fbf5a39b AC |
99 | Auto_Init : Boolean := False) |
100 | is | |
fbf5a39b | 101 | |
fbf5a39b AC |
102 | Lib_File : constant String := |
103 | Lib_Dir & Directory_Separator & "lib" & | |
246d2ceb | 104 | Fil.Ext_To (Lib_Filename, DLL_Ext); |
fbf5a39b AC |
105 | |
106 | Opts : Argument_List := Options; | |
107 | Last_Opt : Natural := Opts'Last; | |
108 | Opts2 : Argument_List (Options'Range); | |
109 | Last_Opt2 : Natural := Opts2'First - 1; | |
91b1417d AC |
110 | |
111 | Inter : constant Argument_List := Interfaces; | |
fbf5a39b AC |
112 | |
113 | function Is_Interface (Obj_File : String) return Boolean; | |
114 | -- For a Stand-Alone Library, returns True if Obj_File is the object | |
246d2ceb AC |
115 | -- file name of an interface of the SAL. For other libraries, always |
116 | -- return True. | |
fbf5a39b | 117 | |
19f0526a AC |
118 | function Option_File_Name return String; |
119 | -- Returns Symbol_File, if not empty. Otherwise, returns "symvec.opt" | |
120 | ||
121 | function Version_String return String; | |
a50c3345 | 122 | -- Returns Lib_Version if not empty and if Symbol_Data.Symbol_Policy is |
6bb81bc1 VC |
123 | -- not Autonomous, otherwise returns "". When Symbol_Data.Symbol_Policy |
124 | -- is Autonomous, fails gnatmake if Lib_Version is not the image of a | |
125 | -- positive number. | |
19f0526a | 126 | |
fbf5a39b AC |
127 | ------------------ |
128 | -- Is_Interface -- | |
129 | ------------------ | |
130 | ||
131 | function Is_Interface (Obj_File : String) return Boolean is | |
132 | ALI : constant String := | |
91b1417d AC |
133 | Fil.Ext_To |
134 | (Filename => To_Lower (Base_Name (Obj_File)), | |
135 | New_Ext => "ali"); | |
136 | ||
fbf5a39b AC |
137 | begin |
138 | if Inter'Length = 0 then | |
139 | return True; | |
140 | ||
141 | elsif ALI'Length > 2 and then | |
bb4daba3 | 142 | ALI (ALI'First .. ALI'First + 2) = "b__" |
fbf5a39b AC |
143 | then |
144 | return True; | |
145 | ||
146 | else | |
147 | for J in Inter'Range loop | |
148 | if Inter (J).all = ALI then | |
149 | return True; | |
150 | end if; | |
151 | end loop; | |
152 | ||
153 | return False; | |
154 | end if; | |
155 | end Is_Interface; | |
156 | ||
19f0526a AC |
157 | ---------------------- |
158 | -- Option_File_Name -- | |
159 | ---------------------- | |
160 | ||
161 | function Option_File_Name return String is | |
162 | begin | |
2cd44f5a | 163 | if Symbol_Data.Symbol_File = No_Path then |
19f0526a | 164 | return "symvec.opt"; |
19f0526a | 165 | else |
5c1c8a03 AC |
166 | Get_Name_String (Symbol_Data.Symbol_File); |
167 | To_Lower (Name_Buffer (1 .. Name_Len)); | |
168 | return Name_Buffer (1 .. Name_Len); | |
19f0526a AC |
169 | end if; |
170 | end Option_File_Name; | |
171 | ||
172 | -------------------- | |
173 | -- Version_String -- | |
174 | -------------------- | |
175 | ||
176 | function Version_String return String is | |
177 | Version : Integer := 0; | |
6bb81bc1 | 178 | |
19f0526a | 179 | begin |
a50c3345 VC |
180 | if Lib_Version = "" |
181 | or else Symbol_Data.Symbol_Policy /= Autonomous | |
182 | then | |
183 | return ""; | |
19f0526a AC |
184 | |
185 | else | |
186 | begin | |
187 | Version := Integer'Value (Lib_Version); | |
188 | ||
189 | if Version <= 0 then | |
190 | raise Constraint_Error; | |
191 | end if; | |
192 | ||
193 | return Lib_Version; | |
194 | ||
195 | exception | |
196 | when Constraint_Error => | |
3dd9959c AC |
197 | Fail ("illegal version """ |
198 | & Lib_Version | |
199 | & """ (on VMS version must be a positive number)"); | |
19f0526a AC |
200 | return ""; |
201 | end; | |
202 | end if; | |
203 | end Version_String; | |
204 | ||
6bb81bc1 VC |
205 | --------------------- |
206 | -- Local Variables -- | |
207 | --------------------- | |
208 | ||
19f0526a | 209 | Opt_File_Name : constant String := Option_File_Name; |
91b1417d | 210 | Version : constant String := Version_String; |
5c1c8a03 | 211 | For_Linker_Opt : String_Access; |
91b1417d AC |
212 | |
213 | -- Start of processing for Build_Dynamic_Library | |
19f0526a | 214 | |
fbf5a39b | 215 | begin |
5c1c8a03 AC |
216 | -- If option file name does not ends with ".opt", append "/OPTIONS" |
217 | -- to its specification for the VMS linker. | |
218 | ||
219 | if Opt_File_Name'Length > 4 | |
220 | and then | |
221 | Opt_File_Name (Opt_File_Name'Last - 3 .. Opt_File_Name'Last) = ".opt" | |
222 | then | |
223 | For_Linker_Opt := new String'("--for-linker=" & Opt_File_Name); | |
224 | else | |
225 | For_Linker_Opt := | |
226 | new String'("--for-linker=" & Opt_File_Name & "/OPTIONS"); | |
227 | end if; | |
228 | ||
af152989 | 229 | VMS_Options (VMS_Options'First) := For_Linker_Opt; |
19f0526a | 230 | |
fbf5a39b AC |
231 | for J in Inter'Range loop |
232 | To_Lower (Inter (J).all); | |
233 | end loop; | |
234 | ||
235 | -- "gnatsym" is necessary for building the option file | |
236 | ||
237 | if Gnatsym_Path = null then | |
6bb81bc1 | 238 | Gnatsym_Path := Locate_Exec_On_Path (Gnatsym_Name); |
fbf5a39b AC |
239 | |
240 | if Gnatsym_Path = null then | |
3dd9959c | 241 | Fail (Gnatsym_Name & " not found in path"); |
fbf5a39b AC |
242 | end if; |
243 | end if; | |
244 | ||
245 | -- For auto-initialization of a stand-alone library, we create | |
246 | -- a macro-assembly file and we invoke the macro-assembler. | |
247 | ||
248 | if Auto_Init then | |
249 | declare | |
bb4daba3 | 250 | Macro_File_Name : constant String := Lib_Filename & "__init.asm"; |
7324bf49 | 251 | Macro_File : File_Descriptor; |
c228a069 | 252 | Init_Proc : constant String := Init_Proc_Name (Lib_Filename); |
fbf5a39b AC |
253 | Popen_Result : System.Address; |
254 | Pclose_Result : Integer; | |
7324bf49 AC |
255 | Len : Natural; |
256 | OK : Boolean := True; | |
fbf5a39b | 257 | |
7e98a4c6 | 258 | command : constant String := |
fbf5a39b | 259 | Macro_Name & " " & Macro_File_Name & ASCII.NUL; |
7324bf49 | 260 | -- The command to invoke the assembler on the generated auto-init |
fbf5a39b AC |
261 | -- assembly file. |
262 | ||
7e98a4c6 | 263 | mode : constant String := "r" & ASCII.NUL; |
fbf5a39b AC |
264 | -- The mode for the invocation of Popen |
265 | ||
266 | begin | |
fbf5a39b AC |
267 | if Verbose_Mode then |
268 | Write_Str ("Creating auto-init assembly file """); | |
269 | Write_Str (Macro_File_Name); | |
270 | Write_Line (""""); | |
271 | end if; | |
272 | ||
7324bf49 AC |
273 | -- Create and write the auto-init assembly file |
274 | ||
275 | declare | |
ad316add DR |
276 | use ASCII; |
277 | ||
278 | -- Output a dummy transfer address for debugging | |
279 | -- followed by the LIB$INITIALIZE section. | |
280 | ||
281 | Lines : constant String := | |
282 | HT & ".text" & LF & | |
283 | HT & ".align 4" & LF & | |
284 | HT & ".globl __main" & LF & | |
285 | HT & ".ent __main" & LF & | |
286 | "__main..en:" & LF & | |
287 | HT & ".base $27" & LF & | |
288 | HT & ".frame $29,0,$26,8" & LF & | |
289 | HT & "ret $31,($26),1" & LF & | |
290 | HT & ".link" & LF & | |
291 | "__main:" & LF & | |
292 | HT & ".pdesc __main..en,null" & LF & | |
293 | HT & ".end __main" & LF & LF & | |
294 | HT & ".section LIB$INITIALIZE,GBL,NOWRT" & LF & | |
295 | HT & ".long " & Init_Proc & LF; | |
7324bf49 | 296 | |
fbf5a39b | 297 | begin |
7324bf49 AC |
298 | Macro_File := Create_File (Macro_File_Name, Text); |
299 | OK := Macro_File /= Invalid_FD; | |
300 | ||
301 | if OK then | |
302 | Len := Write | |
ad316add DR |
303 | (Macro_File, Lines (Lines'First)'Address, |
304 | Lines'Length); | |
305 | OK := Len = Lines'Length; | |
7324bf49 | 306 | end if; |
fbf5a39b | 307 | |
7324bf49 AC |
308 | if OK then |
309 | Close (Macro_File, OK); | |
310 | end if; | |
fbf5a39b | 311 | |
7324bf49 | 312 | if not OK then |
3dd9959c AC |
313 | Fail ("creation of auto-init assembly file """ |
314 | & Macro_File_Name | |
315 | & """ failed"); | |
7324bf49 | 316 | end if; |
fbf5a39b AC |
317 | end; |
318 | ||
319 | -- Invoke the macro-assembler | |
320 | ||
321 | if Verbose_Mode then | |
322 | Write_Str ("Assembling auto-init assembly file """); | |
323 | Write_Str (Macro_File_Name); | |
324 | Write_Line (""""); | |
325 | end if; | |
326 | ||
7e98a4c6 VC |
327 | Popen_Result := popen (command (command'First)'Address, |
328 | mode (mode'First)'Address); | |
fbf5a39b AC |
329 | |
330 | if Popen_Result = Null_Address then | |
3dd9959c AC |
331 | Fail ("assembly of auto-init assembly file """ |
332 | & Macro_File_Name | |
333 | & """ failed"); | |
fbf5a39b AC |
334 | end if; |
335 | ||
336 | -- Wait for the end of execution of the macro-assembler | |
337 | ||
7e98a4c6 | 338 | Pclose_Result := pclose (Popen_Result); |
fbf5a39b AC |
339 | |
340 | if Pclose_Result < 0 then | |
3dd9959c AC |
341 | Fail ("assembly of auto init assembly file """ |
342 | & Macro_File_Name | |
343 | & """ failed"); | |
fbf5a39b AC |
344 | end if; |
345 | ||
346 | -- Add the generated object file to the list of objects to be | |
347 | -- included in the library. | |
348 | ||
349 | Additional_Objects := | |
350 | new Argument_List' | |
bb4daba3 | 351 | (1 => new String'(Lib_Filename & "__init.obj")); |
fbf5a39b AC |
352 | end; |
353 | end if; | |
354 | ||
19f0526a AC |
355 | -- Allocate the argument list and put the symbol file name, the |
356 | -- reference (if any) and the policy (if not autonomous). | |
fbf5a39b | 357 | |
19f0526a | 358 | Arguments := new Argument_List (1 .. Ofiles'Length + 8); |
fbf5a39b | 359 | |
19f0526a AC |
360 | Last_Argument := 0; |
361 | ||
362 | -- Verbosity | |
fbf5a39b AC |
363 | |
364 | if Verbose_Mode then | |
19f0526a | 365 | Last_Argument := Last_Argument + 1; |
fbf5a39b | 366 | Arguments (Last_Argument) := new String'("-v"); |
19f0526a AC |
367 | end if; |
368 | ||
369 | -- Version number (major ID) | |
370 | ||
371 | if Lib_Version /= "" then | |
372 | Last_Argument := Last_Argument + 1; | |
373 | Arguments (Last_Argument) := new String'("-V"); | |
fbf5a39b | 374 | Last_Argument := Last_Argument + 1; |
19f0526a | 375 | Arguments (Last_Argument) := new String'(Version); |
fbf5a39b AC |
376 | end if; |
377 | ||
19f0526a AC |
378 | -- Symbol file |
379 | ||
380 | Last_Argument := Last_Argument + 1; | |
381 | Arguments (Last_Argument) := new String'("-s"); | |
382 | Last_Argument := Last_Argument + 1; | |
fbf5a39b AC |
383 | Arguments (Last_Argument) := new String'(Opt_File_Name); |
384 | ||
19f0526a AC |
385 | -- Reference Symbol File |
386 | ||
2cd44f5a | 387 | if Symbol_Data.Reference /= No_Path then |
19f0526a AC |
388 | Last_Argument := Last_Argument + 1; |
389 | Arguments (Last_Argument) := new String'("-r"); | |
390 | Last_Argument := Last_Argument + 1; | |
391 | Arguments (Last_Argument) := | |
392 | new String'(Get_Name_String (Symbol_Data.Reference)); | |
393 | end if; | |
394 | ||
395 | -- Policy | |
396 | ||
397 | case Symbol_Data.Symbol_Policy is | |
398 | when Autonomous => | |
399 | null; | |
400 | ||
401 | when Compliant => | |
402 | Last_Argument := Last_Argument + 1; | |
403 | Arguments (Last_Argument) := new String'("-c"); | |
404 | ||
405 | when Controlled => | |
406 | Last_Argument := Last_Argument + 1; | |
407 | Arguments (Last_Argument) := new String'("-C"); | |
5453d5bd AC |
408 | |
409 | when Restricted => | |
410 | Last_Argument := Last_Argument + 1; | |
411 | Arguments (Last_Argument) := new String'("-R"); | |
6bb81bc1 VC |
412 | |
413 | when Direct => | |
414 | Last_Argument := Last_Argument + 1; | |
415 | Arguments (Last_Argument) := new String'("-D"); | |
416 | ||
19f0526a AC |
417 | end case; |
418 | ||
fbf5a39b AC |
419 | -- Add each relevant object file |
420 | ||
421 | for Index in Ofiles'Range loop | |
422 | if Is_Interface (Ofiles (Index).all) then | |
423 | Last_Argument := Last_Argument + 1; | |
424 | Arguments (Last_Argument) := new String'(Ofiles (Index).all); | |
425 | end if; | |
426 | end loop; | |
427 | ||
428 | -- Spawn gnatsym | |
429 | ||
430 | Spawn (Program_Name => Gnatsym_Path.all, | |
431 | Args => Arguments (1 .. Last_Argument), | |
432 | Success => Success); | |
433 | ||
434 | if not Success then | |
3dd9959c AC |
435 | Fail ("unable to create symbol file for library """ |
436 | & Lib_Filename | |
437 | & """"); | |
fbf5a39b AC |
438 | end if; |
439 | ||
440 | Free (Arguments); | |
441 | ||
442 | -- Move all the -l switches from Opts to Opts2 | |
443 | ||
444 | declare | |
445 | Index : Natural := Opts'First; | |
446 | Opt : String_Access; | |
91b1417d | 447 | |
fbf5a39b AC |
448 | begin |
449 | while Index <= Last_Opt loop | |
450 | Opt := Opts (Index); | |
451 | ||
452 | if Opt'Length > 2 and then | |
453 | Opt (Opt'First .. Opt'First + 1) = "-l" | |
454 | then | |
455 | if Index < Last_Opt then | |
456 | Opts (Index .. Last_Opt - 1) := | |
457 | Opts (Index + 1 .. Last_Opt); | |
458 | end if; | |
459 | ||
460 | Last_Opt := Last_Opt - 1; | |
461 | ||
462 | Last_Opt2 := Last_Opt2 + 1; | |
463 | Opts2 (Last_Opt2) := Opt; | |
464 | ||
465 | else | |
466 | Index := Index + 1; | |
467 | end if; | |
468 | end loop; | |
469 | end; | |
470 | ||
471 | -- Invoke gcc to build the library | |
472 | ||
473 | Utl.Gcc | |
474 | (Output_File => Lib_File, | |
475 | Objects => Ofiles & Additional_Objects.all, | |
476 | Options => VMS_Options, | |
6bb81bc1 | 477 | Options_2 => Shared_Libgcc_Switch & |
b7e429ab | 478 | Opts (Opts'First .. Last_Opt) & |
2cd44f5a | 479 | Opts2 (Opts2'First .. Last_Opt2), |
fbf5a39b AC |
480 | Driver_Name => Driver_Name); |
481 | ||
482 | -- The auto-init object file need to be deleted, so that it will not | |
483 | -- be included in the library as a regular object file, otherwise | |
484 | -- it will be included twice when the library will be built next | |
485 | -- time, which may lead to errors. | |
486 | ||
487 | if Auto_Init then | |
488 | declare | |
489 | Auto_Init_Object_File_Name : constant String := | |
bb4daba3 | 490 | Lib_Filename & "__init.obj"; |
fbf5a39b AC |
491 | Disregard : Boolean; |
492 | ||
493 | begin | |
494 | if Verbose_Mode then | |
495 | Write_Str ("deleting auto-init object file """); | |
496 | Write_Str (Auto_Init_Object_File_Name); | |
497 | Write_Line (""""); | |
498 | end if; | |
499 | ||
500 | Delete_File (Auto_Init_Object_File_Name, Success => Disregard); | |
501 | end; | |
502 | end if; | |
503 | end Build_Dynamic_Library; | |
504 | ||
6bb81bc1 | 505 | -- Package initialization |
fbf5a39b | 506 | |
6bb81bc1 VC |
507 | begin |
508 | Build_Dynamic_Library_Ptr := Build_Dynamic_Library'Access; | |
509 | end MLib.Tgt.Specific; |