Skip to content

Add atomic operation functions to improve code compatibility with Delphi XE2 #49

New issue

Have a question about this project? Sign up for a free GitHub account to open an issue and contact its maintainers and the community.

Sign up for GitHub

By clicking “Sign up for GitHub”, you agree to our terms of service and privacy statement. We’ll occasionally send you account related emails.

Already on GitHub? Sign in to your account

Open
delphilite wants to merge 8 commits into
base: master
Choose a base branch
from
Open

Add atomic operation functions to improve code compatibility with Delphi XE2 #49

Changes from all commits
Commits
Show all changes
8 commits
Select commit Hold shift + click to select a range
0d27336
Add atomic operation functions to improve code compatibility with Del…
delphilite Apr 19, 2024
93a360b
Merge branch 'pleriche:master' into master
delphilite May 3, 2024
abddd60
Merge branch 'pleriche:master' into master
delphilite Feb 11, 2025
d131e2b
Merge branch 'pleriche:master' into master
delphilite Mar 31, 2025
4372e66
Merge branch 'pleriche:master' into master
delphilite Aug 2, 2025
2f92bd7
Merge branch 'pleriche:master' into master
delphilite Aug 17, 2025
98b1419
Merge branch 'pleriche:master' into master
delphilite Sep 11, 2025
fd91b1c
Merge branch 'pleriche:master' into master
delphilite Mar 2, 2026
File filter

Filter by extension

Filter by extension
Conversations
Failed to load comments.
Loading
Jump to
Jump to file
Failed to load files.
Loading
Diff view
Diff view
246 changes: 232 additions & 14 deletions FastMM5.pas
View file
Open in desktop
Original file line number Diff line number Diff line change
Expand Up @@ -200,7 +200,7 @@ interface
{$define 64Bit}
{$else}
{$define 32Bit}
{$endif}
{$ifend}

{$ifdef CPUX86}
{$ifndef PurePascal}
Expand Down Expand Up @@ -289,7 +289,7 @@ interface
CFastMM_SmallBlockArenaCount = 4;
CFastMM_MediumBlockArenaCount = 4;
CFastMM_LargeBlockArenaCount = 8;
{$endif}
{$ifend}

{The default name of the debug support library.}
CFastMM_DefaultDebugSupportLibraryName = {$ifndef 64Bit}'FastMM_FullDebugMode.dll'{$else}'FastMM_FullDebugMode64.dll'{$endif};
Expand Down Expand Up @@ -2427,6 +2427,224 @@ procedure MoveMultipleOf64_Large(const ASource; var ADest; ACount: NativeInt);
{$endif}
end;

{------------------------------------------}
{--------Atomic calls for Delphi XE2-------}
{------------------------------------------}

{$IF RTLVersion < 24.00}

function AtomicIncrement(var Target: Cardinal): Cardinal; overload;
asm
{$IFDEF CPUX64}
// --> RCX Target
// <-- EAX Result
MOV EAX, 1
LOCK XADD [RCX], EAX
INC EAX
{$ELSE}
// --> EAX Target
// <-- EAX Result
MOV ECX, EAX
MOV EAX, 1
LOCK XADD [ECX], EAX
INC EAX
{$ENDIF}
end;

function AtomicIncrement(var Target: Integer): Integer; overload;
asm
{$IFDEF CPUX64}
// --> RCX Target
// <-- EAX Result
MOV EAX, 1
LOCK XADD [RCX], EAX
INC EAX
{$ELSE}
// --> EAX Target
// <-- EAX Result
MOV ECX, EAX
MOV EAX, 1
LOCK XADD [ECX], EAX
INC EAX
{$ENDIF}
end;

function AtomicIncrement(var Target: NativeUInt; Value: NativeUInt): NativeUInt; overload;
asm
{$IFDEF CPUX64}
// --> RCX Target
// RDX Value
// <-- RAX Result
MOV RAX, RDX
LOCK XADD [RCX], RAX
ADD RAX, RDX
{$ELSE}
// --> EAX Target
// EDX Value
// <-- EAX Result
MOV ECX, EAX
MOV EAX, EDX
LOCK XADD [ECX], EAX
ADD EAX, EDX
{$ENDIF}
end;

