X-Git-Url: https://oss.titaniummirror.com/gitweb/?a=blobdiff_plain;f=gcc%2Fada%2Fgnatdll.adb;fp=gcc%2Fada%2Fgnatdll.adb;h=0000000000000000000000000000000000000000;hb=6fed43773c9b0ce596dca5686f37ac3fc0fa11c0;hp=d39888234a6fef05d3941be656ad6330ec0d4361;hpb=27b11d56b743098deb193d510b337ba22dc52e5c;p=msp430-gcc.git diff --git a/gcc/ada/gnatdll.adb b/gcc/ada/gnatdll.adb deleted file mode 100644 index d3988823..00000000 --- a/gcc/ada/gnatdll.adb +++ /dev/null @@ -1,552 +0,0 @@ ------------------------------------------------------------------------------- --- -- --- GNAT COMPILER COMPONENTS -- --- -- --- G N A T D L L -- --- -- --- B o d y -- --- -- --- $Revision: 1.3.10.1 $ --- -- --- Copyright (C) 1997-2001, 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. -- --- -- ------------------------------------------------------------------------------- - --- GNATDLL is a Windows specific tool for building a DLL. --- Both relocatable and non-relocatable DLL's are supported - -with Ada.Text_IO; -with Ada.Strings.Unbounded; -with Ada.Exceptions; -with Ada.Command_Line; -with GNAT.OS_Lib; -with GNAT.Command_Line; -with Gnatvsn; - -with MDLL.Files; -with MDLL.Tools; - -procedure Gnatdll is - - use GNAT; - use Ada; - use MDLL; - use Ada.Strings.Unbounded; - - use type OS_Lib.Argument_List; - - procedure Syntax; - -- Print out usage - - procedure Check (Filename : String); - -- Check that the file whose name is Filename exists - - procedure Parse_Command_Line; - -- Parse the command line arguments passed to gnatdll - - procedure Check_Context; - -- Check the context before runing any commands to build the library - - Syntax_Error : exception; - Context_Error : exception; - -- What are these for ??? - - Help : Boolean := False; - -- What is this for ??? - - Version : constant String := Gnatvsn.Gnat_Version_String; - -- Why should it be necessary to make a copy of this - - Default_DLL_Address : constant String := "0x11000000"; - -- Default address for non relocatable DLL (Win32) - - Lib_Filename : Unbounded_String := Null_Unbounded_String; - Def_Filename : Unbounded_String := Null_Unbounded_String; - List_Filename : Unbounded_String := Null_Unbounded_String; - DLL_Address : Unbounded_String := - To_Unbounded_String (Default_DLL_Address); - -- What are the above ??? - - Objects_Files : Argument_List_Access := Null_Argument_List_Access; - -- List of objects to put inside the library - - Ali_Files : Argument_List_Access := Null_Argument_List_Access; - -- For each Ada file specified, we keep arecord of the corresponding - -- ALI file. This list of SLI files is used to build the binder program. - - Options : Argument_List_Access := Null_Argument_List_Access; - -- A list of options set in the command line. - - Largs_Options : Argument_List_Access := Null_Argument_List_Access; - Bargs_Options : Argument_List_Access := Null_Argument_List_Access; - -- GNAT linker and binder args options - - type Build_Mode_State is (Import_Lib, Dynamic_Lib, Nil); - -- Comments needed ??? - - Build_Mode : Build_Mode_State := Nil; - Must_Build_Relocatable : Boolean := True; - Build_Import : Boolean := True; - -- Comments needed - - ------------ - -- Syntax -- - ------------ - - procedure Syntax is - use Text_IO; - - procedure P (Str : in String) renames Text_IO.Put_Line; - - begin - P ("Usage : gnatdll [options] [list-of-files]"); - New_Line; - P ("[list-of-files] a list of Ada libraries (.ali) and/or " & - "foreign object files"); - New_Line; - P ("[options] can be"); - P (" -h Help - display this message"); - P (" -v Verbose"); - P (" -q Quiet"); - P (" -k Remove @nn suffix from exported names"); - P (" -g Generate debugging information"); - P (" -Idir Specify source and object files search path"); - P (" -l file File contains a list-of-files to be added to " - & "the library"); - P (" -e file Definition file containing exports"); - P (" -d file Put objects in the relocatable dynamic " - & "library "); - P (" -a[addr] Build non-relocatable DLL at address "); - P (" if is not specified use " - & Default_DLL_Address); - P (" -n No-import - do not create the import library"); - P (" -bargs opts opts are passed to the binder"); - P (" -largs opts opts are passed to the linker"); - end Syntax; - - ----------- - -- Check -- - ----------- - - procedure Check (Filename : in String) is - begin - if not OS_Lib.Is_Regular_File (Filename) then - Exceptions.Raise_Exception (Context_Error'Identity, - "Error: " & Filename & " not found."); - end if; - end Check; - - ------------------------ - -- Parse_Command_Line -- - ------------------------ - - procedure Parse_Command_Line is - - use GNAT.Command_Line; - - procedure Add_File (Filename : in String); - -- add one file to the list of file to handle - - procedure Add_Files_From_List (List_Filename : in String); - -- add the files listed in List_Filename (one by line) to the list - -- of file to handle - - procedure Ali_To_Object_List; - -- for each ali file in Afiles set put a corresponding object file in - -- Ofiles set. - - Max_Files : constant := 5_000; - Max_Options : constant := 100; - -- These are arbitrary limits, a better way will be to use linked list. - -- No, a better choice would be to use tables ??? - -- Limits on what??? - - Ofiles : OS_Lib.Argument_List (1 .. Max_Files); - O : Positive := Ofiles'First; - -- List of object files to put in the library. O is the next entry - -- to be used. - - Afiles : OS_Lib.Argument_List (1 .. Max_Files); - A : Positive := Afiles'First; - -- List of ALI files. A is the next entry to be used. - - Gopts : OS_Lib.Argument_List (1 .. Max_Options); - G : Positive := Gopts'First; - -- List of gcc options. G is the next entry to be used. - - Lopts : OS_Lib.Argument_List (1 .. Max_Options); - L : Positive := Lopts'First; - -- A list of -largs options (L is next entry to be used) - - Bopts : OS_Lib.Argument_List (1 .. Max_Options); - B : Positive := Bopts'First; - -- A list of -bargs options (B is next entry to be used) - - -------------- - -- Add_File -- - -------------- - - procedure Add_File (Filename : in String) is - begin - -- others files are to be put inside the dynamic library - -- ??? this makes no sense, should it be "Other files ..." - - if Files.Is_Ali (Filename) then - - Check (Filename); - - -- Record it to generate the binder program when - -- building dynamic library - - Afiles (A) := new String'(Filename); - A := A + 1; - - elsif Files.Is_Obj (Filename) then - - Check (Filename); - - -- Just record this object file - - Ofiles (O) := new String'(Filename); - O := O + 1; - - else - -- Unknown file type - - Exceptions.Raise_Exception - (Syntax_Error'Identity, - "don't know what to do with " & Filename & " !"); - end if; - end Add_File; - - ------------------------- - -- Add_Files_From_List -- - ------------------------- - - procedure Add_Files_From_List (List_Filename : in String) is - File : Text_IO.File_Type; - Buffer : String (1 .. 500); - Last : Natural; - - begin - Text_IO.Open (File, Text_IO.In_File, List_Filename); - - while not Text_IO.End_Of_File (File) loop - Text_IO.Get_Line (File, Buffer, Last); - Add_File (Buffer (1 .. Last)); - end loop; - - Text_IO.Close (File); - end Add_Files_From_List; - - ------------------------ - -- Ali_To_Object_List -- - ------------------------ - - procedure Ali_To_Object_List is - begin - for K in 1 .. A - 1 loop - Ofiles (O) := new String'(Files.Ext_To (Afiles (K).all, "o")); - O := O + 1; - end loop; - end Ali_To_Object_List; - - -- Start of processing for Parse_Command_Line - - begin - Initialize_Option_Scan ('-', False, "bargs largs"); - - -- scan gnatdll switches - - loop - case Getopt ("g h v q k a? d: e: l: n I:") is - - when ASCII.Nul => - exit; - - when 'h' => - Help := True; - - when 'g' => - Gopts (G) := new String'("-g"); - G := G + 1; - - when 'v' => - - -- Turn verbose mode on - - MDLL.Verbose := True; - if MDLL.Quiet then - Exceptions.Raise_Exception - (Syntax_Error'Identity, - "impossible to use -q and -v together."); - end if; - - when 'q' => - - -- Turn quiet mode on - - MDLL.Quiet := True; - if MDLL.Verbose then - Exceptions.Raise_Exception - (Syntax_Error'Identity, - "impossible to use -v and -q together."); - end if; - - when 'k' => - - MDLL.Kill_Suffix := True; - - when 'a' => - - if Parameter = "" then - - -- Default address for a relocatable dynamic library. - -- address for a non relocatable dynamic library. - - DLL_Address := To_Unbounded_String (Default_DLL_Address); - - else - DLL_Address := To_Unbounded_String (Parameter); - end if; - - Must_Build_Relocatable := False; - - when 'e' => - - Def_Filename := To_Unbounded_String (Parameter); - - when 'd' => - - -- Build a non relocatable DLL - - Lib_Filename := To_Unbounded_String (Parameter); - - if Def_Filename = Null_Unbounded_String then - Def_Filename := To_Unbounded_String - (Files.Ext_To (Parameter, "def")); - end if; - - Build_Mode := Dynamic_Lib; - - when 'n' => - - Build_Import := False; - - when 'l' => - List_Filename := To_Unbounded_String (Parameter); - - when 'I' => - Gopts (G) := new String'("-I" & Parameter); - G := G + 1; - - when others => - raise Invalid_Switch; - - end case; - end loop; - - -- Get parameters - - loop - declare - File : constant String := Get_Argument (Do_Expansion => True); - begin - exit when File'Length = 0; - Add_File (File); - end; - end loop; - - -- Get largs parameters - - Goto_Section ("largs"); - - loop - case Getopt ("*") is - - when ASCII.Nul => - exit; - - when others => - Lopts (L) := new String'(Full_Switch); - L := L + 1; - - end case; - end loop; - - -- Get bargs parameters - - Goto_Section ("bargs"); - - loop - case Getopt ("*") is - - when ASCII.Nul => - exit; - - when others => - Bopts (B) := new String'(Full_Switch); - B := B + 1; - - end case; - end loop; - - -- if list filename has been specified, parse it - - if List_Filename /= Null_Unbounded_String then - Add_Files_From_List (To_String (List_Filename)); - end if; - - -- Check if the set of parameters are compatible. - - if Build_Mode = Nil and then not Help and then not Verbose then - Exceptions.Raise_Exception - (Syntax_Error'Identity, - "nothing to do."); - end if; - - -- Check if we want to build an import library (option -e and - -- no file specified) - - if Build_Mode = Dynamic_Lib - and then A = Afiles'First - and then O = Ofiles'First - then - Build_Mode := Import_Lib; - end if; - - if O /= Ofiles'First then - Objects_Files := new OS_Lib.Argument_List'(Ofiles (1 .. O - 1)); - end if; - - if A /= Afiles'First then - Ali_Files := new OS_Lib.Argument_List'(Afiles (1 .. A - 1)); - end if; - - if G /= Gopts'First then - Options := new OS_Lib.Argument_List'(Gopts (1 .. G - 1)); - end if; - - if L /= Lopts'First then - Largs_Options := new OS_Lib.Argument_List'(Lopts (1 .. L - 1)); - end if; - - if B /= Bopts'First then - Bargs_Options := new OS_Lib.Argument_List'(Bopts (1 .. B - 1)); - end if; - - exception - - when Invalid_Switch => - Exceptions.Raise_Exception - (Syntax_Error'Identity, - Message => "Invalid Switch " & Full_Switch); - - when Invalid_Parameter => - Exceptions.Raise_Exception - (Syntax_Error'Identity, - Message => "No parameter for " & Full_Switch); - - end Parse_Command_Line; - - ------------------- - -- Check_Context -- - ------------------- - - procedure Check_Context is - begin - - Check (To_String (Def_Filename)); - - -- Check that each object file specified exists and raise exception - -- Context_Error if it does not. - - for F in Objects_Files'Range loop - Check (Objects_Files (F).all); - end loop; - end Check_Context; - --- Start of processing for Gnatdll - -begin - if Ada.Command_Line.Argument_Count = 0 then - Help := True; - else - Parse_Command_Line; - end if; - - if MDLL.Verbose or else Help then - Text_IO.New_Line; - Text_IO.Put_Line ("GNATDLL " & Version & " - Dynamic Libraries Builder"); - Text_IO.New_Line; - end if; - - MDLL.Tools.Locate; - - if Help - or else (MDLL.Verbose and then Ada.Command_Line.Argument_Count = 1) - then - Syntax; - else - Check_Context; - - case Build_Mode is - - when Import_Lib => - MDLL.Build_Import_Library - (To_String (Lib_Filename), - To_String (Def_Filename)); - - when Dynamic_Lib => - MDLL.Build_Dynamic_Library - (Objects_Files.all, - Ali_Files.all, - Options.all, - Bargs_Options.all, - Largs_Options.all, - To_String (Lib_Filename), - To_String (Def_Filename), - To_String (DLL_Address), - Build_Import, - Must_Build_Relocatable); - - when Nil => - null; - - end case; - - end if; - - Ada.Command_Line.Set_Exit_Status (Ada.Command_Line.Success); - -exception - - when SE : Syntax_Error => - Text_IO.Put_Line ("Syntax error : " & Exceptions.Exception_Message (SE)); - Text_IO.New_Line; - Syntax; - Ada.Command_Line.Set_Exit_Status (Ada.Command_Line.Failure); - - when E : Tools_Error | Context_Error => - Text_IO.Put_Line (Exceptions.Exception_Message (E)); - Ada.Command_Line.Set_Exit_Status (Ada.Command_Line.Failure); - - when others => - Text_IO.Put_Line ("gnatdll: INTERNAL ERROR. Please report"); - Ada.Command_Line.Set_Exit_Status (Ada.Command_Line.Failure); - -end Gnatdll;