From: Pascal Obry Date: Thu, 16 Jun 2005 08:30:00 +0000 (+0200) Subject: mlib-tgt-mingw.adb (Build_Dynamic_Library): Replace the previous implementation. X-Git-Tag: misc/cutover-cvs2svn~2372 X-Git-Url: http://git.ipfire.org/?a=commitdiff_plain;h=1e813ab6c01a9a4628f991c7a91719e4988c590c;p=thirdparty%2Fgcc.git mlib-tgt-mingw.adb (Build_Dynamic_Library): Replace the previous implementation. 2005-06-14 Pascal Obry * mlib-tgt-mingw.adb (Build_Dynamic_Library): Replace the previous implementation. This new version generates the proper DllMain routine to initialize the SAL. The DllMain is generated in Ada and compiled before being added as option to the library build command. From-SVN: r101019 --- diff --git a/gcc/ada/mlib-tgt-mingw.adb b/gcc/ada/mlib-tgt-mingw.adb index 9bd970ba701a..185c1329f2cd 100644 --- a/gcc/ada/mlib-tgt-mingw.adb +++ b/gcc/ada/mlib-tgt-mingw.adb @@ -31,13 +31,15 @@ -- This is the Windows version of the body. Works only with GCC versions -- supporting the "-shared" option. +with Ada.Characters.Handling; use Ada.Characters.Handling; +with Ada.Text_IO; use Ada; use Ada.Text_IO; +with GNAT.OS_Lib; use GNAT.OS_Lib; + with Namet; use Namet; with Opt; with Output; use Output; with Prj.Com; -with GNAT.OS_Lib; use GNAT.OS_Lib; - with MLib.Fil; with MLib.Utl; @@ -111,7 +113,6 @@ package body MLib.Tgt is is pragma Unreferenced (Foreign); pragma Unreferenced (Afiles); - pragma Unreferenced (Auto_Init); pragma Unreferenced (Symbol_Data); pragma Unreferenced (Interfaces); pragma Unreferenced (Lib_Version); @@ -128,12 +129,149 @@ package body MLib.Tgt is Write_Line (Lib_File); end if; - Tools.Gcc - (Output_File => Lib_File, - Objects => Ofiles, - Options => Tools.No_Argument_List, - Options_2 => Options & Options_2, - Driver_Name => Driver_Name); + -- Generate auto-init routine if in Auto_Init mode + + if Auto_Init then + declare + Compile_Only : aliased String := "-c"; + GCC : constant String_Access := + Locate_Exec_On_Path ("gcc.exe"); + Filename : constant String := To_Lower (Lib_Filename); + Autoinit_Spec : constant String := Filename & "_autoinit.ads"; + Autoinit_Body : aliased String := Filename & "_autoinit.adb"; + Autoinit_Obj : aliased String := Filename & "_autoinit.o"; + Autoinit_Ali : constant String := Filename & "_autoinit.ali"; + Init_Proc : constant String := Lib_Filename & "init"; + Final_Proc : constant String := Lib_Filename & "final"; + Autoinit_Opt : constant Argument_List := + (1 => Autoinit_Obj'Unchecked_Access); + Arguments : constant Argument_List (1 .. 2) := + (Compile_Only'Unchecked_Access, + Autoinit_Body'Unchecked_Access); + File : Text_IO.File_Type; + Success : Boolean; + + begin + if Opt.Verbose_Mode then + Write_Str ("Creating auto-init Ada file """); + Write_Str (Autoinit_Spec); + Write_Str (""" and """); + Write_Str (Autoinit_Body); + Write_Line (""""); + end if; + + -- Create the spec + + Create (File, Out_File, Autoinit_Spec); + + Put_Line (File, "package " & Lib_Filename & "_autoinit is"); + New_Line (File); + Put_Line (File, " type HINSTANCE is new Integer;"); + Put_Line (File, " type DWORD is new Integer;"); + Put_Line (File, " type LPVOID is new Integer;"); + Put_Line (File, " type BOOL is new Integer;"); + New_Line (File); + Put_Line (File, " function DllMain"); + Put_Line (File, " (hinstdll : HINSTANCE;"); + Put_Line (File, " fdwreason : DWORD;"); + Put_Line (File, " lpvreserved : LPVOID)"); + Put_Line (File, " return BOOL;"); + Put_Line + (File, " pragma Export (Stdcall, DllMain, ""DllMain"");"); + New_Line (File); + Put_Line (File, "end " & Lib_Filename & "_autoinit;"); + + Close (File); + + -- Create the body + + Create (File, Out_File, Autoinit_Body); + + Put_Line (File, "package body " & Lib_Filename & "_autoinit is"); + New_Line (File); + Put_Line (File, " DLL_PROCESS_DETACH : constant := 0;"); + Put_Line (File, " DLL_PROCESS_ATTACH : constant := 1;"); + Put_Line (File, " DLL_THREAD_ATTACH : constant := 2;"); + Put_Line (File, " DLL_THREAD_DETACH : constant := 3;"); + New_Line (File); + Put_Line (File, " procedure " & Init_Proc & ";"); + Put (File, " pragma Import (C, " & Init_Proc); + Put_Line (File, ", """ & Init_Proc & """);"); + New_Line (File); + Put_Line (File, " procedure " & Final_Proc & ";"); + Put (File, " pragma Import (C, " & Final_Proc); + Put_Line (File, ", """ & Final_Proc & """);"); + New_Line (File); + Put_Line (File, " function DllMain"); + Put_Line (File, " (hinstdll : HINSTANCE;"); + Put_Line (File, " fdwreason : DWORD;"); + Put_Line (File, " lpvreserved : LPVOID)"); + Put_Line (File, " return BOOL"); + Put_Line (File, " is"); + Put_Line (File, " pragma Unreferenced (hinstDLL);"); + Put_Line (File, " pragma Unreferenced (lpvReserved);"); + Put_Line (File, " begin"); + Put_Line (File, " case fdwReason is"); + Put_Line (File, " when DLL_PROCESS_ATTACH =>"); + Put_Line (File, " " & Init_Proc & ";"); + Put_Line (File, " when DLL_PROCESS_DETACH =>"); + Put_Line (File, " " & Final_Proc & ";"); + Put_Line (File, " when DLL_THREAD_ATTACH =>"); + Put_Line (File, " null;"); + Put_Line (File, " when DLL_THREAD_DETACH =>"); + Put_Line (File, " null;"); + Put_Line (File, " when others =>"); + Put_Line (File, " null;"); + Put_Line (File, " end case;"); + Put_Line (File, " return 1;"); + Put_Line (File, " exception"); + Put_Line (File, " when others =>"); + Put_Line (File, " return 0;"); + Put_Line (File, " end DllMain;"); + New_Line (File); + Put_Line (File, "end " & Lib_Filename & "_autoinit;"); + + Close (File); + + -- Compile the auto-init file + + Spawn (GCC.all, Arguments, Success); + + if not Success then + Fail ("unable to compile the auto-init unit for library """, + Lib_Filename, """"); + end if; + + -- Build the SAL library + + Tools.Gcc + (Output_File => Lib_File, + Objects => Ofiles, + Options => Tools.No_Argument_List, + Options_2 => Options & Options_2 & Autoinit_Opt, + Driver_Name => Driver_Name); + + -- Remove generated files + + if Opt.Verbose_Mode then + Write_Str ("deleting auto-init generated files"); + Write_Eol; + end if; + + Delete_File (Autoinit_Spec, Success); + Delete_File (Autoinit_Body, Success); + Delete_File (Autoinit_Obj, Success); + Delete_File (Autoinit_Ali, Success); + end; + + else + Tools.Gcc + (Output_File => Lib_File, + Objects => Ofiles, + Options => Tools.No_Argument_List, + Options_2 => Options & Options_2, + Driver_Name => Driver_Name); + end if; end Build_Dynamic_Library; ------------- @@ -195,8 +333,7 @@ package body MLib.Tgt is ------------------------ function Library_Exists_For - (Project : Project_Id; In_Tree : Project_Tree_Ref) return Boolean - is + (Project : Project_Id; In_Tree : Project_Tree_Ref) return Boolean is begin if not In_Tree.Projects.Table (Project).Library then Prj.Com.Fail ("INTERNAL ERROR: Library_Exists_For called " & @@ -235,8 +372,7 @@ package body MLib.Tgt is function Library_File_Name_For (Project : Project_Id; - In_Tree : Project_Tree_Ref) return Name_Id - is + In_Tree : Project_Tree_Ref) return Name_Id is begin if not In_Tree.Projects.Table (Project).Library then Prj.Com.Fail ("INTERNAL ERROR: Library_File_Name_For called " & @@ -291,7 +427,7 @@ package body MLib.Tgt is function Standalone_Library_Auto_Init_Is_Supported return Boolean is begin - return False; + return True; end Standalone_Library_Auto_Init_Is_Supported; ---------------------------