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-2007, 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 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 is the Alpha VMS version of the body
30 with Ada.Characters.Handling; use Ada.Characters.Handling;
36 pragma Warnings (Off, MLib.Tgt.VMS);
37 -- MLib.Tgt.VMS is with'ed only for elaboration purposes
40 with Output; use Output;
42 with GNAT.Directory_Operations; use GNAT.Directory_Operations;
44 with System; use System;
45 with System.Case_Util; use System.Case_Util;
46 with System.CRTL; use System.CRTL;
48 package body MLib.Tgt.Specific is
50 -- Non default subprogram. See comment in mlib-tgt.ads.
52 procedure Build_Dynamic_Library
53 (Ofiles : Argument_List;
54 Foreign : Argument_List;
55 Afiles : Argument_List;
56 Options : Argument_List;
57 Options_2 : Argument_List;
58 Interfaces : Argument_List;
59 Lib_Filename : String;
61 Symbol_Data : Symbol_Record;
62 Driver_Name : Name_Id := No_Name;
63 Lib_Version : String := "";
64 Auto_Init : Boolean := False);
68 Empty_Argument_List : aliased Argument_List := (1 .. 0 => null);
69 Additional_Objects : Argument_List_Access := Empty_Argument_List'Access;
70 -- Used to add the generated auto-init object files for auto-initializing
71 -- stand-alone libraries.
73 Macro_Name : constant String := "mcr gnu:[bin]gcc -c -x assembler";
74 -- The name of the command to invoke the macro-assembler
76 VMS_Options : Argument_List := (1 .. 1 => null);
78 Gnatsym_Name : constant String := "gnatsym";
80 Gnatsym_Path : String_Access;
82 Arguments : Argument_List_Access := null;
83 Last_Argument : Natural := 0;
85 Success : Boolean := False;
87 Shared_Libgcc : aliased String := "-shared-libgcc";
89 Shared_Libgcc_Switch : constant Argument_List :=
90 (1 => Shared_Libgcc'Access);
92 ---------------------------
93 -- Build_Dynamic_Library --
94 ---------------------------
96 procedure Build_Dynamic_Library
97 (Ofiles : Argument_List;
98 Foreign : Argument_List;
99 Afiles : Argument_List;
100 Options : Argument_List;
101 Options_2 : Argument_List;
102 Interfaces : Argument_List;
103 Lib_Filename : String;
105 Symbol_Data : Symbol_Record;
106 Driver_Name : Name_Id := No_Name;
107 Lib_Version : String := "";
108 Auto_Init : Boolean := False)
110 pragma Unreferenced (Foreign);
111 pragma Unreferenced (Afiles);
113 Lib_File : constant String :=
114 Lib_Dir & Directory_Separator & "lib" &
115 Fil.Ext_To (Lib_Filename, DLL_Ext);
117 Opts : Argument_List := Options;
118 Last_Opt : Natural := Opts'Last;
119 Opts2 : Argument_List (Options'Range);
120 Last_Opt2 : Natural := Opts2'First - 1;
122 Inter : constant Argument_List := Interfaces;
124 function Is_Interface (Obj_File : String) return Boolean;
125 -- For a Stand-Alone Library, returns True if Obj_File is the object
126 -- file name of an interface of the SAL. For other libraries, always
129 function Option_File_Name return String;
130 -- Returns Symbol_File, if not empty. Otherwise, returns "symvec.opt"
132 function Version_String return String;
133 -- Returns Lib_Version if not empty and if Symbol_Data.Symbol_Policy is
134 -- not Autonomous, otherwise returns "". When Symbol_Data.Symbol_Policy
135 -- is Autonomous, fails gnatmake if Lib_Version is not the image of a
142 function Is_Interface (Obj_File : String) return Boolean is
143 ALI : constant String :=
145 (Filename => To_Lower (Base_Name (Obj_File)),
149 if Inter'Length = 0 then
152 elsif ALI'Length > 2 and then
153 ALI (ALI'First .. ALI'First + 2) = "b__"
158 for J in Inter'Range loop
159 if Inter (J).all = ALI then
168 ----------------------
169 -- Option_File_Name --
170 ----------------------
172 function Option_File_Name return String is
174 if Symbol_Data.Symbol_File = No_Name then
177 Get_Name_String (Symbol_Data.Symbol_File);
178 To_Lower (Name_Buffer (1 .. Name_Len));
179 return Name_Buffer (1 .. Name_Len);
181 end Option_File_Name;
187 function Version_String return String is
188 Version : Integer := 0;
192 or else Symbol_Data.Symbol_Policy /= Autonomous
198 Version := Integer'Value (Lib_Version);
201 raise Constraint_Error;
207 when Constraint_Error =>
208 Fail ("illegal version """, Lib_Version,
209 """ (on VMS version must be a positive number)");
215 ---------------------
216 -- Local Variables --
217 ---------------------
219 Opt_File_Name : constant String := Option_File_Name;
220 Version : constant String := Version_String;
221 For_Linker_Opt : String_Access;
223 -- Start of processing for Build_Dynamic_Library
226 -- If option file name does not ends with ".opt", append "/OPTIONS"
227 -- to its specification for the VMS linker.
229 if Opt_File_Name'Length > 4
231 Opt_File_Name (Opt_File_Name'Last - 3 .. Opt_File_Name'Last) = ".opt"
233 For_Linker_Opt := new String'("--for-linker=" & Opt_File_Name);
236 new String'("--for-linker=" & Opt_File_Name & "/OPTIONS");
239 VMS_Options (VMS_Options'First) := For_Linker_Opt;
241 for J in Inter'Range loop
242 To_Lower (Inter (J).all);
245 -- "gnatsym" is necessary for building the option file
247 if Gnatsym_Path = null then
248 Gnatsym_Path := Locate_Exec_On_Path (Gnatsym_Name);
250 if Gnatsym_Path = null then
251 Fail (Gnatsym_Name, " not found in path");
255 -- For auto-initialization of a stand-alone library, we create
256 -- a macro-assembly file and we invoke the macro-assembler.
260 Macro_File_Name : constant String := Lib_Filename & "__init.asm";
261 Macro_File : File_Descriptor;
262 Init_Proc : String := Lib_Filename & "INIT";
263 Popen_Result : System.Address;
264 Pclose_Result : Integer;
266 OK : Boolean := True;
268 command : constant String :=
269 Macro_Name & " " & Macro_File_Name & ASCII.NUL;
270 -- The command to invoke the assembler on the generated auto-init
273 mode : constant String := "r" & ASCII.NUL;
274 -- The mode for the invocation of Popen
277 To_Upper (Init_Proc);
280 Write_Str ("Creating auto-init assembly file """);
281 Write_Str (Macro_File_Name);
285 -- Create and write the auto-init assembly file
288 First_Line : constant String :=
289 ASCII.HT & ".section LIB$INITIALIZE,GBL,NOWRT" &
291 Second_Line : constant String :=
292 ASCII.HT & ".long " & Init_Proc & ASCII.LF;
293 -- First and second lines of the auto-init assembly file
296 Macro_File := Create_File (Macro_File_Name, Text);
297 OK := Macro_File /= Invalid_FD;
301 (Macro_File, First_Line (First_Line'First)'Address,
303 OK := Len = First_Line'Length;
308 (Macro_File, Second_Line (Second_Line'First)'Address,
310 OK := Len = Second_Line'Length;
314 Close (Macro_File, OK);
318 Fail ("creation of auto-init assembly file """,
319 Macro_File_Name, """ failed");
323 -- Invoke the macro-assembler
326 Write_Str ("Assembling auto-init assembly file """);
327 Write_Str (Macro_File_Name);
331 Popen_Result := popen (command (command'First)'Address,
332 mode (mode'First)'Address);
334 if Popen_Result = Null_Address then
335 Fail ("assembly of auto-init assembly file """,
336 Macro_File_Name, """ failed");
339 -- Wait for the end of execution of the macro-assembler
341 Pclose_Result := pclose (Popen_Result);
343 if Pclose_Result < 0 then
344 Fail ("assembly of auto init assembly file """,
345 Macro_File_Name, """ failed");
348 -- Add the generated object file to the list of objects to be
349 -- included in the library.
351 Additional_Objects :=
353 (1 => new String'(Lib_Filename & "__init.obj"));
357 -- Allocate the argument list and put the symbol file name, the
358 -- reference (if any) and the policy (if not autonomous).
360 Arguments := new Argument_List (1 .. Ofiles'Length + 8);
367 Last_Argument := Last_Argument + 1;
368 Arguments (Last_Argument) := new String'("-v");
371 -- Version number (major ID)
373 if Lib_Version /= "" then
374 Last_Argument := Last_Argument + 1;
375 Arguments (Last_Argument) := new String'("-V");
376 Last_Argument := Last_Argument + 1;
377 Arguments (Last_Argument) := new String'(Version);
382 Last_Argument := Last_Argument + 1;
383 Arguments (Last_Argument) := new String'("-s");
384 Last_Argument := Last_Argument + 1;
385 Arguments (Last_Argument) := new String'(Opt_File_Name);
387 -- Reference Symbol File
389 if Symbol_Data.Reference /= No_Name then
390 Last_Argument := Last_Argument + 1;
391 Arguments (Last_Argument) := new String'("-r");
392 Last_Argument := Last_Argument + 1;
393 Arguments (Last_Argument) :=
394 new String'(Get_Name_String (Symbol_Data.Reference));
399 case Symbol_Data.Symbol_Policy is
404 Last_Argument := Last_Argument + 1;
405 Arguments (Last_Argument) := new String'("-c");
408 Last_Argument := Last_Argument + 1;
409 Arguments (Last_Argument) := new String'("-C");
412 Last_Argument := Last_Argument + 1;
413 Arguments (Last_Argument) := new String'("-R");
416 Last_Argument := Last_Argument + 1;
417 Arguments (Last_Argument) := new String'("-D");
421 -- Add each relevant object file
423 for Index in Ofiles'Range loop
424 if Is_Interface (Ofiles (Index).all) then
425 Last_Argument := Last_Argument + 1;
426 Arguments (Last_Argument) := new String'(Ofiles (Index).all);
432 Spawn (Program_Name => Gnatsym_Path.all,
433 Args => Arguments (1 .. Last_Argument),
437 Fail ("unable to create symbol file for library """,
443 -- Move all the -l switches from Opts to Opts2
446 Index : Natural := Opts'First;
450 while Index <= Last_Opt loop
453 if Opt'Length > 2 and then
454 Opt (Opt'First .. Opt'First + 1) = "-l"
456 if Index < Last_Opt then
457 Opts (Index .. Last_Opt - 1) :=
458 Opts (Index + 1 .. Last_Opt);
461 Last_Opt := Last_Opt - 1;
463 Last_Opt2 := Last_Opt2 + 1;
464 Opts2 (Last_Opt2) := Opt;
472 -- Invoke gcc to build the library
475 (Output_File => Lib_File,
476 Objects => Ofiles & Additional_Objects.all,
477 Options => VMS_Options,
478 Options_2 => Shared_Libgcc_Switch &
479 Opts (Opts'First .. Last_Opt) &
480 Opts2 (Opts2'First .. Last_Opt2) & Options_2,
481 Driver_Name => Driver_Name);
483 -- The auto-init object file need to be deleted, so that it will not
484 -- be included in the library as a regular object file, otherwise
485 -- it will be included twice when the library will be built next
486 -- time, which may lead to errors.
490 Auto_Init_Object_File_Name : constant String :=
491 Lib_Filename & "__init.obj";
496 Write_Str ("deleting auto-init object file """);
497 Write_Str (Auto_Init_Object_File_Name);
501 Delete_File (Auto_Init_Object_File_Name, Success => Disregard);
504 end Build_Dynamic_Library;
506 -- Package initialization
509 Build_Dynamic_Library_Ptr := Build_Dynamic_Library'Access;
510 end MLib.Tgt.Specific;