function AtomicDecrement(var Target: Integer): Integer; overload;
asm
{$IFDEF CPUX64}
// --> RCX Target
// <-- EAX Result
MOV EAX, -1
LOCK XADD [RCX], EAX
DEC EAX
{$ELSE}
// --> EAX Target
// <-- EAX Result
MOV ECX, EAX
MOV EAX, -1
LOCK XADD [ECX], EAX
DEC EAX
{$ENDIF}
end;

function AtomicDecrement(var Target: NativeUInt; Value: NativeUInt): NativeUInt; overload;
asm
{$IFDEF CPUX64}
// --> RCX Target
// RDX Value
// <-- RAX Result
NEG RDX
MOV RAX, RDX
LOCK XADD [RCX], RAX
ADD RAX, RDX
{$ELSE}
// --> EAX Target
// EDX Value
// <-- EAX Result
MOV ECX, EAX
NEG EDX
MOV EAX, EDX
LOCK XADD [ECX], EAX
ADD EAX, EDX
{$ENDIF}
end;

function AtomicExchange(var Target: Integer; Value: Integer): Integer; overload;
asm
{$IFDEF CPUX64}
// --> RCX Target
// EDX Value
// <-- EAX Result
MOV EAX, EDX
// RCX Target
// EAX Value
LOCK XCHG [RCX], EAX
{$ELSE}
// --> EAX Target
// EDX Value
// <-- EAX Result
MOV ECX, EAX
MOV EAX, EDX
// ECX Target
// EAX Value
LOCK XCHG [ECX], EAX
{$ENDIF}
end;

function AtomicExchange(var Target: Pointer; Value: Pointer): Pointer; overload;
asm
{$IFDEF CPUX64}
// --> RCX Target
// RDX Value
// <-- RAX Result
MOV RAX, RDX
LOCK XCHG [RCX], RAX
{$ELSE}
// --> EAX Target
// EDX Value
// <-- EAX Result
MOV ECX, EAX
MOV EAX, EDX
// ECX Target
// EAX Value
LOCK XCHG [ECX], EAX
{$ENDIF}
end;

function AtomicCmpExchange(var Target: Integer; Value: Integer; Compare: Integer): Integer; overload;
asm
{$IFDEF CPUX64}
// --> RCX Target
// EDX Value
// R8 Compare
// <-- EAX Result
MOV RAX, R8
// RCX Target
// EDX Value
// RAX Compare
LOCK CMPXCHG [RCX], EDX
{$ELSE}
// --> EAX Target
// EDX Value
// ECX Compare
// <-- EAX Result
XCHG EAX, ECX
// EAX Compare
// EDX Value
// ECX Target
LOCK CMPXCHG [ECX], EDX
{$ENDIF}
end;

function AtomicCmpExchange(var Target: Int64; Value: Int64; Compare: Int64): Int64; overload;
asm
{$IFDEF CPUX64}
// --> RCX Target
// RDX Value
// R8 Compare
// <-- RAX Result
MOV RAX, R8
LOCK CMPXCHG [RCX], RDX
{$ELSE}
PUSH EBX
PUSH EDI
MOV EDI, EAX // Target
MOV EAX, DWORD PTR [Compare]
MOV EDX, DWORD PTR [Compare+4]
MOV EBX, DWORD PTR [Value]
MOV ECX, DWORD PTR [Value+4]
LOCK CMPXCHG8B QWORD PTR [EDI]
POP EDI
POP EBX
{$ENDIF}
end;

function AtomicCmpExchange(var Target: Pointer; Value: Pointer; Compare: Pointer): Pointer; overload;
asm
{$IFDEF CPUX64}
// --> RCX Target
// RDX Value
// R8 Compare
// <-- RAX Result
MOV RAX, R8
// RCX Target
// RDX Value
// RAX Compare
LOCK CMPXCHG [RCX], RDX
{$ELSE}
// --> EAX Target
// EDX Value
// ECX Compare
// <-- EAX Result
XCHG EAX, ECX
// EAX Comp
// EDX Value
// ECX Target
LOCK CMPXCHG [ECX], EDX
{$ENDIF}
end;

{$IFEND}

