diff options
Diffstat (limited to 'gcc-4.4.3/gcc/ada/mlib-tgt-specific-vms-alpha.adb')
| -rw-r--r-- | gcc-4.4.3/gcc/ada/mlib-tgt-specific-vms-alpha.adb | 508 |
1 files changed, 0 insertions, 508 deletions
diff --git a/gcc-4.4.3/gcc/ada/mlib-tgt-specific-vms-alpha.adb b/gcc-4.4.3/gcc/ada/mlib-tgt-specific-vms-alpha.adb deleted file mode 100644 index f272307b9..000000000 --- a/gcc-4.4.3/gcc/ada/mlib-tgt-specific-vms-alpha.adb +++ /dev/null @@ -1,508 +0,0 @@ ------------------------------------------------------------------------------- --- -- --- GNAT COMPILER COMPONENTS -- --- -- --- M L I B . T G T . S P E C I F I C -- --- (Alpha VMS Version) -- --- -- --- B o d y -- --- -- --- Copyright (C) 2003-2008, 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 3, 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 COPYING3. If not, go to -- --- http://www.gnu.org/licenses for a complete copy of the license. -- --- -- --- GNAT was originally developed by the GNAT team at New York University. -- --- Extensive contributions were provided by Ada Core Technologies Inc. -- --- -- ------------------------------------------------------------------------------- - --- This is the Alpha VMS version of the body - -with Ada.Characters.Handling; use Ada.Characters.Handling; - -with MLib.Fil; -with MLib.Utl; - -with MLib.Tgt.VMS_Common; -pragma Warnings (Off, MLib.Tgt.VMS_Common); --- MLib.Tgt.VMS_Common is with'ed only for elaboration purposes - -with Opt; use Opt; -with Output; use Output; - -with GNAT.Directory_Operations; use GNAT.Directory_Operations; - -with System; use System; -with System.Case_Util; use System.Case_Util; -with System.CRTL; use System.CRTL; - -package body MLib.Tgt.Specific is - - -- Non default subprogram. See comment in mlib-tgt.ads. - - procedure Build_Dynamic_Library - (Ofiles : 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_Version : String := ""; - Auto_Init : Boolean := False); - - -- Local variables - - 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"; - - Shared_Libgcc_Switch : constant Argument_List := - (1 => Shared_Libgcc'Access); - - --------------------------- - -- Build_Dynamic_Library -- - --------------------------- - - procedure Build_Dynamic_Library - (Ofiles : 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_Version : String := ""; - Auto_Init : Boolean := False) - is - - 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 and if Symbol_Data.Symbol_Policy is - -- not Autonomous, otherwise returns "". When Symbol_Data.Symbol_Policy - -- is Autonomous, 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 + 2) = "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_Path 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 = "" - or else Symbol_Data.Symbol_Policy /= Autonomous - then - return ""; - - 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; - - --------------------- - -- Local Variables -- - --------------------- - - 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 - -- 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 := 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 - use ASCII; - - -- Output a dummy transfer address for debugging - -- followed by the LIB$INITIALIZE section. - - Lines : constant String := - HT & ".text" & LF & - HT & ".align 4" & LF & - HT & ".globl __main" & LF & - HT & ".ent __main" & LF & - "__main..en:" & LF & - HT & ".base $27" & LF & - HT & ".frame $29,0,$26,8" & LF & - HT & "ret $31,($26),1" & LF & - HT & ".link" & LF & - "__main:" & LF & - HT & ".pdesc __main..en,null" & LF & - HT & ".end __main" & LF & LF & - HT & ".section LIB$INITIALIZE,GBL,NOWRT" & LF & - HT & ".long " & Init_Proc & LF; - - begin - Macro_File := Create_File (Macro_File_Name, Text); - OK := Macro_File /= Invalid_FD; - - if OK then - Len := Write - (Macro_File, Lines (Lines'First)'Address, - Lines'Length); - OK := Len = Lines'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_Path 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"); - - when Restricted => - Last_Argument := Last_Argument + 1; - Arguments (Last_Argument) := new String'("-R"); - - when Direct => - Last_Argument := Last_Argument + 1; - Arguments (Last_Argument) := new String'("-D"); - - 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 => Shared_Libgcc_Switch & - 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; - --- Package initialization - -begin - Build_Dynamic_Library_Ptr := Build_Dynamic_Library'Access; -end MLib.Tgt.Specific; |