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

* SysAllocateThreadVars: Make sure the data slot is only allocated once

Browse Source 
git-svn-id: trunk@17891 -
This commit is contained in:
pierre 2011-07-01 10:07:38 +00:00
parent 04d85d32d9
commit 1339c66ec9
1 changed files with 10 additions and 3 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

7
rtl/win/systhrd.inc
View File

@ -113,15 +113,22 @@ var
procedure SysAllocateThreadVars; procedure SysAllocateThreadVars;
var var
dataindex : pointer; dataindex : pointer;
errorsave : dword;
begin begin
{ we've to allocate the memory from system } { we've to allocate the memory from system }
{ because the FPC heap management uses } { because the FPC heap management uses }
{ exceptions which use threadvars but } { exceptions which use threadvars but }
{ 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;
dataindex:=TlsGetValue(tlskey);
if dataindex=nil then
begin
dataindex:=pointer(LocalAlloc(LMEM_FIXED or LMEM_ZEROINIT,threadvarblocksize)); dataindex:=pointer(LocalAlloc(LMEM_FIXED or LMEM_ZEROINIT,threadvarblocksize));
TlsSetValue(tlskey,dataindex); TlsSetValue(tlskey,dataindex);
end; end;
SetLastError(errorsave);
end;
function SysRelocateThreadvar(offset : dword) : pointer; forward; function SysRelocateThreadvar(offset : dword) : pointer; forward;