{------------------------------------------}
{---------Operating system calls-----------}
Expand Down Expand Up @@ -4058,7 +4276,7 @@ function CountTrailingZeros32(AInteger: Integer): Integer;
{$endif}
bsf eax, eax
end;
{$endif}
{$ifend}

{Returns True if the block is not in use.}
function BlockIsFree(APSmallMediumOrLargeBlock: Pointer): Boolean; inline;
Expand Down Expand Up @@ -4606,7 +4824,7 @@ function FastMM_FreeMem_FreeLargeBlock_ReleaseVM(APLargeBlockHeader: PLargeBlock
LRemainingSize := NativeUInt(APLargeBlockHeader.ActualBlockSize);
{$if CompilerVersion < 31}
Result := 0; //Workaround for spurious warning with older compilers
{$endif}
{$ifend}
while True do
begin
OS_GetVirtualMemoryRegionInfo(LPCurrentSegment, LMemoryRegionInfo);
Expand Down Expand Up @@ -9872,7 +10090,7 @@ procedure FastMM_PerformMemoryLeakCheck_AddBlockToLeakSummary(APLeakSummary: PMe
begin
{$if CompilerVersion < 31}
LChildDirection := False; //Workaround for spurious warning with older compilers
{$endif}
{$ifend}
while True do
begin
LPSummaryEntry := @APLeakSummary.MemoryLeakEntries[i];
Expand Down Expand Up @@ -10309,20 +10527,20 @@ procedure FastMM_InitializeMemoryManager;
begin
{---------Bug checks-------}

{$if CSmallBlockHeaderSize <> 2} {$message error 'Small block header size must be 2 bytes'} {$endif}
{$if CMediumBlockHeaderSize <> 8} {$message error 'Medium block header size must be 8 bytes'} {$endif}
{$if CLargeBlockHeaderSize and 63 <> 0} {$message error 'Large block header size must be multiple of 64 bytes'} {$endif}
{$if CSmallBlockHeaderSize <> 2} {$message error 'Small block header size must be 2 bytes'} {$ifend}
{$if CMediumBlockHeaderSize <> 8} {$message error 'Medium block header size must be 8 bytes'} {$ifend}
{$if CLargeBlockHeaderSize and 63 <> 0} {$message error 'Large block header size must be multiple of 64 bytes'} {$ifend}
{In order to ensure minimum alignment is always honoured the debug block header must be a multiple of 64.}
{$if CDebugBlockHeaderSize and 63 <> 0} {$message error 'Debug block header must be a multiple of 64 bytes'} {$endif}
{$if CDebugBlockHeaderSize and 63 <> 0} {$message error 'Debug block header must be a multiple of 64 bytes'} {$ifend}

{Span headers have to be a multiple of 64 bytes in order to ensure that 64-byte alignment of user data is possible.}
{$if CSmallBlockSpanHeaderSize and 63 <> 0} {$message error 'Small block span header size must be multiple of 64 bytes'} {$endif}
{$if CMediumBlockSpanHeaderSize and 63 <> 0} {$message error 'Medium block span header size must be multiple of 64 bytes'} {$endif}
{$if CSmallBlockSpanHeaderSize and 63 <> 0} {$message error 'Small block span header size must be multiple of 64 bytes'} {$ifend}
{$if CMediumBlockSpanHeaderSize and 63 <> 0} {$message error 'Medium block span header size must be multiple of 64 bytes'} {$ifend}

{$if CSmallBlockManagerSize and 63 <> 0} {$message error 'Small block manager size must be a multiple of 64 bytes'} {$endif}
{$if CSmallBlockManagerSize <> (1 shl CSmallBlockManagerSizeBits)} {$message error 'Small block manager size mismatch'} {$endif}
{$if CSmallBlockManagerSize and 63 <> 0} {$message error 'Small block manager size must be a multiple of 64 bytes'} {$ifend}
{$if CSmallBlockManagerSize <> (1 shl CSmallBlockManagerSizeBits)} {$message error 'Small block manager size mismatch'} {$ifend}

{$if CLargeBlockManagerSize and 63 <> 0} {$message error 'Large block manager size must be a multiple of 64 bytes'} {$endif}
{$if CLargeBlockManagerSize and 63 <> 0} {$message error 'Large block manager size must be a multiple of 64 bytes'} {$ifend}

{---------General configuration-------}

Expand Down