paweld/fpc
1
0
Fork 0
mirror of https://gitlab.com/freepascal.org/fpc/source.git synced 2025-09-23 14:49:13 +02:00
Code Issues Packages Projects Releases Wiki Activity

* thread.inc, DoneThread: allow CurrentTM.ReleaseThreadVars to be unassigned and reset ThreadID (in preparation to support Windows native threadvars)

Browse Source 
* win/systhrd.inc: added error checking in several places. Fail with code 226 if resources cannot be allocated, as Delphi does.
* win/syswin.inc, Dll_entry: Don't call DoneThread in PROCESS_DETACH callback, it is redundant because the main thread is finalized by FPC_DO_EXIT. SysReleaseThreadVars is still necessary. Also removed redundant assignments to return value.

git-svn-id: trunk@17992 -
This commit is contained in:
sergei 2011-07-15 23:57:23 +00:00
parent e21749d6d4
commit 5c3aca5148
3 changed files with 23 additions and 13 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

6
rtl/inc/thread.inc
View File

@ -71,7 +71,11 @@ Var
{ Open all stdio fds again } { Open all stdio fds again }
SysFlushStdio; SysFlushStdio;
{$endif FPC_HAS_FEATURE_CONSOLEIO} {$endif FPC_HAS_FEATURE_CONSOLEIO}
CurrentTM.ReleaseThreadVars; { Support platforms where threadvar memory is managed outside of the RTL:
reset ThreadID and allow ReleaseThreadVars to be unassigned }
ThreadID := 0;
if assigned(CurrentTM.ReleaseThreadVars) then
CurrentTM.ReleaseThreadVars;
end; end;
{***************************************************************************** {*****************************************************************************

23
rtl/win/systhrd.inc
View File

@ -121,10 +121,14 @@ var
{ these aren't allocated yet ... } { these aren't allocated yet ... }
{ allocate room on the heap for the thread vars } { allocate room on the heap for the thread vars }
errorsave:=GetLastError; errorsave:=GetLastError;
if tlskey=$ffffffff then
RunError(226);
dataindex:=TlsGetValue(tlskey); dataindex:=TlsGetValue(tlskey);
if dataindex=nil then if dataindex=nil then
begin begin
dataindex:=pointer(LocalAlloc(LMEM_FIXED or LMEM_ZEROINIT,threadvarblocksize)); dataindex:=pointer(LocalAlloc(LMEM_FIXED or LMEM_ZEROINIT,threadvarblocksize));
if dataindex=nil then
RunError(226);
TlsSetValue(tlskey,dataindex); TlsSetValue(tlskey,dataindex);
end; end;
SetLastError(errorsave); SetLastError(errorsave);
@ -150,11 +154,9 @@ var
procedure SysFiniMultithreading; procedure SysFiniMultithreading;
begin begin
if IsMultiThread then if TLSKey<>$ffffffff then
begin TlsFree(TLSKey);
TlsFree(TLSKey); TLSKey:=$ffffffff;
TLSKey:=$ffffffff;
end;
end; end;
function SysRelocateThreadvar(offset : dword) : pointer; function SysRelocateThreadvar(offset : dword) : pointer;
@ -176,9 +178,16 @@ var
procedure SysReleaseThreadVars; procedure SysReleaseThreadVars;
var
p: pointer;
begin begin
LocalFree(TlsGetValue(tlskey)); if TLSKey<>$ffffffff then
TlsSetValue(tlskey, nil); begin
p:=TlsGetValue(tlskey);
if Assigned(p) then
LocalFree(p);
TlsSetValue(tlskey, nil);
end;
end; end;

7
rtl/win/syswin.inc
View File

@ -30,7 +30,7 @@ function Dll_entry{$ifdef FPC_HAS_INDIRECT_MAIN_INFORMATION}(const info : TEntry
EntryInformation:=info; EntryInformation:=info;
{$endif FPC_HAS_INDIRECT_MAIN_INFORMATION} {$endif FPC_HAS_INDIRECT_MAIN_INFORMATION}
IsLibrary:=true; IsLibrary:=true;
Dll_entry:=false; Dll_entry:=false; { return value is ignored, except when DLLreason=DLL_PROCESS_ATTACH }
case DLLreason of case DLLreason of
DLL_PROCESS_ATTACH : DLL_PROCESS_ATTACH :
begin begin
@ -61,7 +61,6 @@ function Dll_entry{$ifdef FPC_HAS_INDIRECT_MAIN_INFORMATION}(const info : TEntry
if assigned(Dll_Thread_Attach_Hook) then if assigned(Dll_Thread_Attach_Hook) then
Dll_Thread_Attach_Hook(DllParam); Dll_Thread_Attach_Hook(DllParam);
Dll_entry:=true; { return value is ignored }
end; end;
DLL_THREAD_DETACH : DLL_THREAD_DETACH :
begin begin
@ -70,11 +69,9 @@ function Dll_entry{$ifdef FPC_HAS_INDIRECT_MAIN_INFORMATION}(const info : TEntry
{ Release Threadvars } { Release Threadvars }
if TlsGetValue(TLSKey)<>nil then if TlsGetValue(TLSKey)<>nil then
DoneThread; { Assume everything is idempotent there } DoneThread; { Assume everything is idempotent there }
Dll_entry:=true; { return value is ignored }
end; end;
DLL_PROCESS_DETACH : DLL_PROCESS_DETACH :
begin begin
Dll_entry:=true; { return value is ignored }
if MainThreadIDWin32=0 then // already been here. if MainThreadIDWin32=0 then // already been here.
exit; exit;
If SetJmp(DLLBuf) = 0 then If SetJmp(DLLBuf) = 0 then
@ -82,7 +79,7 @@ function Dll_entry{$ifdef FPC_HAS_INDIRECT_MAIN_INFORMATION}(const info : TEntry
if assigned(Dll_Process_Detach_Hook) then if assigned(Dll_Process_Detach_Hook) then
Dll_Process_Detach_Hook(DllParam); Dll_Process_Detach_Hook(DllParam);
DoneThread; SysReleaseThreadVars;
{ Free TLS resources used by ThreadVars } { Free TLS resources used by ThreadVars }
SysFiniMultiThreading; SysFiniMultiThreading;
MainThreadIDWin32:=0; MainThreadIDWin32:=0;