1 ------------------------------------------------------------------------------
3 -- GNAT COMPILER COMPONENTS --
5 -- M L I B . T G T . S P E C I F I C --
6 -- (Alpha VMS Version) --
10 -- Copyright (C) 2003-2008, Free Software Foundation, 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 3, 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 COPYING3. If not, go to --
20 -- http://www.gnu.org/licenses for a complete copy of the license. --
22 -- GNAT was originally developed by the GNAT team at New York University. --
23 -- Extensive contributions were provided by Ada Core Technologies Inc. --
25 ------------------------------------------------------------------------------
27 -- This is the Alpha VMS version of the body
29 with Ada
.Characters
.Handling
; use Ada
.Characters
.Handling
;
34 with MLib
.Tgt
.VMS_Common
;
35 pragma Warnings
(Off
, MLib
.Tgt
.VMS_Common
);
36 -- MLib.Tgt.VMS_Common is with'ed only for elaboration purposes
39 with Output
; use Output
;
41 with GNAT
.Directory_Operations
; use GNAT
.Directory_Operations
;
43 with System
; use System
;
44 with System
.Case_Util
; use System
.Case_Util
;
45 with System
.CRTL
; use System
.CRTL
;
47 package body MLib
.Tgt
.Specific
is
49 -- Non default subprogram. See comment in mlib-tgt.ads.
51 procedure Build_Dynamic_Library
52 (Ofiles
: Argument_List
;
53 Options
: Argument_List
;
54 Interfaces
: Argument_List
;
55 Lib_Filename
: String;
57 Symbol_Data
: Symbol_Record
;
58 Driver_Name
: Name_Id
:= No_Name
;
59 Lib_Version
: String := "";
60 Auto_Init
: Boolean := False);
64 Empty_Argument_List
: aliased Argument_List
:= (1 .. 0 => null);
65 Additional_Objects
: Argument_List_Access
:= Empty_Argument_List
'Access;
66 -- Used to add the generated auto-init object files for auto-initializing
67 -- stand-alone libraries.
69 Macro_Name
: constant String := "mcr gnu:[bin]gcc -c -x assembler";
70 -- The name of the command to invoke the macro-assembler
72 VMS_Options
: Argument_List
:= (1 .. 1 => null);
74 Gnatsym_Name
: constant String := "gnatsym";
76 Gnatsym_Path
: String_Access
;
78 Arguments
: Argument_List_Access
:= null;
79 Last_Argument
: Natural := 0;
81 Success
: Boolean := False;
83 Shared_Libgcc
: aliased String := "-shared-libgcc";
85 Shared_Libgcc_Switch
: constant Argument_List
:=
86 (1 => Shared_Libgcc
'Access);
88 ---------------------------
89 -- Build_Dynamic_Library --
90 ---------------------------
92 procedure Build_Dynamic_Library
93 (Ofiles
: Argument_List
;
94 Options
: Argument_List
;
95 Interfaces
: Argument_List
;
96 Lib_Filename
: String;
98 Symbol_Data
: Symbol_Record
;
99 Driver_Name
: Name_Id
:= No_Name
;
100 Lib_Version
: String := "";
101 Auto_Init
: Boolean := False)
104 Lib_File
: constant String :=
105 Lib_Dir
& Directory_Separator
& "lib" &
106 Fil
.Ext_To
(Lib_Filename
, DLL_Ext
);
108 Opts
: Argument_List
:= Options
;
109 Last_Opt
: Natural := Opts
'Last;
110 Opts2
: Argument_List
(Options
'Range);
111 Last_Opt2
: Natural := Opts2
'First - 1;
113 Inter
: constant Argument_List
:= Interfaces
;
115 function Is_Interface
(Obj_File
: String) return Boolean;
116 -- For a Stand-Alone Library, returns True if Obj_File is the object
117 -- file name of an interface of the SAL. For other libraries, always
120 function Option_File_Name
return String;
121 -- Returns Symbol_File, if not empty. Otherwise, returns "symvec.opt"
123 function Version_String
return String;
124 -- Returns Lib_Version if not empty and if Symbol_Data.Symbol_Policy is
125 -- not Autonomous, otherwise returns "". When Symbol_Data.Symbol_Policy
126 -- is Autonomous, fails gnatmake if Lib_Version is not the image of a
133 function Is_Interface
(Obj_File
: String) return Boolean is
134 ALI
: constant String :=
136 (Filename
=> To_Lower
(Base_Name
(Obj_File
)),
140 if Inter
'Length = 0 then
143 elsif ALI
'Length > 2 and then
144 ALI
(ALI
'First .. ALI
'First + 2) = "b__"
149 for J
in Inter
'Range loop
150 if Inter
(J
).all = ALI
then
159 ----------------------
160 -- Option_File_Name --
161 ----------------------
163 function Option_File_Name
return String is
165 if Symbol_Data
.Symbol_File
= No_Path
then
168 Get_Name_String
(Symbol_Data
.Symbol_File
);
169 To_Lower
(Name_Buffer
(1 .. Name_Len
));
170 return Name_Buffer
(1 .. Name_Len
);
172 end Option_File_Name
;
178 function Version_String
return String is
179 Version
: Integer := 0;
183 or else Symbol_Data
.Symbol_Policy
/= Autonomous
189 Version
:= Integer'Value (Lib_Version
);
192 raise Constraint_Error
;
198 when Constraint_Error
=>
199 Fail
("illegal version """, Lib_Version
,
200 """ (on VMS version must be a positive number)");
206 ---------------------
207 -- Local Variables --
208 ---------------------
210 Opt_File_Name
: constant String := Option_File_Name
;
211 Version
: constant String := Version_String
;
212 For_Linker_Opt
: String_Access
;
214 -- Start of processing for Build_Dynamic_Library
217 -- If option file name does not ends with ".opt", append "/OPTIONS"
218 -- to its specification for the VMS linker.
220 if Opt_File_Name
'Length > 4
222 Opt_File_Name
(Opt_File_Name
'Last - 3 .. Opt_File_Name
'Last) = ".opt"
224 For_Linker_Opt
:= new String'("--for-linker=" & Opt_File_Name);
227 new String'("--for-linker=" & Opt_File_Name
& "/OPTIONS");
230 VMS_Options
(VMS_Options
'First) := For_Linker_Opt
;
232 for J
in Inter
'Range loop
233 To_Lower
(Inter
(J
).all);
236 -- "gnatsym" is necessary for building the option file
238 if Gnatsym_Path
= null then
239 Gnatsym_Path
:= Locate_Exec_On_Path
(Gnatsym_Name
);
241 if Gnatsym_Path
= null then
242 Fail
(Gnatsym_Name
, " not found in path");
246 -- For auto-initialization of a stand-alone library, we create
247 -- a macro-assembly file and we invoke the macro-assembler.
251 Macro_File_Name
: constant String := Lib_Filename
& "__init.asm";
252 Macro_File
: File_Descriptor
;
253 Init_Proc
: String := Lib_Filename
& "INIT";
254 Popen_Result
: System
.Address
;
255 Pclose_Result
: Integer;
257 OK
: Boolean := True;
259 command
: constant String :=
260 Macro_Name
& " " & Macro_File_Name
& ASCII
.NUL
;
261 -- The command to invoke the assembler on the generated auto-init
264 mode
: constant String := "r" & ASCII
.NUL
;
265 -- The mode for the invocation of Popen
268 To_Upper
(Init_Proc
);
271 Write_Str
("Creating auto-init assembly file """);
272 Write_Str
(Macro_File_Name
);
276 -- Create and write the auto-init assembly file
279 First_Line
: constant String :=
280 ASCII
.HT
& ".section LIB$INITIALIZE,GBL,NOWRT" &
282 Second_Line
: constant String :=
283 ASCII
.HT
& ".long " & Init_Proc
& ASCII
.LF
;
284 -- First and second lines of the auto-init assembly file
287 Macro_File
:= Create_File
(Macro_File_Name
, Text
);
288 OK
:= Macro_File
/= Invalid_FD
;
292 (Macro_File
, First_Line
(First_Line
'First)'Address,
294 OK
:= Len
= First_Line
'Length;
299 (Macro_File
, Second_Line
(Second_Line
'First)'Address,
301 OK
:= Len
= Second_Line
'Length;
305 Close
(Macro_File
, OK
);
309 Fail
("creation of auto-init assembly file """,
310 Macro_File_Name
, """ failed");
314 -- Invoke the macro-assembler
317 Write_Str
("Assembling auto-init assembly file """);
318 Write_Str
(Macro_File_Name
);
322 Popen_Result
:= popen
(command
(command
'First)'Address,
323 mode
(mode
'First)'Address);
325 if Popen_Result
= Null_Address
then
326 Fail
("assembly of auto-init assembly file """,
327 Macro_File_Name
, """ failed");
330 -- Wait for the end of execution of the macro-assembler
332 Pclose_Result
:= pclose
(Popen_Result
);
334 if Pclose_Result
< 0 then
335 Fail
("assembly of auto init assembly file """,
336 Macro_File_Name
, """ failed");
339 -- Add the generated object file to the list of objects to be
340 -- included in the library.
342 Additional_Objects
:=
344 (1 => new String'(Lib_Filename
& "__init.obj"));
348 -- Allocate the argument list and put the symbol file name, the
349 -- reference (if any) and the policy (if not autonomous).
351 Arguments
:= new Argument_List
(1 .. Ofiles
'Length + 8);
358 Last_Argument
:= Last_Argument
+ 1;
359 Arguments
(Last_Argument
) := new String'("-v");
362 -- Version number (major ID)
364 if Lib_Version /= "" then
365 Last_Argument := Last_Argument + 1;
366 Arguments (Last_Argument) := new String'("-V");
367 Last_Argument
:= Last_Argument
+ 1;
368 Arguments
(Last_Argument
) := new String'(Version);
373 Last_Argument := Last_Argument + 1;
374 Arguments (Last_Argument) := new String'("-s");
375 Last_Argument
:= Last_Argument
+ 1;
376 Arguments
(Last_Argument
) := new String'(Opt_File_Name);
378 -- Reference Symbol File
380 if Symbol_Data.Reference /= No_Path then
381 Last_Argument := Last_Argument + 1;
382 Arguments (Last_Argument) := new String'("-r");
383 Last_Argument
:= Last_Argument
+ 1;
384 Arguments
(Last_Argument
) :=
385 new String'(Get_Name_String (Symbol_Data.Reference));
390 case Symbol_Data.Symbol_Policy is
395 Last_Argument := Last_Argument + 1;
396 Arguments (Last_Argument) := new String'("-c");
399 Last_Argument
:= Last_Argument
+ 1;
400 Arguments
(Last_Argument
) := new String'("-C");
403 Last_Argument := Last_Argument + 1;
404 Arguments (Last_Argument) := new String'("-R");
407 Last_Argument
:= Last_Argument
+ 1;
408 Arguments
(Last_Argument
) := new String'("-D");
412 -- Add each relevant object file
414 for Index in Ofiles'Range loop
415 if Is_Interface (Ofiles (Index).all) then
416 Last_Argument := Last_Argument + 1;
417 Arguments (Last_Argument) := new String'(Ofiles
(Index
).all);
423 Spawn
(Program_Name
=> Gnatsym_Path
.all,
424 Args
=> Arguments
(1 .. Last_Argument
),
428 Fail
("unable to create symbol file for library """,
434 -- Move all the -l switches from Opts to Opts2
437 Index
: Natural := Opts
'First;
441 while Index
<= Last_Opt
loop
444 if Opt
'Length > 2 and then
445 Opt
(Opt
'First .. Opt
'First + 1) = "-l"
447 if Index
< Last_Opt
then
448 Opts
(Index
.. Last_Opt
- 1) :=
449 Opts
(Index
+ 1 .. Last_Opt
);
452 Last_Opt
:= Last_Opt
- 1;
454 Last_Opt2
:= Last_Opt2
+ 1;
455 Opts2
(Last_Opt2
) := Opt
;
463 -- Invoke gcc to build the library
466 (Output_File
=> Lib_File
,
467 Objects
=> Ofiles
& Additional_Objects
.all,
468 Options
=> VMS_Options
,
469 Options_2
=> Shared_Libgcc_Switch
&
470 Opts
(Opts
'First .. Last_Opt
) &
471 Opts2
(Opts2
'First .. Last_Opt2
),
472 Driver_Name
=> Driver_Name
);
474 -- The auto-init object file need to be deleted, so that it will not
475 -- be included in the library as a regular object file, otherwise
476 -- it will be included twice when the library will be built next
477 -- time, which may lead to errors.
481 Auto_Init_Object_File_Name
: constant String :=
482 Lib_Filename
& "__init.obj";
487 Write_Str
("deleting auto-init object file """);
488 Write_Str
(Auto_Init_Object_File_Name
);
492 Delete_File
(Auto_Init_Object_File_Name
, Success
=> Disregard
);
495 end Build_Dynamic_Library
;
497 -- Package initialization
500 Build_Dynamic_Library_Ptr
:= Build_Dynamic_Library
'Access;
501 end MLib
.Tgt
.Specific
;