Win32 and Win64, fixed DLL exit sequence, resolves #14603:

* Unwind to DllEntry context only if called from DllEntry. Otherwise, terminate the entire process, making sure that RTL won't be finalized twice.
* Call DLL_process_detach_hook before RTL is finalized, not after.

git-svn-id: trunk@20367 -

rtl/win/syswin.inc

@@ -246,9 +246,9 @@ const
 
 
 
-Const
-   DLLExitOK : boolean = true;
+
 Var
+  DLLInitState : Longint = -1;
   DLLBuf : Jmp_buf;
 
 function Dll_entry{$ifdef FPC_HAS_INDIRECT_MAIN_INFORMATION}(const info : TEntryInformation){$endif FPC_HAS_INDIRECT_MAIN_INFORMATION} : longbool; [public,alias:'_FPC_DLL_Entry'];
@@ -257,6 +257,7 @@ function Dll_entry{$ifdef FPC_HAS_INDIRECT_MAIN_INFORMATION}(const info : TEntry
      EntryInformation:=info;
 {$endif FPC_HAS_INDIRECT_MAIN_INFORMATION}
      IsLibrary:=true;
+     DllInitState:=DLLreason;
      Dll_entry:=false;  { return value is ignored, except when DLLreason=DLL_PROCESS_ATTACH }
      case DLLreason of
        DLL_PROCESS_ATTACH :
@@ -273,7 +274,7 @@ function Dll_entry{$ifdef FPC_HAS_INDIRECT_MAIN_INFORMATION}(const info : TEntry
                Dll_entry:=true;
              end
            else
-             Dll_entry:=DLLExitOK;
+             Dll_entry:=(ExitCode=0);
          end;
        DLL_THREAD_ATTACH :
          begin
@@ -299,12 +300,14 @@ function Dll_entry{$ifdef FPC_HAS_INDIRECT_MAIN_INFORMATION}(const info : TEntry
          end;
        DLL_PROCESS_DETACH :
          begin
-	   if MainThreadIDWin32=0 then // already been here.
-	     exit;
+           if MainThreadIDWin32=0 then // already been here.
+             exit;
            If SetJmp(DLLBuf) = 0 then
-             FPC_Do_Exit;
-           if assigned(Dll_Process_Detach_Hook) then
-             Dll_Process_Detach_Hook(DllParam);
+             begin
+               if assigned(Dll_Process_Detach_Hook) then
+                 Dll_Process_Detach_Hook(DllParam);
+               InternalExit;
+             end;
 
            SysReleaseThreadVars;
            { Free TLS resources used by ThreadVars }
@@ -312,20 +315,10 @@ function Dll_entry{$ifdef FPC_HAS_INDIRECT_MAIN_INFORMATION}(const info : TEntry
            MainThreadIDWin32:=0;
          end;
      end;
+     DllInitState:=-1;
   end;
 
 
-Procedure ExitDLL(Exitcode : longint);
-  begin
-    DLLExitOK:=ExitCode=0;
-    LongJmp(DLLBuf,1);
-  end;
-
-{$ifdef win64}
-{$include systlsdir.inc}
-{$endif win64}
-
-
 {****************************************************************************
                     Error Message writing using messageboxes
 ****************************************************************************}

rtl/win32/system.pp

@@ -140,6 +140,8 @@ const
 { include system independent routines }
 {$I system.inc}
 
+{ include code common with win64 }
+{$I syswin.inc}
 
 
 {*****************************************************************************
@@ -148,16 +150,22 @@ const
 
 procedure install_exception_handlers;forward;
 procedure remove_exception_handlers;forward;
-procedure fpc_do_exit;stdcall;external name 'FPC_DO_EXIT';
-Procedure ExitDLL(Exitcode : longint); forward;
 
 Procedure system_exit;
 begin
-  { don't call ExitProcess inside
-    the DLL exit code !!
-    This crashes Win95 at least PM }
   if IsLibrary then
-    ExitDLL(ExitCode);
+  begin
+    { If exiting from DLL_PROCESS_ATTACH/DETACH, unwind to DllMain context. }
+    if DllInitState in [DLL_PROCESS_ATTACH,DLL_PROCESS_DETACH] then
+      LongJmp(DLLBuf,1)
+    else
+    { Abnormal termination, Halt has been called from DLL function,
+      put down the entire process (DLL_PROCESS_DETACH will still
+      occur). At this point RTL has been already finalized in InternalExit
+      and shouldn't be finalized another time in DLL_PROCESS_DETACH.
+      Indicate this by resetting MainThreadIdWin32. }
+      MainThreadIDWin32:=0;
+  end;
   if not IsConsole then
    begin
      Close(stderr);
@@ -168,7 +176,8 @@ begin
      { what about Input and Output ?? PM }
      { now handled, FPK }
    end;
-  remove_exception_handlers;
+  if not IsLibrary then
+    remove_exception_handlers;
 
   { do cleanup required by the startup code }
   EntryInformation.asm_exit();
@@ -260,12 +269,6 @@ function is_prefetch(p : pointer) : boolean;
       end;
   end;
 
-{******************************************************************************}
-{ include code common with win64 }
-
-{$I syswin.inc}
-{******************************************************************************}
-
 //
 // Hardware exception handling
 //

rtl/win64/system.pp

@@ -135,16 +135,23 @@ var
 procedure install_exception_handlers;forward;
 {$endif FPC_USE_WIN64_SEH}
 procedure PascalMain;stdcall;external name 'PASCALMAIN';
-procedure fpc_do_exit;stdcall;external name 'FPC_DO_EXIT';
-Procedure ExitDLL(Exitcode : longint); forward;
+
+{ include code common with win32 }
+{$I syswin.inc}
+
+{ TLS directory code }
+{$I systlsdir.inc}
 
 Procedure system_exit;
 begin
-  { don't call ExitProcess inside
-    the DLL exit code !!
-    This crashes Win95 at least PM }
+  { see comments in win32/system.pp about this logic }
   if IsLibrary then
-    ExitDLL(ExitCode);
+  begin
+    if DllInitState in [DLL_PROCESS_ATTACH,DLL_PROCESS_DETACH] then
+      LongJmp(DLLBuf,1)
+    else
+      MainThreadIDWin32:=0;
+  end;
   if not IsConsole then
    begin
      Close(stderr);
@@ -219,9 +226,6 @@ procedure Exe_entry;[public,alias:'_FPC_EXE_Entry'];
      system_exit;
   end;
 
-function Dll_entry{$ifdef FPC_HAS_INDIRECT_MAIN_INFORMATION}(const info : TEntryInformation){$endif FPC_HAS_INDIRECT_MAIN_INFORMATION} : longbool;forward;
-
-
 
 procedure _FPC_DLLMainCRTStartup(_hinstance : qword;_dllreason : dword;_dllparam:Pointer);stdcall;public name '_DLLMainCRTStartup';
 begin
@@ -280,11 +284,6 @@ function is_prefetch(p : pointer) : boolean;
       end;
   end;
 
-{******************************************************************************}
-{ include code common with win64 }
-
-{$I syswin.inc}
-{******************************************************************************}
 
 //
 // Hardware exception handling