paweld/fpc
1
0
Fork 0
mirror of https://gitlab.com/freepascal.org/fpc/source.git synced 2025-04-16 20:39:28 +02:00
Code Issues Packages Projects Releases Wiki Activity

+ cardinal/qword overloads for interlocked* routines (mantis #13281)

Browse Source 
git-svn-id: trunk@13127 -
This commit is contained in:
Jonas Maebe 2009-05-10 15:22:38 +00:00
parent 8c3305824a
commit b77bff2996
3 changed files with 52 additions and 0 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

1
.gitattributes vendored
View File

@ -8835,6 +8835,7 @@ tests/webtbs/tw13187.pp svneol=native#text/plain
tests/webtbs/tw13210.pp svneol=native#text/plain
tests/webtbs/tw1323.pp svneol=native#text/plain
tests/webtbs/tw1327.pp svneol=native#text/plain
tests/webtbs/tw13281.pp svneol=native#text/plain
tests/webtbs/tw13307.pp svneol=native#text/plain
tests/webtbs/tw1331.pp svneol=native#text/plain
tests/webtbs/tw13313.pp svneol=native#text/plain

13
rtl/inc/systemh.inc
View File

@ -936,6 +936,19 @@ function InterLockedExchange (var Target: Pointer;Source : Pointer) : Pointer; e
function InterLockedExchangeAdd (var Target: Pointer;Source : Pointer) : Pointer; external name 'FPC_INTERLOCKEDEXCHANGEADD';
function InterlockedCompareExchange(var Target: Pointer; NewValue: Pointer; Comperand: Pointer): Pointer; external name 'FPC_INTERLOCKEDCOMPAREEXCHANGE';
{$endif cpu64}
{ unsigned overloads }
function InterLockedIncrement (var Target: cardinal) : cardinal; external name 'FPC_INTERLOCKEDINCREMENT';
function InterLockedDecrement (var Target: cardinal) : cardinal; external name 'FPC_INTERLOCKEDDECREMENT';
function InterLockedExchange (var Target: cardinal;Source : cardinal) : cardinal; external name 'FPC_INTERLOCKEDEXCHANGE';
function InterLockedExchangeAdd (var Target: cardinal;Source : cardinal) : cardinal; external name 'FPC_INTERLOCKEDEXCHANGEADD';
function InterlockedCompareExchange(var Target: cardinal; NewValue: cardinal; Comperand: cardinal): cardinal; external name 'FPC_INTERLOCKEDCOMPAREEXCHANGE';
{$ifdef cpu64}
function InterLockedIncrement64 (var Target: qword) : qword; external name 'FPC_INTERLOCKEDINCREMENT64';
function InterLockedDecrement64 (var Target: qword) : qword; external name 'FPC_INTERLOCKEDDECREMENT64';
function InterLockedExchange64 (var Target: qword;Source : qword) : qword; external name 'FPC_INTERLOCKEDEXCHANGE64';
function InterLockedExchangeAdd64 (var Target: qword;Source : qword) : qword; external name 'FPC_INTERLOCKEDEXCHANGEADD64';
function InterlockedCompareExchange64(var Target: qword; NewValue: qword; Comperand: qword): int64; external name 'FPC_INTERLOCKEDCOMPAREEXCHANGE64';
{$endif cpu64}
{*****************************************************************************

38
tests/webtbs/tw13281.pp Normal file
View File

@ -0,0 +1,38 @@
{$ifdef cpu64}
procedure test64;
var
c: qword;
begin
c:=1;
if interlockeddecrement64(c)<>0 then
halt(10);
if interlockedincrement64(c)<>1 then
halt(20);
if interlockedexchange64(c,1234)<>1 then
halt(30);
if InterLockedExchangeAdd64(c,5)<>1234 then
halt(40);
if InterlockedCompareExchange64(c,qword($8000000000000035),1239)<>1239 then
halt(50);
if (c<>qword($8000000000000035)) then
halt(60);
end;
{$endif cpu64}
var
c: cardinal;
begin
c:=1;
if interlockeddecrement(c)<>0 then
halt(1);
if interlockedincrement(c)<>1 then
halt(2);
if interlockedexchange(c,1234)<>1 then
halt(3);
if InterLockedExchangeAdd(c,5)<>1234 then
halt(4);
if InterlockedCompareExchange(c,$80000000,1239)<>1239 then
halt(5);
if (c<>$80000000) then
halt(6);
end.