paweld/fpc
1
0
Fork 0
mirror of https://gitlab.com/freepascal.org/fpc/source.git synced 2025-04-06 18:47:56 +02:00
Code Issues Packages Projects Releases Wiki Activity

+ RTMSupport function

Browse Source 
+ if available use RTM to support InterlockedCompareExchange128 on i386

git-svn-id: trunk@47833 -
This commit is contained in:
florian 2020-12-22 22:00:08 +00:00
parent da468719df
commit 4f05523db9
3 changed files with 71 additions and 26 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

35
rtl/i386/cpu.pp
View File

@ -14,6 +14,7 @@
**********************************************************************}
{$mode objfpc}
{$goto on}
unit cpu;
interface
@ -41,6 +42,7 @@ unit cpu;
function MOVBESupport: boolean;inline;
function F16CSupport: boolean;inline;
function RDRANDSupport: boolean;inline;
function RTMSupport: boolean;inline;
var
is_sse3_cpu : boolean = false;
@ -60,12 +62,29 @@ unit cpu;
_SSE42Support,
_MOVBESupport,
_F16CSupport,
_RDRANDSupport: boolean;
_RDRANDSupport,
_RTMSupport: boolean;
function InterlockedCompareExchange128(var Target: Int128Rec; NewValue: Int128Rec; Comperand: Int128Rec): Int128Rec;
label
Lretry;
begin
RunError(217);
if _RTMSupport then
begin
asm
Lretry:
xbegin Lretry
end;
Result:=Target;
if (Result.Lo=Comperand.Lo) and (Result.Hi=Comperand.Hi) then
Target:=NewValue;
asm
xend
end;
end
else
RunError(217);
end;
@ -163,14 +182,16 @@ unit cpu;
popl %ebx
end;
_AVX2Support:=_AVXSupport and ((_ebx and $20)<>0);
_RTMSupport:=((_ebx and $800)<>0);
end;
end;
function InterlockedCompareExchange128Support : boolean;
begin
{ 32 Bit CPUs have no 128 Bit interlocked exchange support }
result:=false;
{ 32 Bit CPUs have no 128 Bit interlocked exchange support,
but it can simulated using RTM }
result:=_RTMSupport;
end;
@ -234,6 +255,12 @@ unit cpu;
end;
function RTMSupport: boolean;inline;
begin
result:=_RTMSupport;
end;
begin
SetupSupport;
end.

10
rtl/x86_64/cpu.pp
View File

@ -39,6 +39,7 @@ unit cpu;
function MOVBESupport: boolean;inline;
function F16CSupport: boolean;inline;
function RDRANDSupport: boolean;inline;
function RTMSupport: boolean;inline;
var
is_sse3_cpu : boolean = false;
@ -60,7 +61,8 @@ unit cpu;
_SSE42Support,
_MOVBESupport,
_F16CSupport,
_RDRANDSupport: boolean;
_RDRANDSupport,
_RTMSupport: boolean;
function InterlockedCompareExchange128(var Target: Int128Rec; NewValue: Int128Rec; Comperand: Int128Rec): Int128Rec; assembler;
{
@ -179,6 +181,7 @@ unit cpu;
movl %ebx,_ebx
end ['rax','rbx','rcx','rdx'];
_AVX2Support:=_AVXSupport and ((_ebx and $20)<>0);
_RTMSupport:=((_ebx and $800)<>0);
end;
@ -247,6 +250,11 @@ unit cpu;
end;
function RTMSupport: boolean;inline;
begin
result:=_RTMSupport;
end;
begin
SetupSupport;
end.

52
tests/test/tcas128.pp
View File

@ -1,4 +1,4 @@
{ %cpu=x86_64 }
{ %cpu=x86_64,i386 }
{$codealign varmin=16}
@ -9,24 +9,34 @@ var
i1,i2,i3,i4 : int128rec;
begin
writeln('Start');
i1.lo:=11;
i1.hi:=12;
i2.lo:=21;
i2.hi:=22;
i3:=i1;
i4.lo:=0;
i4.hi:=0;
i4:=InterlockedCompareExchange128(i1,i2,i3);
{
writeln(i4.lo);
writeln(i4.hi);
writeln(i1.lo);
writeln(i1.hi);
writeln(i2.lo);
writeln(i2.hi);
}
if (i4.lo<>11) or (i4.hi<>12) or (i1.lo<>i2.lo) or (i1.hi<>i2.hi) then
halt(1);
writeln('ok');
{$ifdef cpui386}
writeln('RTM Support: ',RTMSupport);
if RTMSupport then
begin
{$endif cpui386}
writeln('Start');
i1.lo:=11;
i1.hi:=12;
i2.lo:=21;
i2.hi:=22;
i3:=i1;
i4.lo:=0;
i4.hi:=0;
i4:=InterlockedCompareExchange128(i1,i2,i3);
{
writeln(i4.lo);
writeln(i4.hi);
writeln(i1.lo);
writeln(i1.hi);
writeln(i2.lo);
writeln(i2.hi);
}
if (i4.lo<>11) or (i4.hi<>12) or (i1.lo<>i2.lo) or (i1.hi<>i2.hi) then
halt(1);
writeln('ok');
{$ifdef cpui386}
end
else
writeln('No InterlockedCompareExchange128 support available');
{$endif cpui386}
end.