------------------------------------------------------------------------------ -- -- -- GNAT COMPILER COMPONENTS -- -- -- -- G N A T D L L -- -- -- -- B o d y -- -- -- -- Copyright (C) 1997-2023, 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. -- -- -- ------------------------------------------------------------------------------ -- GNATDLL is a Windows specific tool for building a DLL. -- Both relocatable and non-relocatable DLL's are supported with Gnatvsn; with MDLL.Fil; use MDLL.Fil; with MDLL.Utl; with Switch; use Switch; with Ada.Text_IO; use Ada.Text_IO; with Ada.Strings.Unbounded; use Ada.Strings.Unbounded; with Ada.Exceptions; use Ada.Exceptions; with Ada.Command_Line; use Ada.Command_Line; with GNAT.OS_Lib; use GNAT.OS_Lib; with GNAT.Command_Line; use GNAT.Command_Line; procedure Gnatdll is 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 running any commands to build the library Syntax_Error : exception; -- Raised when a syntax error is detected, in this case a usage info will -- be displayed. Context_Error : exception; -- Raised when some files (specified on the command line) are missing to -- build the DLL. Help : Boolean := False; -- Help will be set to True the usage information is to be displayed 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; -- The DLL filename that will be created (.dll) Def_Filename : Unbounded_String := Null_Unbounded_String; -- The definition filename (.def) List_Filename : Unbounded_String := Null_Unbounded_String; -- The name of the file containing the objects file to put into the DLL DLL_Address : Unbounded_String := To_Unbounded_String (Default_DLL_Address); -- The DLL's base address Gen_Map_File : Boolean := False; -- Set to True if a map file is to be generated Objects_Files : Argument_List_Access := MDLL.Null_Argument_List_Access; -- List of objects to put inside the library Ali_Files : Argument_List_Access := MDLL.Null_Argument_List_Access; -- For each Ada file specified, we keep a record of the corresponding -- ALI file. This list of SLI files is used to build the binder program. Options : Argument_List_Access := MDLL.Null_Argument_List_Access; -- A list of options set in the command line Largs_Options : Argument_List_Access := MDLL.Null_Argument_List_Access; Bargs_Options : Argument_List_Access := MDLL.Null_Argument_List_Access; -- GNAT linker and binder args options type Build_Mode_State is (Import_Lib, Dynamic_Lib, Dynamic_Lib_Only, Nil); -- Import_Lib means only the .a file will be created, Dynamic_Lib means -- that both the DLL and the import library will be created. -- Dynamic_Lib_Only means that only the DLL will be created (no import -- library). Build_Mode : Build_Mode_State := Nil; -- Will be set when parsing the command line Must_Build_Relocatable : Boolean := True; -- True means build a relocatable DLL, will be set to False if a -- non-relocatable DLL must be built. ------------ -- Syntax -- ------------ procedure Syntax is procedure P (Str : String) renames 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 (" -b addr Set base address for the relocatable DLL"); P (" default address is " & Default_DLL_Address); P (" -a[addr] Build non-relocatable DLL at address "); P (" if is not specified use " & Default_DLL_Address); P (" -m Generate map file"); 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 : String) is begin if not Is_Regular_File (Filename) then Raise_Exception (Context_Error'Identity, "Error: " & Filename & " not found."); end if; end Check; ------------------------ -- Parse_Command_Line -- ------------------------ procedure Parse_Command_Line is procedure Add_File (Filename : String); -- Add one file to the list of file to handle procedure Add_Files_From_List (List_Filename : String); -- Add the files listed in List_Filename (one by line) to the list -- of file to handle Max_Files : constant := 50_000; Max_Options : constant := 1_000; Ofiles : 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 : Argument_List (1 .. Max_Files); A : Positive := Afiles'First; -- List of ALI files. A is the next entry to be used Gopts : Argument_List (1 .. Max_Options); G : Positive := Gopts'First; -- List of gcc options. G is the next entry to be used Lopts : Argument_List (1 .. Max_Options); L : Positive := Lopts'First; -- A list of -largs options (L is next entry to be used) Bopts : Argument_List (1 .. Max_Options); B : Positive := Bopts'First; -- A list of -bargs options (B is next entry to be used) Build_Import : Boolean := True; -- Set to False if option -n if specified (no-import) -------------- -- Add_File -- -------------- procedure Add_File (Filename : String) is begin if 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 Is_Obj (Filename) then Check (Filename); -- Just record this object file Ofiles (O) := new String'(Filename); O := O + 1; else -- Unknown file type 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 : String) is File : File_Type; Buffer : String (1 .. 500); Last : Natural; begin Open (File, In_File, List_Filename); while not End_Of_File (File) loop Get_Line (File, Buffer, Last); Add_File (Buffer (1 .. Last)); end loop; Close (File); exception when Name_Error => Raise_Exception (Syntax_Error'Identity, "list-of-files file " & List_Filename & " not found."); end Add_Files_From_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? b: d: e: l: n m 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 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 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 'b' => DLL_Address := To_Unbounded_String (Parameter); Must_Build_Relocatable := True; 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 (Ext_To (Parameter, "def")); end if; Build_Mode := Dynamic_Lib; when 'm' => Gen_Map_File := True; 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 MDLL.Verbose then Raise_Exception (Syntax_Error'Identity, "nothing to do."); end if; -- -n option but no file specified if not Build_Import and then A = Afiles'First and then O = Ofiles'First then Raise_Exception (Syntax_Error'Identity, "-n specified but there are no objects to build the library."); 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 map file is to be generated, add linker option here if Gen_Map_File and then Build_Mode = Import_Lib then Raise_Exception (Syntax_Error'Identity, "Can't generate a map file for an import library."); end if; -- Check if only a dynamic library must be built if Build_Mode = Dynamic_Lib and then not Build_Import then Build_Mode := Dynamic_Lib_Only; end if; if O /= Ofiles'First then Objects_Files := new Argument_List'(Ofiles (1 .. O - 1)); end if; if A /= Afiles'First then Ali_Files := new Argument_List'(Afiles (1 .. A - 1)); end if; if G /= Gopts'First then Options := new Argument_List'(Gopts (1 .. G - 1)); end if; if L /= Lopts'First then Largs_Options := new Argument_List'(Lopts (1 .. L - 1)); end if; if B /= Bopts'First then Bargs_Options := new Argument_List'(Bopts (1 .. B - 1)); end if; exception when Invalid_Switch => Raise_Exception (Syntax_Error'Identity, Message => "Invalid Switch " & Full_Switch); when Invalid_Parameter => 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; procedure Check_Version_And_Help is new Check_Version_And_Help_G (Syntax); -- Start of processing for Gnatdll begin Check_Version_And_Help ("GNATDLL", "1997"); if Ada.Command_Line.Argument_Count = 0 then Help := True; else Parse_Command_Line; end if; if MDLL.Verbose or else Help then New_Line; Put_Line ("GNATDLL " & Version & " - Dynamic Libraries Builder"); New_Line; end if; MDLL.Utl.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 => True, Relocatable => Must_Build_Relocatable, Map_File => Gen_Map_File); when Dynamic_Lib_Only => 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 => False, Relocatable => Must_Build_Relocatable, Map_File => Gen_Map_File); when Nil => null; end case; end if; Set_Exit_Status (Success); exception when SE : Syntax_Error => Put_Line ("Syntax error : " & Exception_Message (SE)); New_Line; Syntax; Set_Exit_Status (Failure); when E : MDLL.Tools_Error | Context_Error => Put_Line (Exception_Message (E)); Set_Exit_Status (Failure); when others => Put_Line ("gnatdll: INTERNAL ERROR. Please report"); Set_Exit_Status (Failure); end Gnatdll;