1 ------------------------------------------------------------------------------
3 -- GNAT COMPILER COMPONENTS --
6 -- (Alpha VMS Version) --
10 -- Copyright (C) 2003-2005, 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 Alpha 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;
42 with System; use System;
43 with System.Case_Util; use System.Case_Util;
44 with System.CRTL; use System.CRTL;
46 package body MLib.Tgt is
50 Empty_Argument_List : aliased Argument_List := (1 .. 0 => null);
51 Additional_Objects : Argument_List_Access := Empty_Argument_List'Access;
52 -- Used to add the generated auto-init object files for auto-initializing
53 -- stand-alone libraries.
55 Macro_Name : constant String := "mcr gnu:[bin]gcc -c -x assembler";
56 -- The name of the command to invoke the macro-assembler
58 VMS_Options : Argument_List := (1 .. 1 => null);
60 Gnatsym_Name : constant String := "gnatsym";
62 Gnatsym_Path : String_Access;
64 Arguments : Argument_List_Access := null;
65 Last_Argument : Natural := 0;
67 Success : Boolean := False;
69 Shared_Libgcc : aliased String := "-shared-libgcc";
71 No_Shared_Libgcc_Switch : aliased Argument_List := (1 .. 0 => null);
72 Shared_Libgcc_Switch : aliased Argument_List :=
73 (1 => Shared_Libgcc'Access);
74 Link_With_Shared_Libgcc : Argument_List_Access :=
75 No_Shared_Libgcc_Switch'Access;
81 function Archive_Builder return String is
86 -----------------------------
87 -- Archive_Builder_Options --
88 -----------------------------
90 function Archive_Builder_Options return String_List_Access is
92 return new String_List'(1 => new String'("cr"));
93 end Archive_Builder_Options;
99 function Archive_Ext return String is
104 ---------------------
105 -- Archive_Indexer --
106 ---------------------
108 function Archive_Indexer return String is
113 -----------------------------
114 -- Archive_Indexer_Options --
115 -----------------------------
117 function Archive_Indexer_Options return String_List_Access is
119 return new String_List (1 .. 0);
120 end Archive_Indexer_Options;
122 ---------------------------
123 -- Build_Dynamic_Library --
124 ---------------------------
126 procedure Build_Dynamic_Library
127 (Ofiles : Argument_List;
128 Foreign : Argument_List;
129 Afiles : Argument_List;
130 Options : Argument_List;
131 Options_2 : Argument_List;
132 Interfaces : Argument_List;
133 Lib_Filename : String;
135 Symbol_Data : Symbol_Record;
136 Driver_Name : Name_Id := No_Name;
137 Lib_Version : String := "";
138 Auto_Init : Boolean := False)
140 pragma Unreferenced (Foreign);
141 pragma Unreferenced (Afiles);
143 Lib_File : constant String :=
144 Lib_Dir & Directory_Separator & "lib" &
145 Fil.Ext_To (Lib_Filename, DLL_Ext);
147 Opts : Argument_List := Options;
148 Last_Opt : Natural := Opts'Last;
149 Opts2 : Argument_List (Options'Range);
150 Last_Opt2 : Natural := Opts2'First - 1;
152 Inter : constant Argument_List := Interfaces;
154 function Is_Interface (Obj_File : String) return Boolean;
155 -- For a Stand-Alone Library, returns True if Obj_File is the object
156 -- file name of an interface of the SAL. For other libraries, always
159 function Option_File_Name return String;
160 -- Returns Symbol_File, if not empty. Otherwise, returns "symvec.opt"
162 function Version_String return String;
163 -- Returns Lib_Version if not empty, otherwise returns "1".
164 -- Fails gnatmake if Lib_Version is not the image of a positive number.
170 function Is_Interface (Obj_File : String) return Boolean is
171 ALI : constant String :=
173 (Filename => To_Lower (Base_Name (Obj_File)),
177 if Inter'Length = 0 then
180 elsif ALI'Length > 2 and then
181 ALI (ALI'First .. ALI'First + 1) = "b$"
186 for J in Inter'Range loop
187 if Inter (J).all = ALI then
196 ----------------------
197 -- Option_File_Name --
198 ----------------------
200 function Option_File_Name return String is
202 if Symbol_Data.Symbol_File = No_Name then
205 Get_Name_String (Symbol_Data.Symbol_File);
206 To_Lower (Name_Buffer (1 .. Name_Len));
207 return Name_Buffer (1 .. Name_Len);
209 end Option_File_Name;
215 function Version_String return String is
216 Version : Integer := 0;
218 if Lib_Version = "" then
223 Version := Integer'Value (Lib_Version);
226 raise Constraint_Error;
232 when Constraint_Error =>
233 Fail ("illegal version """, Lib_Version,
234 """ (on VMS version must be a positive number)");
240 Opt_File_Name : constant String := Option_File_Name;
241 Version : constant String := Version_String;
242 For_Linker_Opt : String_Access;
244 -- Start of processing for Build_Dynamic_Library
247 -- Invoke gcc with -shared-libgcc, but only for GCC 3 or higher
249 if GCC_Version >= 3 then
250 Link_With_Shared_Libgcc := Shared_Libgcc_Switch'Access;
252 Link_With_Shared_Libgcc := No_Shared_Libgcc_Switch'Access;
255 -- If option file name does not ends with ".opt", append "/OPTIONS"
256 -- to its specification for the VMS linker.
258 if Opt_File_Name'Length > 4
260 Opt_File_Name (Opt_File_Name'Last - 3 .. Opt_File_Name'Last) = ".opt"
262 For_Linker_Opt := new String'("--for-linker=" & Opt_File_Name);
265 new String'("--for-linker=" & Opt_File_Name & "/OPTIONS");
268 VMS_Options (VMS_Options'First) := For_Linker_Opt;
270 for J in Inter'Range loop
271 To_Lower (Inter (J).all);
274 -- "gnatsym" is necessary for building the option file
276 if Gnatsym_Path = null then
277 Gnatsym_Path := OS_Lib.Locate_Exec_On_Path (Gnatsym_Name);
279 if Gnatsym_Path = null then
280 Fail (Gnatsym_Name, " not found in path");
284 -- For auto-initialization of a stand-alone library, we create
285 -- a macro-assembly file and we invoke the macro-assembler.
289 Macro_File_Name : constant String := Lib_Filename & "$init.asm";
290 Macro_File : File_Descriptor;
291 Init_Proc : String := Lib_Filename & "INIT";
292 Popen_Result : System.Address;
293 Pclose_Result : Integer;
295 OK : Boolean := True;
297 command : constant String :=
298 Macro_Name & " " & Macro_File_Name & ASCII.NUL;
299 -- The command to invoke the assembler on the generated auto-init
302 mode : constant String := "r" & ASCII.NUL;
303 -- The mode for the invocation of Popen
306 To_Upper (Init_Proc);
309 Write_Str ("Creating auto-init assembly file """);
310 Write_Str (Macro_File_Name);
314 -- Create and write the auto-init assembly file
317 First_Line : constant String :=
318 ASCII.HT & ".section LIB$INITIALIZE,GBL,NOWRT" &
320 Second_Line : constant String :=
321 ASCII.HT & ".long " & Init_Proc & ASCII.LF;
322 -- First and second lines of the auto-init assembly file
325 Macro_File := Create_File (Macro_File_Name, Text);
326 OK := Macro_File /= Invalid_FD;
330 (Macro_File, First_Line (First_Line'First)'Address,
332 OK := Len = First_Line'Length;
337 (Macro_File, Second_Line (Second_Line'First)'Address,
339 OK := Len = Second_Line'Length;
343 Close (Macro_File, OK);
347 Fail ("creation of auto-init assembly file """,
348 Macro_File_Name, """ failed");
352 -- Invoke the macro-assembler
355 Write_Str ("Assembling auto-init assembly file """);
356 Write_Str (Macro_File_Name);
360 Popen_Result := popen (command (command'First)'Address,
361 mode (mode'First)'Address);
363 if Popen_Result = Null_Address then
364 Fail ("assembly of auto-init assembly file """,
365 Macro_File_Name, """ failed");
368 -- Wait for the end of execution of the macro-assembler
370 Pclose_Result := pclose (Popen_Result);
372 if Pclose_Result < 0 then
373 Fail ("assembly of auto init assembly file """,
374 Macro_File_Name, """ failed");
377 -- Add the generated object file to the list of objects to be
378 -- included in the library.
380 Additional_Objects :=
382 (1 => new String'(Lib_Filename & "$init.obj"));
386 -- Allocate the argument list and put the symbol file name, the
387 -- reference (if any) and the policy (if not autonomous).
389 Arguments := new Argument_List (1 .. Ofiles'Length + 8);
396 Last_Argument := Last_Argument + 1;
397 Arguments (Last_Argument) := new String'("-v");
400 -- Version number (major ID)
402 if Lib_Version /= "" then
403 Last_Argument := Last_Argument + 1;
404 Arguments (Last_Argument) := new String'("-V");
405 Last_Argument := Last_Argument + 1;
406 Arguments (Last_Argument) := new String'(Version);
411 Last_Argument := Last_Argument + 1;
412 Arguments (Last_Argument) := new String'("-s");
413 Last_Argument := Last_Argument + 1;
414 Arguments (Last_Argument) := new String'(Opt_File_Name);
416 -- Reference Symbol File
418 if Symbol_Data.Reference /= No_Name then
419 Last_Argument := Last_Argument + 1;
420 Arguments (Last_Argument) := new String'("-r");
421 Last_Argument := Last_Argument + 1;
422 Arguments (Last_Argument) :=
423 new String'(Get_Name_String (Symbol_Data.Reference));
428 case Symbol_Data.Symbol_Policy is
433 Last_Argument := Last_Argument + 1;
434 Arguments (Last_Argument) := new String'("-c");
437 Last_Argument := Last_Argument + 1;
438 Arguments (Last_Argument) := new String'("-C");
441 Last_Argument := Last_Argument + 1;
442 Arguments (Last_Argument) := new String'("-R");
445 -- Add each relevant object file
447 for Index in Ofiles'Range loop
448 if Is_Interface (Ofiles (Index).all) then
449 Last_Argument := Last_Argument + 1;
450 Arguments (Last_Argument) := new String'(Ofiles (Index).all);
456 Spawn (Program_Name => Gnatsym_Path.all,
457 Args => Arguments (1 .. Last_Argument),
461 Fail ("unable to create symbol file for library """,
467 -- Move all the -l switches from Opts to Opts2
470 Index : Natural := Opts'First;
474 while Index <= Last_Opt loop
477 if Opt'Length > 2 and then
478 Opt (Opt'First .. Opt'First + 1) = "-l"
480 if Index < Last_Opt then
481 Opts (Index .. Last_Opt - 1) :=
482 Opts (Index + 1 .. Last_Opt);
485 Last_Opt := Last_Opt - 1;
487 Last_Opt2 := Last_Opt2 + 1;
488 Opts2 (Last_Opt2) := Opt;
496 -- Invoke gcc to build the library
499 (Output_File => Lib_File,
500 Objects => Ofiles & Additional_Objects.all,
501 Options => VMS_Options,
502 Options_2 => Link_With_Shared_Libgcc.all &
503 Opts (Opts'First .. Last_Opt) &
504 Opts2 (Opts2'First .. Last_Opt2) & Options_2,
505 Driver_Name => Driver_Name);
507 -- The auto-init object file need to be deleted, so that it will not
508 -- be included in the library as a regular object file, otherwise
509 -- it will be included twice when the library will be built next
510 -- time, which may lead to errors.
514 Auto_Init_Object_File_Name : constant String :=
515 Lib_Filename & "$init.obj";
520 Write_Str ("deleting auto-init object file """);
521 Write_Str (Auto_Init_Object_File_Name);
525 Delete_File (Auto_Init_Object_File_Name, Success => Disregard);
528 end Build_Dynamic_Library;
534 function DLL_Ext return String is
543 function Dynamic_Option return String is
552 function Is_Object_Ext (Ext : String) return Boolean is
561 function Is_C_Ext (Ext : String) return Boolean is
570 function Is_Archive_Ext (Ext : String) return Boolean is
572 return Ext = ".olb" or else Ext = ".exe";
579 function Libgnat return String is
580 Libgnat_A : constant String := "libgnat.a";
581 Libgnat_Olb : constant String := "libgnat.olb";
584 Name_Len := Libgnat_A'Length;
585 Name_Buffer (1 .. Name_Len) := Libgnat_A;
587 if Osint.Find_File (Name_Enter, Osint.Library) /= No_File then
595 ------------------------
596 -- Library_Exists_For --
597 ------------------------
599 function Library_Exists_For
600 (Project : Project_Id; In_Tree : Project_Tree_Ref) return Boolean
603 if not In_Tree.Projects.Table (Project).Library then
604 Fail ("INTERNAL ERROR: Library_Exists_For called " &
605 "for non library project");
610 Lib_Dir : constant String :=
612 (In_Tree.Projects.Table (Project).Library_Dir);
613 Lib_Name : constant String :=
615 (In_Tree.Projects.Table (Project).Library_Name);
618 if In_Tree.Projects.Table (Project).Library_Kind =
621 return Is_Regular_File
622 (Lib_Dir & Directory_Separator & "lib" &
623 Fil.Ext_To (Lib_Name, Archive_Ext));
626 return Is_Regular_File
627 (Lib_Dir & Directory_Separator & "lib" &
628 Fil.Ext_To (Lib_Name, DLL_Ext));
632 end Library_Exists_For;
634 ---------------------------
635 -- Library_File_Name_For --
636 ---------------------------
638 function Library_File_Name_For
639 (Project : Project_Id;
640 In_Tree : Project_Tree_Ref) return Name_Id
643 if not In_Tree.Projects.Table (Project).Library then
644 Prj.Com.Fail ("INTERNAL ERROR: Library_File_Name_For called " &
645 "for non library project");
650 Lib_Name : constant String :=
652 (In_Tree.Projects.Table (Project).Library_Name);
656 Name_Buffer (1 .. Name_Len) := "lib";
658 if In_Tree.Projects.Table (Project).Library_Kind =
661 Add_Str_To_Name_Buffer (Fil.Ext_To (Lib_Name, Archive_Ext));
664 Add_Str_To_Name_Buffer (Fil.Ext_To (Lib_Name, DLL_Ext));
670 end Library_File_Name_For;
676 function Object_Ext return String is
685 function PIC_Option return String is
690 -----------------------------------------------
691 -- Standalone_Library_Auto_Init_Is_Supported --
692 -----------------------------------------------
694 function Standalone_Library_Auto_Init_Is_Supported return Boolean is
697 end Standalone_Library_Auto_Init_Is_Supported;
699 ---------------------------
700 -- Support_For_Libraries --
701 ---------------------------
703 function Support_For_Libraries return Library_Support is
706 end Support_For_Libraries;