summaryrefslogtreecommitdiff
path: root/gcc/ada/mlib-tgt-vms.adb
diff options
context:
space:
mode:
authorcharlet <charlet@138bc75d-0d04-0410-961f-82ee72b054a4>2004-05-14 10:02:00 +0000
committercharlet <charlet@138bc75d-0d04-0410-961f-82ee72b054a4>2004-05-14 10:02:00 +0000
commit3e55413dd9a577b7b270e04f09ccb3f13a90a3cb (patch)
treead67eadab2c2032169ff2f33eb289b29a4e7e3a9 /gcc/ada/mlib-tgt-vms.adb
parent7e0c7e2e8e2c055a2751d8dbd5cdd4bd70fe316e (diff)
downloadgcc-3e55413dd9a577b7b270e04f09ccb3f13a90a3cb.tar.gz
Renaming of target specific files for clarity
* Makefile.in: Rename GNAT target specific files. * 31soccon.ads, 31soliop.ads 35soccon.ads, 3asoccon.ads, 3bsoccon.ads, 3gsoccon.ads, 3hsoccon.ads, 3psoccon.ads, 3ssoccon.ads, 3ssoliop.ads, 3veacodu.adb, 3vexpect.adb, 3vsoccon.ads, 3vsocthi.adb, 3vsocthi.ads, 3vtrasym.adb, 3wsoccon.ads, 3wsocthi.adb, 3wsocthi.ads, 3wsoliop.ads, 3zsoccon.ads, 3zsocthi.adb, 3zsocthi.ads, 41intnam.ads, 42intnam.ads, 45intnam.ads, 4aintnam.ads, 4cintnam.ads, 4gintnam.ads, 4hexcpol.adb, 4hintnam.ads, 4lintnam.ads, 4nintnam.ads, 4ointnam.ads, 4onumaux.ads, 4pintnam.ads, 4sintnam.ads, 4vcaldel.adb, 4vcalend.adb, 4vcalend.ads, 4vintnam.ads, 4wcalend.adb, 4wexcpol.adb, 4wintnam.ads, 4zintnam.ads, 4znumaux.ads, 4zsytaco.adb, 4zsytaco.ads, 51osinte.adb, 51osinte.ads, 51system.ads, 52osinte.adb, 52osinte.ads, 53osinte.ads, 54osinte.ads, 55osinte.adb, 55osinte.ads, 55system.ads, 56osinte.adb, 56osinte.ads, 56system.ads, 56taprop.adb, 56taspri.ads, 56tpopsp.adb, 57system.ads, 58system.ads, 5amastop.adb, 5aml-tgt.adb, 5aosinte.adb, 5aosinte.ads, 5asystem.ads, 5ataprop.adb, 5atasinf.ads, 5ataspri.ads, 5atpopsp.adb, 5avxwork.ads, 5bml-tgt.adb, 5bosinte.adb, 5bosinte.ads, 5bsystem.ads, 5cosinte.ads, 5csystem.ads, 5dsystem.ads, 5esystem.ads, 5fintman.adb, 5fosinte.adb, 5fosinte.ads, 5fsystem.ads, 5ftaprop.adb, 5ftasinf.ads, 5ginterr.adb, 5gintman.adb, 5gmastop.adb, 5gml-tgt.adb, 5gosinte.ads, 5gproinf.adb, 5gproinf.ads, 5gsystem.ads, 5gtaprop.adb, 5gtasinf.adb, 5gtasinf.ads, 5gtpgetc.adb, 5hml-tgt.adb, 5hosinte.adb, 5hosinte.ads, 5hparame.ads, 5hsystem.ads, 5htaprop.adb, 5htaspri.ads, 5htraceb.adb, 5iosinte.adb, 5iosinte.ads, 5itaprop.adb, 5itaspri.ads, 5ksystem.ads, 5kvxwork.ads, 5lml-tgt.adb, 5losinte.ads, 5lparame.adb, 5lsystem.ads, 5msystem.ads, 5mvxwork.ads, 5ninmaop.adb, 5nintman.adb, 5nosinte.ads, 5nsystem.ads, 5ntaprop.adb, 5ntaspri.ads, 5ointerr.adb, 5omastop.adb, 5oosinte.adb, 5oosinte.ads, 5oosprim.adb, 5oparame.adb, 5osystem.ads, 5otaprop.adb, 5otaspri.ads, 5posinte.ads, 5posprim.adb, 5psystem.ads, 5pvxwork.ads, 5sintman.adb, 5sml-tgt.adb, 5sosinte.adb, 5sosinte.ads, 5sosprim.adb, 5sparame.adb, 5ssystem.ads, 5staprop.adb, 5stasinf.adb, 5stasinf.ads, 5staspri.ads, 5stpopsp.adb, 5svxwork.ads, 5tosinte.ads, 5usystem.ads, 5vasthan.adb, 5vdirval.adb, 5vinmaop.adb, 5vinterr.adb, 5vintman.adb, 5vintman.ads, 5vmastop.adb, 5vml-tgt.adb, 5vosinte.adb, 5vosinte.ads, 5vosprim.adb, 5vosprim.ads, 5vparame.ads, 5vsymbol.adb, 5vsystem.ads, 5vtaprop.adb, 5vtaspri.ads, 5vtpopde.adb, 5vtpopde.ads, 5vtraent.adb, 5vtraent.ads, 5vvaflop.adb, 5wdirval.adb, 5wgloloc.adb, 5wintman.adb, 5wmemory.adb, 5wml-tgt.adb, 5wosinte.ads, 5wosprim.adb, 5wsystem.ads, 5wtaprop.adb, 5wtaspri.ads, 5xparame.ads, 5xsystem.ads, 5xvxwork.ads, 5yparame.ads, 5ysystem.ads, 5zinterr.adb, 5zintman.adb, 5zintman.ads, 5zml-tgt.adb, 5zosinte.adb, 5zosinte.ads, 5zosprim.adb, 5zparame.ads, 5zstchop.adb, 5zsystem.ads, 5ztaprop.adb, 5ztaspri.ads, 5ztfsetr.adb, 5ztpopsp.adb, 6vcpp.adb, 6vcstrea.adb, 6vinterf.ads, 7sinmaop.adb, 7sintman.adb, 7sosinte.adb, 7sosprim.adb, 7staprop.adb, 7staspri.ads, 7stfsetr.adb, 7stpopsp.adb, 7straceb.adb, 7straces.adb, 7strafor.adb, 7strafor.ads, 7stratas.adb, 86numaux.adb, 86numaux.ads: Replaced by files below. * a-caldel-vms.adb, a-calend-mingw.adb, a-calend-vms.adb, a-calend-vms.ads, a-dirval-mingw.adb, a-dirval-vms.adb, a-excpol-abort.adb, a-excpol-interix.adb, a-intnam-aix.ads, a-intnam-dummy.ads, a-intnam-freebsd.ads, a-intnam-hpux.ads, a-intnam-interix.ads, a-intnam-irix.ads, a-intnam-linux.ads, a-intnam-lynxos.ads, a-intnam-mingw.ads, a-intnam-os2.ads, a-intnam-solaris.ads, a-intnam-tru64.ads, a-intnam-unixware.ads, a-intnam-vms.ads, a-intnam-vxworks.ads, a-numaux-libc-x86.ads, a-numaux-vxworks.ads, a-numaux-x86.adb, a-numaux-x86.ads, a-sytaco-vxworks.adb, a-sytaco-vxworks.ads, g-eacodu-vms.adb, g-expect-vms.adb, g-soccon-aix.ads, g-soccon-freebsd.ads, g-soccon-hpux.ads, g-soccon-interix.ads, g-soccon-irix.ads, g-soccon-mingw.ads, g-soccon-solaris.ads, g-soccon-tru64.ads, g-soccon-unixware.ads, g-soccon-vms.adb, g-soccon-vxworks.ads, g-socthi-mingw.adb, g-socthi-mingw.ads, g-socthi-vms.adb, g-socthi-vms.ads, g-socthi-vxworks.adb, g-socthi-vxworks.ads, g-soliop-mingw.ads, g-soliop-solaris.ads, g-soliop-unixware.ads, g-trasym-vms.adb, i-cpp-vms.adb, i-cstrea-vms.adb, interfac-vms.ads, mlib-tgt-aix.adb, mlib-tgt-hpux.adb, mlib-tgt-irix.adb, mlib-tgt-linux.adb, mlib-tgt-mingw.adb, mlib-tgt-solaris.adb, mlib-tgt-tru64.adb, mlib-tgt-vms.adb, mlib-tgt-vxworks.adb, s-asthan-vms.adb, s-gloloc-mingw.adb, s-inmaop-dummy.adb, s-inmaop-posix.adb, s-inmaop-vms.adb, s-interr-dummy.adb, s-interr-sigaction.adb, s-interr-vms.adb, s-interr-vxworks.adb, s-intman-dummy.adb, s-intman-irix.adb, s-intman-irix-athread.adb, s-intman-mingw.adb, s-intman-posix.adb, s-intman-solaris.adb, s-intman-vms.adb, s-intman-vms.ads, s-intman-vxworks.adb, s-intman-vxworks.ads, s-mastop-irix.adb, s-mastop-tru64.adb, s-mastop-vms.adb, s-mastop-x86.adb, s-memory-mingw.adb, s-osinte-aix.adb, s-osinte-aix.ads, s-osinte-aix-fsu.ads, s-osinte-dummy.ads, s-osinte-freebsd.adb, s-osinte-freebsd.ads, s-osinte-fsu.adb, s-osinte-hpux.ads, s-osinte-hpux-dce.adb, s-osinte-hpux-dce.ads, s-osinte-interix.ads, s-osinte-irix.adb, s-osinte-irix.ads, s-osinte-irix-athread.ads, s-osinte-linux.ads, s-osinte-linux-fsu.ads, s-osinte-linux-ia64.ads, s-osinte-lynxos-3.adb, s-osinte-lynxos-3.ads, s-osinte-lynxos.adb, s-osinte-lynxos.ads, s-osinte-mingw.ads, s-osinte-os2.adb, s-osinte-os2.ads, s-osinte-posix.adb, s-osinte-solaris.adb, s-osinte-solaris.ads, s-osinte-solaris-fsu.ads, s-osinte-solaris-posix.ads, s-osinte-tru64.adb, s-osinte-tru64.ads, s-osinte-unixware.adb, s-osinte-unixware.ads, s-osinte-vms.adb, s-osinte-vms.ads, s-osinte-vxworks.adb, s-osinte-vxworks.ads, s-osprim-mingw.adb, s-osprim-os2.adb, s-osprim-posix.adb, s-osprim-solaris.adb, s-osprim-unix.adb, s-osprim-vms.adb, s-osprim-vms.ads, s-osprim-vxworks.adb, s-parame-ae653.ads, s-parame-hpux.ads, s-parame-linux.adb, s-parame-os2.adb, s-parame-solaris.adb, s-parame-vms.ads, s-parame-vms-restrict.ads, s-parame-vxworks.ads, s-proinf-irix-athread.adb, s-proinf-irix-athread.ads, s-stchop-vxworks.adb, s-taprop-dummy.adb, s-taprop-hpux-dce.adb, s-taprop-irix.adb, s-taprop-irix-athread.adb, s-taprop-linux.adb, s-taprop-lynxos.adb, s-taprop-mingw.adb, s-taprop-os2.adb, s-taprop-posix.adb, s-taprop-solaris.adb, s-taprop-tru64.adb, s-taprop-vms.adb, s-taprop-vxworks.adb, s-tasinf-irix.ads, s-tasinf-irix-athread.adb, s-tasinf-irix-athread.ads, s-tasinf-solaris.adb, s-tasinf-solaris.ads, s-tasinf-tru64.ads, s-taspri-dummy.ads, s-taspri-hpux-dce.ads, s-taspri-linux.ads, s-taspri-lynxos.ads, s-taspri-mingw.ads, s-taspri-os2.ads, s-taspri-posix.ads, s-taspri-solaris.ads, s-taspri-tru64.ads, s-taspri-vms.ads, s-taspri-vxworks.ads, s-tfsetr-default.adb, s-tfsetr-vxworks.adb, s-tpopde-vms.adb, s-tpopde-vms.ads, s-tpopsp-lynxos.adb, s-tpopsp-posix.adb, s-tpopsp-posix-foreign.adb, s-tpopsp-solaris.adb, s-tpopsp-vxworks.adb, s-traceb-hpux.adb, s-traceb-mastop.adb, s-traces-default.adb, s-traent-vms.adb, s-traent-vms.ads, s-trafor-default.adb, s-trafor-default.ads, s-tratas-default.adb, s-vaflop-vms.adb, s-vxwork-alpha.ads, s-vxwork-m68k.ads, s-vxwork-mips.ads, s-vxwork-ppc.ads, s-vxwork-sparcv9.ads, s-vxwork-xscale.ads, symbols-vms.adb, system-aix.ads, system-freebsd-x86.ads, system-hpux.ads, system-interix.ads, system-irix-n32.ads, system-irix-o32.ads, system-linux-x86_64.ads, system-linux-x86.ads, system-lynxos-ppc.ads, system-lynxos-x86.ads, system-mingw.ads, system-os2.ads, system-solaris-sparc.ads, system-solaris-sparcv9.ads, system-solaris-x86.ads, system-tru64.ads, system-unixware.ads, system-vms.ads, system-vms-zcx.ads, system-vxworks-alpha.ads, system-vxworks-m68k.ads, system-vxworks-mips.ads, system-vxworks-ppc.ads, system-vxworks-sparcv9.ads, system-vxworks-xscale.ads: Replace files above. git-svn-id: svn+ssh://gcc.gnu.org/svn/gcc/trunk@81834 138bc75d-0d04-0410-961f-82ee72b054a4
Diffstat (limited to 'gcc/ada/mlib-tgt-vms.adb')
-rw-r--r--gcc/ada/mlib-tgt-vms.adb703
1 files changed, 703 insertions, 0 deletions
diff --git a/gcc/ada/mlib-tgt-vms.adb b/gcc/ada/mlib-tgt-vms.adb
new file mode 100644
index 00000000000..6db0dccb9dc
--- /dev/null
+++ b/gcc/ada/mlib-tgt-vms.adb
@@ -0,0 +1,703 @@
+------------------------------------------------------------------------------
+-- --
+-- GNAT COMPILER COMPONENTS --
+-- --
+-- M L I B . T G T --
+-- (VMS Version) --
+-- --
+-- B o d y --
+-- --
+-- Copyright (C) 2003-2004, Free Software Foundation, Inc. --
+-- --
+-- GNAT is free software; you can redistribute it and/or modify it under --
+-- terms of the GNU General Public License as published by the Free Soft- --
+-- ware Foundation; either version 2, or (at your option) any later ver- --
+-- sion. GNAT is distributed in the hope that it will be useful, but WITH- --
+-- OUT ANY WARRANTY; without even the implied warranty of MERCHANTABILITY --
+-- or FITNESS FOR A PARTICULAR PURPOSE. See the GNU General Public License --
+-- for more details. You should have received a copy of the GNU General --
+-- Public License distributed with GNAT; see file COPYING. If not, write --
+-- to the Free Software Foundation, 59 Temple Place - Suite 330, Boston, --
+-- MA 02111-1307, USA. --
+-- --
+-- GNAT was originally developed by the GNAT team at New York University. --
+-- Extensive contributions were provided by Ada Core Technologies Inc. --
+-- --
+------------------------------------------------------------------------------
+
+-- This is the VMS version of the body
+
+with Ada.Characters.Handling; use Ada.Characters.Handling;
+
+with GNAT.Directory_Operations; use GNAT.Directory_Operations;
+with GNAT.OS_Lib; use GNAT.OS_Lib;
+
+with MLib.Fil;
+with MLib.Utl;
+with Namet; use Namet;
+with Opt; use Opt;
+with Output; use Output;
+with Prj.Com;
+with System; use System;
+with System.Case_Util; use System.Case_Util;
+
+package body MLib.Tgt is
+
+ use GNAT;
+
+ Empty_Argument_List : aliased Argument_List := (1 .. 0 => null);
+ Additional_Objects : Argument_List_Access := Empty_Argument_List'Access;
+ -- Used to add the generated auto-init object files for auto-initializing
+ -- stand-alone libraries.
+
+ Macro_Name : constant String := "mcr gnu:[bin]gcc -c -x assembler";
+ -- The name of the command to invoke the macro-assembler
+
+ VMS_Options : Argument_List := (1 .. 1 => null);
+
+ Gnatsym_Name : constant String := "gnatsym";
+
+ Gnatsym_Path : String_Access;
+
+ Arguments : Argument_List_Access := null;
+ Last_Argument : Natural := 0;
+
+ Success : Boolean := False;
+
+ Shared_Libgcc : aliased String := "-shared-libgcc";
+
+ No_Shared_Libgcc_Switch : aliased Argument_List := (1 .. 0 => null);
+ Shared_Libgcc_Switch : aliased Argument_List :=
+ (1 => Shared_Libgcc'Access);
+ Link_With_Shared_Libgcc : Argument_List_Access :=
+ No_Shared_Libgcc_Switch'Access;
+
+ ------------------------------
+ -- Target dependent section --
+ ------------------------------
+
+ function Popen (Command, Mode : System.Address) return System.Address;
+ pragma Import (C, Popen);
+
+ function Pclose (File : System.Address) return Integer;
+ pragma Import (C, Pclose);
+
+ ---------------------
+ -- Archive_Builder --
+ ---------------------
+
+ function Archive_Builder return String is
+ begin
+ return "ar";
+ end Archive_Builder;
+
+ -----------------------------
+ -- Archive_Builder_Options --
+ -----------------------------
+
+ function Archive_Builder_Options return String_List_Access is
+ begin
+ return new String_List'(1 => new String'("cr"));
+ end Archive_Builder_Options;
+
+ -----------------
+ -- Archive_Ext --
+ -----------------
+
+ function Archive_Ext return String is
+ begin
+ return "olb";
+ end Archive_Ext;
+
+ ---------------------
+ -- Archive_Indexer --
+ ---------------------
+
+ function Archive_Indexer return String is
+ begin
+ return "ranlib";
+ end Archive_Indexer;
+
+ ---------------------------
+ -- Build_Dynamic_Library --
+ ---------------------------
+
+ procedure Build_Dynamic_Library
+ (Ofiles : Argument_List;
+ Foreign : Argument_List;
+ Afiles : Argument_List;
+ Options : Argument_List;
+ Interfaces : Argument_List;
+ Lib_Filename : String;
+ Lib_Dir : String;
+ Symbol_Data : Symbol_Record;
+ Driver_Name : Name_Id := No_Name;
+ Lib_Address : String := "";
+ Lib_Version : String := "";
+ Relocatable : Boolean := False;
+ Auto_Init : Boolean := False)
+ is
+ pragma Unreferenced (Foreign);
+ pragma Unreferenced (Afiles);
+ pragma Unreferenced (Lib_Address);
+ pragma Unreferenced (Relocatable);
+
+ Lib_File : constant String :=
+ Lib_Dir & Directory_Separator & "lib" &
+ Fil.Ext_To (Lib_Filename, DLL_Ext);
+
+ Opts : Argument_List := Options;
+ Last_Opt : Natural := Opts'Last;
+ Opts2 : Argument_List (Options'Range);
+ Last_Opt2 : Natural := Opts2'First - 1;
+
+ Inter : constant Argument_List := Interfaces;
+
+ function Is_Interface (Obj_File : String) return Boolean;
+ -- For a Stand-Alone Library, returns True if Obj_File is the object
+ -- file name of an interface of the SAL.
+ -- For other libraries, always return True.
+
+ function Option_File_Name return String;
+ -- Returns Symbol_File, if not empty. Otherwise, returns "symvec.opt"
+
+ function Version_String return String;
+ -- Returns Lib_Version if not empty, otherwise returns "1".
+ -- Fails gnatmake if Lib_Version is not the image of a positive number.
+
+ ------------------
+ -- Is_Interface --
+ ------------------
+
+ function Is_Interface (Obj_File : String) return Boolean is
+ ALI : constant String :=
+ Fil.Ext_To
+ (Filename => To_Lower (Base_Name (Obj_File)),
+ New_Ext => "ali");
+
+ begin
+ if Inter'Length = 0 then
+ return True;
+
+ elsif ALI'Length > 2 and then
+ ALI (ALI'First .. ALI'First + 1) = "b$"
+ then
+ return True;
+
+ else
+ for J in Inter'Range loop
+ if Inter (J).all = ALI then
+ return True;
+ end if;
+ end loop;
+
+ return False;
+ end if;
+ end Is_Interface;
+
+ ----------------------
+ -- Option_File_Name --
+ ----------------------
+
+ function Option_File_Name return String is
+ begin
+ if Symbol_Data.Symbol_File = No_Name then
+ return "symvec.opt";
+ else
+ Get_Name_String (Symbol_Data.Symbol_File);
+ To_Lower (Name_Buffer (1 .. Name_Len));
+ return Name_Buffer (1 .. Name_Len);
+ end if;
+ end Option_File_Name;
+
+ --------------------
+ -- Version_String --
+ --------------------
+
+ function Version_String return String is
+ Version : Integer := 0;
+ begin
+ if Lib_Version = "" then
+ return "1";
+
+ else
+ begin
+ Version := Integer'Value (Lib_Version);
+
+ if Version <= 0 then
+ raise Constraint_Error;
+ end if;
+
+ return Lib_Version;
+
+ exception
+ when Constraint_Error =>
+ Fail ("illegal version """, Lib_Version,
+ """ (on VMS version must be a positive number)");
+ return "";
+ end;
+ end if;
+ end Version_String;
+
+ Opt_File_Name : constant String := Option_File_Name;
+ Version : constant String := Version_String;
+ For_Linker_Opt : String_Access;
+
+ -- Start of processing for Build_Dynamic_Library
+
+ begin
+ -- Invoke gcc with -shared-libgcc, but only for GCC 3 or higher
+
+ if GCC_Version >= 3 then
+ Link_With_Shared_Libgcc := Shared_Libgcc_Switch'Access;
+ else
+ Link_With_Shared_Libgcc := No_Shared_Libgcc_Switch'Access;
+ end if;
+
+ -- If option file name does not ends with ".opt", append "/OPTIONS"
+ -- to its specification for the VMS linker.
+
+ if Opt_File_Name'Length > 4
+ and then
+ Opt_File_Name (Opt_File_Name'Last - 3 .. Opt_File_Name'Last) = ".opt"
+ then
+ For_Linker_Opt := new String'("--for-linker=" & Opt_File_Name);
+ else
+ For_Linker_Opt :=
+ new String'("--for-linker=" & Opt_File_Name & "/OPTIONS");
+ end if;
+
+ VMS_Options (VMS_Options'First) := For_Linker_Opt;
+
+ for J in Inter'Range loop
+ To_Lower (Inter (J).all);
+ end loop;
+
+ -- "gnatsym" is necessary for building the option file
+
+ if Gnatsym_Path = null then
+ Gnatsym_Path := OS_Lib.Locate_Exec_On_Path (Gnatsym_Name);
+
+ if Gnatsym_Path = null then
+ Fail (Gnatsym_Name, " not found in path");
+ end if;
+ end if;
+
+ -- For auto-initialization of a stand-alone library, we create
+ -- a macro-assembly file and we invoke the macro-assembler.
+
+ if Auto_Init then
+ declare
+ Macro_File_Name : constant String := Lib_Filename & "$init.asm";
+ Macro_File : File_Descriptor;
+ Init_Proc : String := Lib_Filename & "INIT";
+ Popen_Result : System.Address;
+ Pclose_Result : Integer;
+ Len : Natural;
+ OK : Boolean := True;
+
+ Command : constant String :=
+ Macro_Name & " " & Macro_File_Name & ASCII.NUL;
+ -- The command to invoke the assembler on the generated auto-init
+ -- assembly file.
+
+ Mode : constant String := "r" & ASCII.NUL;
+ -- The mode for the invocation of Popen
+
+ begin
+ To_Upper (Init_Proc);
+
+ if Verbose_Mode then
+ Write_Str ("Creating auto-init assembly file """);
+ Write_Str (Macro_File_Name);
+ Write_Line ("""");
+ end if;
+
+ -- Create and write the auto-init assembly file
+
+ declare
+ First_Line : constant String :=
+ ASCII.HT & ".section LIB$INITIALIZE,GBL,NOWRT" &
+ ASCII.LF;
+ Second_Line : constant String :=
+ ASCII.HT & ".long " & Init_Proc & ASCII.LF;
+ -- First and second lines of the auto-init assembly file
+
+ begin
+ Macro_File := Create_File (Macro_File_Name, Text);
+ OK := Macro_File /= Invalid_FD;
+
+ if OK then
+ Len := Write
+ (Macro_File, First_Line (First_Line'First)'Address,
+ First_Line'Length);
+ OK := Len = First_Line'Length;
+ end if;
+
+ if OK then
+ Len := Write
+ (Macro_File, Second_Line (Second_Line'First)'Address,
+ Second_Line'Length);
+ OK := Len = Second_Line'Length;
+ end if;
+
+ if OK then
+ Close (Macro_File, OK);
+ end if;
+
+ if not OK then
+ Fail ("creation of auto-init assembly file """,
+ Macro_File_Name, """ failed");
+ end if;
+ end;
+
+ -- Invoke the macro-assembler
+
+ if Verbose_Mode then
+ Write_Str ("Assembling auto-init assembly file """);
+ Write_Str (Macro_File_Name);
+ Write_Line ("""");
+ end if;
+
+ Popen_Result := Popen (Command (Command'First)'Address,
+ Mode (Mode'First)'Address);
+
+ if Popen_Result = Null_Address then
+ Fail ("assembly of auto-init assembly file """,
+ Macro_File_Name, """ failed");
+ end if;
+
+ -- Wait for the end of execution of the macro-assembler
+
+ Pclose_Result := Pclose (Popen_Result);
+
+ if Pclose_Result < 0 then
+ Fail ("assembly of auto init assembly file """,
+ Macro_File_Name, """ failed");
+ end if;
+
+ -- Add the generated object file to the list of objects to be
+ -- included in the library.
+
+ Additional_Objects :=
+ new Argument_List'
+ (1 => new String'(Lib_Filename & "$init.obj"));
+ end;
+ end if;
+
+ -- Allocate the argument list and put the symbol file name, the
+ -- reference (if any) and the policy (if not autonomous).
+
+ Arguments := new Argument_List (1 .. Ofiles'Length + 8);
+
+ Last_Argument := 0;
+
+ -- Verbosity
+
+ if Verbose_Mode then
+ Last_Argument := Last_Argument + 1;
+ Arguments (Last_Argument) := new String'("-v");
+ end if;
+
+ -- Version number (major ID)
+
+ if Lib_Version /= "" then
+ Last_Argument := Last_Argument + 1;
+ Arguments (Last_Argument) := new String'("-V");
+ Last_Argument := Last_Argument + 1;
+ Arguments (Last_Argument) := new String'(Version);
+ end if;
+
+ -- Symbol file
+
+ Last_Argument := Last_Argument + 1;
+ Arguments (Last_Argument) := new String'("-s");
+ Last_Argument := Last_Argument + 1;
+ Arguments (Last_Argument) := new String'(Opt_File_Name);
+
+ -- Reference Symbol File
+
+ if Symbol_Data.Reference /= No_Name then
+ Last_Argument := Last_Argument + 1;
+ Arguments (Last_Argument) := new String'("-r");
+ Last_Argument := Last_Argument + 1;
+ Arguments (Last_Argument) :=
+ new String'(Get_Name_String (Symbol_Data.Reference));
+ end if;
+
+ -- Policy
+
+ case Symbol_Data.Symbol_Policy is
+ when Autonomous =>
+ null;
+
+ when Compliant =>
+ Last_Argument := Last_Argument + 1;
+ Arguments (Last_Argument) := new String'("-c");
+
+ when Controlled =>
+ Last_Argument := Last_Argument + 1;
+ Arguments (Last_Argument) := new String'("-C");
+ end case;
+
+ -- Add each relevant object file
+
+ for Index in Ofiles'Range loop
+ if Is_Interface (Ofiles (Index).all) then
+ Last_Argument := Last_Argument + 1;
+ Arguments (Last_Argument) := new String'(Ofiles (Index).all);
+ end if;
+ end loop;
+
+ -- Spawn gnatsym
+
+ Spawn (Program_Name => Gnatsym_Path.all,
+ Args => Arguments (1 .. Last_Argument),
+ Success => Success);
+
+ if not Success then
+ Fail ("unable to create symbol file for library """,
+ Lib_Filename, """");
+ end if;
+
+ Free (Arguments);
+
+ -- Move all the -l switches from Opts to Opts2
+
+ declare
+ Index : Natural := Opts'First;
+ Opt : String_Access;
+
+ begin
+ while Index <= Last_Opt loop
+ Opt := Opts (Index);
+
+ if Opt'Length > 2 and then
+ Opt (Opt'First .. Opt'First + 1) = "-l"
+ then
+ if Index < Last_Opt then
+ Opts (Index .. Last_Opt - 1) :=
+ Opts (Index + 1 .. Last_Opt);
+ end if;
+
+ Last_Opt := Last_Opt - 1;
+
+ Last_Opt2 := Last_Opt2 + 1;
+ Opts2 (Last_Opt2) := Opt;
+
+ else
+ Index := Index + 1;
+ end if;
+ end loop;
+ end;
+
+ -- Invoke gcc to build the library
+
+ Utl.Gcc
+ (Output_File => Lib_File,
+ Objects => Ofiles & Additional_Objects.all,
+ Options => VMS_Options,
+ Options_2 => Link_With_Shared_Libgcc.all &
+ Opts (Opts'First .. Last_Opt) &
+ Opts2 (Opts2'First .. Last_Opt2),
+ Driver_Name => Driver_Name);
+
+ -- The auto-init object file need to be deleted, so that it will not
+ -- be included in the library as a regular object file, otherwise
+ -- it will be included twice when the library will be built next
+ -- time, which may lead to errors.
+
+ if Auto_Init then
+ declare
+ Auto_Init_Object_File_Name : constant String :=
+ Lib_Filename & "$init.obj";
+ Disregard : Boolean;
+
+ begin
+ if Verbose_Mode then
+ Write_Str ("deleting auto-init object file """);
+ Write_Str (Auto_Init_Object_File_Name);
+ Write_Line ("""");
+ end if;
+
+ Delete_File (Auto_Init_Object_File_Name, Success => Disregard);
+ end;
+ end if;
+ end Build_Dynamic_Library;
+
+ -------------------------
+ -- Default_DLL_Address --
+ -------------------------
+
+ function Default_DLL_Address return String is
+ begin
+ return "";
+ end Default_DLL_Address;
+
+ -------------
+ -- DLL_Ext --
+ -------------
+
+ function DLL_Ext return String is
+ begin
+ return "exe";
+ end DLL_Ext;
+
+ --------------------
+ -- Dynamic_Option --
+ --------------------
+
+ function Dynamic_Option return String is
+ begin
+ return "-shared";
+ end Dynamic_Option;
+
+ -------------------
+ -- Is_Object_Ext --
+ -------------------
+
+ function Is_Object_Ext (Ext : String) return Boolean is
+ begin
+ return Ext = ".obj";
+ end Is_Object_Ext;
+
+ --------------
+ -- Is_C_Ext --
+ --------------
+
+ function Is_C_Ext (Ext : String) return Boolean is
+ begin
+ return Ext = ".c";
+ end Is_C_Ext;
+
+ --------------------
+ -- Is_Archive_Ext --
+ --------------------
+
+ function Is_Archive_Ext (Ext : String) return Boolean is
+ begin
+ return Ext = ".olb" or else Ext = ".exe";
+ end Is_Archive_Ext;
+
+ -------------
+ -- Libgnat --
+ -------------
+
+ function Libgnat return String is
+ Libgnat_A : constant String := "libgnat.a";
+ Libgnat_Olb : constant String := "libgnat.olb";
+
+ begin
+ Name_Len := Libgnat_A'Length;
+ Name_Buffer (1 .. Name_Len) := Libgnat_A;
+
+ if Osint.Find_File (Name_Enter, Osint.Library) /= No_File then
+ return Libgnat_A;
+
+ else
+ return Libgnat_Olb;
+ end if;
+ end Libgnat;
+
+ ------------------------
+ -- Library_Exists_For --
+ ------------------------
+
+ function Library_Exists_For (Project : Project_Id) return Boolean is
+ begin
+ if not Projects.Table (Project).Library then
+ Fail ("INTERNAL ERROR: Library_Exists_For called " &
+ "for non library project");
+ return False;
+
+ else
+ declare
+ Lib_Dir : constant String :=
+ Get_Name_String (Projects.Table (Project).Library_Dir);
+ Lib_Name : constant String :=
+ Get_Name_String (Projects.Table (Project).Library_Name);
+
+ begin
+ if Projects.Table (Project).Library_Kind = Static then
+ return Is_Regular_File
+ (Lib_Dir & Directory_Separator & "lib" &
+ Fil.Ext_To (Lib_Name, Archive_Ext));
+
+ else
+ return Is_Regular_File
+ (Lib_Dir & Directory_Separator & "lib" &
+ Fil.Ext_To (Lib_Name, DLL_Ext));
+ end if;
+ end;
+ end if;
+ end Library_Exists_For;
+
+ ---------------------------
+ -- Library_File_Name_For --
+ ---------------------------
+
+ function Library_File_Name_For (Project : Project_Id) return Name_Id is
+ begin
+ if not Projects.Table (Project).Library then
+ Prj.Com.Fail ("INTERNAL ERROR: Library_File_Name_For called " &
+ "for non library project");
+ return No_Name;
+
+ else
+ declare
+ Lib_Name : constant String :=
+ Get_Name_String (Projects.Table (Project).Library_Name);
+
+ begin
+ Name_Len := 3;
+ Name_Buffer (1 .. Name_Len) := "lib";
+
+ if Projects.Table (Project).Library_Kind = Static then
+ Add_Str_To_Name_Buffer (Fil.Ext_To (Lib_Name, Archive_Ext));
+
+ else
+ Add_Str_To_Name_Buffer (Fil.Ext_To (Lib_Name, DLL_Ext));
+ end if;
+
+ return Name_Find;
+ end;
+ end if;
+ end Library_File_Name_For;
+
+ ----------------
+ -- Object_Ext --
+ ----------------
+
+ function Object_Ext return String is
+ begin
+ return "obj";
+ end Object_Ext;
+
+ ----------------
+ -- PIC_Option --
+ ----------------
+
+ function PIC_Option return String is
+ begin
+ return "";
+ end PIC_Option;
+
+ -----------------------------------------------
+ -- Standalone_Library_Auto_Init_Is_Supported --
+ -----------------------------------------------
+
+ function Standalone_Library_Auto_Init_Is_Supported return Boolean is
+ begin
+ return True;
+ end Standalone_Library_Auto_Init_Is_Supported;
+
+ ---------------------------
+ -- Support_For_Libraries --
+ ---------------------------
+
+ function Support_For_Libraries return Library_Support is
+ begin
+ return Full;
+ end Support_For_Libraries;
+
+end MLib.Tgt;