paweld/fpc
1
0
Fork 0
mirror of https://gitlab.com/freepascal.org/fpc/source.git synced 2025-09-12 18:09:22 +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 }
SysFlushStdio;
{$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;
{*****************************************************************************

23
rtl/win/systhrd.inc
View File

@ -121,10 +121,14 @@ var
{ these aren't allocated yet ... }
{ allocate room on the heap for the thread vars }
errorsave:=GetLastError;
if tlskey=$ffffffff then
RunError(226);
dataindex:=TlsGetValue(tlskey);
if dataindex=nil then
begin
dataindex:=pointer(LocalAlloc(LMEM_FIXED or LMEM_ZEROINIT,threadvarblocksize));
if dataindex=nil then
RunError(226);
TlsSetValue(tlskey,dataindex);
end;
SetLastError(errorsave);
@ -150,11 +154,9 @@ var
procedure SysFiniMultithreading;
begin
if IsMultiThread then
begin
TlsFree(TLSKey);
TLSKey:=$ffffffff;
end;
if TLSKey<>$ffffffff then
TlsFree(TLSKey);
TLSKey:=$ffffffff;
end;
function SysRelocateThreadvar(offset : dword) : pointer;
@ -176,9 +178,16 @@ var
procedure SysReleaseThreadVars;
var
p: pointer;
begin
LocalFree(TlsGetValue(tlskey));
TlsSetValue(tlskey, nil);
if TLSKey<>$ffffffff then
begin
p:=TlsGetValue(tlskey);
if Assigned(p) then
LocalFree(p);
TlsSetValue(tlskey, nil);
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;
{$endif FPC_HAS_INDIRECT_MAIN_INFORMATION}
IsLibrary:=true;
Dll_entry:=false;
Dll_entry:=false; { return value is ignored, except when DLLreason=DLL_PROCESS_ATTACH }
case DLLreason of
DLL_PROCESS_ATTACH :
begin
@ -61,7 +61,6 @@ function Dll_entry{$ifdef FPC_HAS_INDIRECT_MAIN_INFORMATION}(const info : TEntry
if assigned(Dll_Thread_Attach_Hook) then
Dll_Thread_Attach_Hook(DllParam);
Dll_entry:=true; { return value is ignored }
end;
DLL_THREAD_DETACH :
begin
@ -70,11 +69,9 @@ function Dll_entry{$ifdef FPC_HAS_INDIRECT_MAIN_INFORMATION}(const info : TEntry
{ Release Threadvars }
if TlsGetValue(TLSKey)<>nil then
DoneThread; { Assume everything is idempotent there }
Dll_entry:=true; { return value is ignored }
end;
DLL_PROCESS_DETACH :
begin
Dll_entry:=true; { return value is ignored }
if MainThreadIDWin32=0 then // already been here.
exit;
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
Dll_Process_Detach_Hook(DllParam);
DoneThread;
SysReleaseThreadVars;
{ Free TLS resources used by ThreadVars }
SysFiniMultiThreading;
MainThreadIDWin32:=0;