1 ------------------------------------------------------------------------------
3 -- GNAT COMPILER COMPONENTS --
6 -- (Integrity VMS Version) --
10 -- Copyright (C) 2004, 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, 59 Temple Place - Suite 330, Boston, --
21 -- MA 02111-1307, 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 Integrity VMS version of the body
30 with Ada.Characters.Handling; use Ada.Characters.Handling;
32 with GNAT.Directory_Operations; use GNAT.Directory_Operations;
33 with GNAT.OS_Lib; use GNAT.OS_Lib;
37 with Namet; use Namet;
39 with Output; use Output;
41 with System; use System;
42 with System.Case_Util; use System.Case_Util;
44 package body MLib.Tgt is
48 Empty_Argument_List : aliased Argument_List := (1 .. 0 => null);
49 Additional_Objects : Argument_List_Access := Empty_Argument_List'Access;
50 -- Used to add the generated auto-init object files for auto-initializing
51 -- stand-alone libraries.
53 Macro_Name : constant String := "mcr gnu:[bin]gcc -c -x assembler";
54 -- The name of the command to invoke the macro-assembler
56 VMS_Options : Argument_List := (1 .. 1 => null);
58 Gnatsym_Name : constant String := "gnatsym";
60 Gnatsym_Path : String_Access;
62 Arguments : Argument_List_Access := null;
63 Last_Argument : Natural := 0;
65 Success : Boolean := False;
67 Shared_Libgcc : aliased String := "-shared-libgcc";
69 No_Shared_Libgcc_Switch : aliased Argument_List := (1 .. 0 => null);
70 Shared_Libgcc_Switch : aliased Argument_List :=
71 (1 => Shared_Libgcc'Access);
72 Link_With_Shared_Libgcc : Argument_List_Access :=
73 No_Shared_Libgcc_Switch'Access;
75 ------------------------------
76 -- Target dependent section --
77 ------------------------------
79 function Popen (Command, Mode : System.Address) return System.Address;
80 pragma Import (C, Popen);
82 function Pclose (File : System.Address) return Integer;
83 pragma Import (C, Pclose);
89 function Archive_Builder return String is
94 -----------------------------
95 -- Archive_Builder_Options --
96 -----------------------------
98 function Archive_Builder_Options return String_List_Access is
100 return new String_List'(1 => new String'("cr"));
101 end Archive_Builder_Options;
107 function Archive_Ext return String is
112 ---------------------
113 -- Archive_Indexer --
114 ---------------------
116 function Archive_Indexer return String is
121 ---------------------------
122 -- Build_Dynamic_Library --
123 ---------------------------
125 procedure Build_Dynamic_Library
126 (Ofiles : Argument_List;
127 Foreign : Argument_List;
128 Afiles : Argument_List;
129 Options : Argument_List;
130 Interfaces : Argument_List;
131 Lib_Filename : String;
133 Symbol_Data : Symbol_Record;
134 Driver_Name : Name_Id := No_Name;
135 Lib_Version : String := "";
136 Auto_Init : Boolean := False)
138 pragma Unreferenced (Foreign);
139 pragma Unreferenced (Afiles);
141 Lib_File : constant String :=
142 Lib_Dir & Directory_Separator & "lib" &
143 Fil.Ext_To (Lib_Filename, DLL_Ext);
145 Opts : Argument_List := Options;
146 Last_Opt : Natural := Opts'Last;
147 Opts2 : Argument_List (Options'Range);
148 Last_Opt2 : Natural := Opts2'First - 1;
150 Inter : constant Argument_List := Interfaces;
152 function Is_Interface (Obj_File : String) return Boolean;
153 -- For a Stand-Alone Library, returns True if Obj_File is the object
154 -- file name of an interface of the SAL. For other libraries, always
157 function Option_File_Name return String;
158 -- Returns Symbol_File, if not empty. Otherwise, returns "symvec.opt"
160 function Version_String return String;
161 -- Returns Lib_Version if not empty, otherwise returns "1".
162 -- Fails gnatmake if Lib_Version is not the image of a positive number.
168 function Is_Interface (Obj_File : String) return Boolean is
169 ALI : constant String :=
171 (Filename => To_Lower (Base_Name (Obj_File)),
175 if Inter'Length = 0 then
178 elsif ALI'Length > 2 and then
179 ALI (ALI'First .. ALI'First + 1) = "b$"
184 for J in Inter'Range loop
185 if Inter (J).all = ALI then
194 ----------------------
195 -- Option_File_Name --
196 ----------------------
198 function Option_File_Name return String is
200 if Symbol_Data.Symbol_File = No_Name then
203 Get_Name_String (Symbol_Data.Symbol_File);
204 To_Lower (Name_Buffer (1 .. Name_Len));
205 return Name_Buffer (1 .. Name_Len);
207 end Option_File_Name;
213 function Version_String return String is
214 Version : Integer := 0;
216 if Lib_Version = "" then
221 Version := Integer'Value (Lib_Version);
224 raise Constraint_Error;
230 when Constraint_Error =>
231 Fail ("illegal version """, Lib_Version,
232 """ (on VMS version must be a positive number)");
238 Opt_File_Name : constant String := Option_File_Name;
239 Version : constant String := Version_String;
240 For_Linker_Opt : String_Access;
242 -- Start of processing for Build_Dynamic_Library
245 -- Invoke gcc with -shared-libgcc, but only for GCC 3 or higher
247 if GCC_Version >= 3 then
248 Link_With_Shared_Libgcc := Shared_Libgcc_Switch'Access;
250 Link_With_Shared_Libgcc := No_Shared_Libgcc_Switch'Access;
253 -- Option file must end with ".opt"
255 if Opt_File_Name'Length > 4
257 Opt_File_Name (Opt_File_Name'Last - 3 .. Opt_File_Name'Last) = ".opt"
259 For_Linker_Opt := new String'("--for-linker=" & Opt_File_Name);
261 Fail ("Options File """, Opt_File_Name, """ must end with .opt");
264 VMS_Options (VMS_Options'First) := For_Linker_Opt;
266 for J in Inter'Range loop
267 To_Lower (Inter (J).all);
270 -- "gnatsym" is necessary for building the option file
272 if Gnatsym_Path = null then
273 Gnatsym_Path := OS_Lib.Locate_Exec_On_Path (Gnatsym_Name);
275 if Gnatsym_Path = null then
276 Fail (Gnatsym_Name, " not found in path");
280 -- For auto-initialization of a stand-alone library, we create
281 -- a macro-assembly file and we invoke the macro-assembler.
285 Macro_File_Name : constant String := Lib_Filename & "$init.asm";
286 Macro_File : File_Descriptor;
287 Init_Proc : String := Lib_Filename & "INIT";
288 Popen_Result : System.Address;
289 Pclose_Result : Integer;
291 OK : Boolean := True;
293 Command : constant String :=
294 Macro_Name & " " & Macro_File_Name & ASCII.NUL;
295 -- The command to invoke the assembler on the generated auto-init
298 Mode : constant String := "r" & ASCII.NUL;
299 -- The mode for the invocation of Popen
302 To_Upper (Init_Proc);
305 Write_Str ("Creating auto-init assembly file """);
306 Write_Str (Macro_File_Name);
310 -- Create and write the auto-init assembly file
313 First_Line : constant String :=
315 ".type " & Init_Proc & "#, @function" &
317 Second_Line : constant String :=
319 ".global " & Init_Proc & "#" &
321 Third_Line : constant String :=
323 ".global LIB$INITIALIZE#" &
325 Fourth_Line : constant String :=
327 ".section LIB$INITIALIZE#,""a"",@progbits" &
329 Fifth_Line : constant String :=
331 "data4 @fptr(" & Init_Proc & "#)" &
335 Macro_File := Create_File (Macro_File_Name, Text);
336 OK := Macro_File /= Invalid_FD;
340 (Macro_File, First_Line (First_Line'First)'Address,
342 OK := Len = First_Line'Length;
347 (Macro_File, Second_Line (Second_Line'First)'Address,
349 OK := Len = Second_Line'Length;
354 (Macro_File, Third_Line (Third_Line'First)'Address,
356 OK := Len = Third_Line'Length;
361 (Macro_File, Fourth_Line (Fourth_Line'First)'Address,
363 OK := Len = Fourth_Line'Length;
368 (Macro_File, Fifth_Line (Fifth_Line'First)'Address,
370 OK := Len = Fifth_Line'Length;
374 Close (Macro_File, OK);
378 Fail ("creation of auto-init assembly file """,
379 Macro_File_Name, """ failed");
383 -- Invoke the macro-assembler
386 Write_Str ("Assembling auto-init assembly file """);
387 Write_Str (Macro_File_Name);
391 Popen_Result := Popen (Command (Command'First)'Address,
392 Mode (Mode'First)'Address);
394 if Popen_Result = Null_Address then
395 Fail ("assembly of auto-init assembly file """,
396 Macro_File_Name, """ failed");
399 -- Wait for the end of execution of the macro-assembler
401 Pclose_Result := Pclose (Popen_Result);
403 if Pclose_Result < 0 then
404 Fail ("assembly of auto init assembly file """,
405 Macro_File_Name, """ failed");
408 -- Add the generated object file to the list of objects to be
409 -- included in the library.
411 Additional_Objects :=
413 (1 => new String'(Lib_Filename & "$init.obj"));
417 -- Allocate the argument list and put the symbol file name, the
418 -- reference (if any) and the policy (if not autonomous).
420 Arguments := new Argument_List (1 .. Ofiles'Length + 8);
427 Last_Argument := Last_Argument + 1;
428 Arguments (Last_Argument) := new String'("-v");
431 -- Version number (major ID)
433 if Lib_Version /= "" then
434 Last_Argument := Last_Argument + 1;
435 Arguments (Last_Argument) := new String'("-V");
436 Last_Argument := Last_Argument + 1;
437 Arguments (Last_Argument) := new String'(Version);
442 Last_Argument := Last_Argument + 1;
443 Arguments (Last_Argument) := new String'("-s");
444 Last_Argument := Last_Argument + 1;
445 Arguments (Last_Argument) := new String'(Opt_File_Name);
447 -- Reference Symbol File
449 if Symbol_Data.Reference /= No_Name then
450 Last_Argument := Last_Argument + 1;
451 Arguments (Last_Argument) := new String'("-r");
452 Last_Argument := Last_Argument + 1;
453 Arguments (Last_Argument) :=
454 new String'(Get_Name_String (Symbol_Data.Reference));
459 case Symbol_Data.Symbol_Policy is
464 Last_Argument := Last_Argument + 1;
465 Arguments (Last_Argument) := new String'("-c");
468 Last_Argument := Last_Argument + 1;
469 Arguments (Last_Argument) := new String'("-C");
472 Last_Argument := Last_Argument + 1;
473 Arguments (Last_Argument) := new String'("-R");
476 -- Add each relevant object file
478 for Index in Ofiles'Range loop
479 if Is_Interface (Ofiles (Index).all) then
480 Last_Argument := Last_Argument + 1;
481 Arguments (Last_Argument) := new String'(Ofiles (Index).all);
487 Spawn (Program_Name => Gnatsym_Path.all,
488 Args => Arguments (1 .. Last_Argument),
492 Fail ("unable to create symbol file for library """,
498 -- Move all the -l switches from Opts to Opts2
501 Index : Natural := Opts'First;
505 while Index <= Last_Opt loop
508 if Opt'Length > 2 and then
509 Opt (Opt'First .. Opt'First + 1) = "-l"
511 if Index < Last_Opt then
512 Opts (Index .. Last_Opt - 1) :=
513 Opts (Index + 1 .. Last_Opt);
516 Last_Opt := Last_Opt - 1;
518 Last_Opt2 := Last_Opt2 + 1;
519 Opts2 (Last_Opt2) := Opt;
527 -- Invoke gcc to build the library
530 (Output_File => Lib_File,
531 Objects => Ofiles & Additional_Objects.all,
532 Options => VMS_Options,
533 Options_2 => Link_With_Shared_Libgcc.all &
534 Opts (Opts'First .. Last_Opt) &
535 Opts2 (Opts2'First .. Last_Opt2),
536 Driver_Name => Driver_Name);
538 -- The auto-init object file need to be deleted, so that it will not
539 -- be included in the library as a regular object file, otherwise
540 -- it will be included twice when the library will be built next
541 -- time, which may lead to errors.
545 Auto_Init_Object_File_Name : constant String :=
546 Lib_Filename & "$init.obj";
551 Write_Str ("deleting auto-init object file """);
552 Write_Str (Auto_Init_Object_File_Name);
556 Delete_File (Auto_Init_Object_File_Name, Success => Disregard);
559 end Build_Dynamic_Library;
565 function DLL_Ext return String is
574 function Dynamic_Option return String is
583 function Is_Object_Ext (Ext : String) return Boolean is
592 function Is_C_Ext (Ext : String) return Boolean is
601 function Is_Archive_Ext (Ext : String) return Boolean is
603 return Ext = ".olb" or else Ext = ".exe";
610 function Libgnat return String is
611 Libgnat_A : constant String := "libgnat.a";
612 Libgnat_Olb : constant String := "libgnat.olb";
615 Name_Len := Libgnat_A'Length;
616 Name_Buffer (1 .. Name_Len) := Libgnat_A;
618 if Osint.Find_File (Name_Enter, Osint.Library) /= No_File then
626 ------------------------
627 -- Library_Exists_For --
628 ------------------------
630 function Library_Exists_For (Project : Project_Id) return Boolean is
632 if not Projects.Table (Project).Library then
633 Fail ("INTERNAL ERROR: Library_Exists_For called " &
634 "for non library project");
639 Lib_Dir : constant String :=
640 Get_Name_String (Projects.Table (Project).Library_Dir);
641 Lib_Name : constant String :=
642 Get_Name_String (Projects.Table (Project).Library_Name);
645 if Projects.Table (Project).Library_Kind = Static then
646 return Is_Regular_File
647 (Lib_Dir & Directory_Separator & "lib" &
648 Fil.Ext_To (Lib_Name, Archive_Ext));
651 return Is_Regular_File
652 (Lib_Dir & Directory_Separator & "lib" &
653 Fil.Ext_To (Lib_Name, DLL_Ext));
657 end Library_Exists_For;
659 ---------------------------
660 -- Library_File_Name_For --
661 ---------------------------
663 function Library_File_Name_For (Project : Project_Id) return Name_Id is
665 if not Projects.Table (Project).Library then
666 Prj.Com.Fail ("INTERNAL ERROR: Library_File_Name_For called " &
667 "for non library project");
672 Lib_Name : constant String :=
673 Get_Name_String (Projects.Table (Project).Library_Name);
677 Name_Buffer (1 .. Name_Len) := "lib";
679 if Projects.Table (Project).Library_Kind = Static then
680 Add_Str_To_Name_Buffer (Fil.Ext_To (Lib_Name, Archive_Ext));
683 Add_Str_To_Name_Buffer (Fil.Ext_To (Lib_Name, DLL_Ext));
689 end Library_File_Name_For;
695 function Object_Ext return String is
704 function PIC_Option return String is
709 -----------------------------------------------
710 -- Standalone_Library_Auto_Init_Is_Supported --
711 -----------------------------------------------
713 function Standalone_Library_Auto_Init_Is_Supported return Boolean is
716 end Standalone_Library_Auto_Init_Is_Supported;
718 ---------------------------
719 -- Support_For_Libraries --
720 ---------------------------
722 function Support_For_Libraries return Library_Support is
725 end Support_For_Libraries;