renamed some units, added TMycAtomicStack
This commit is contained in:
Michael Schimmel
@@ -1,108 +0,0 @@
|
||||
unit Myc.Atomic;
|
||||
|
||||
interface
|
||||
|
||||
uses
|
||||
Myc.Heap;
|
||||
|
||||
type
|
||||
IAtomicStack<T> = interface
|
||||
function Pop: T;
|
||||
function TryPop( out Item: T ): Boolean;
|
||||
procedure Push( const Data: T );
|
||||
end;
|
||||
|
||||
TMycAtomicStack<T> = class( TInterfacedObject, IAtomicStack<T> )
|
||||
private
|
||||
type
|
||||
PItem = ^TItem;
|
||||
TItem = packed record
|
||||
Next: Pointer;
|
||||
Data: T;
|
||||
end;
|
||||
|
||||
var
|
||||
FSList: PSList;
|
||||
|
||||
public
|
||||
constructor Create;
|
||||
destructor Destroy; override;
|
||||
function Pop: T; inline;
|
||||
function TryPop(out Item: T): Boolean; inline;
|
||||
procedure Push( const Data: T ); inline;
|
||||
function Alloc: PItem; inline;
|
||||
procedure PushPtr(Item: PItem); inline;
|
||||
function PopPtr: PItem;
|
||||
end;
|
||||
|
||||
implementation
|
||||
|
||||
uses Winapi.Windows;
|
||||
|
||||
constructor TMycAtomicStack<T>.Create;
|
||||
begin
|
||||
inherited Create;
|
||||
FSList := TSList.Create;
|
||||
end;
|
||||
|
||||
destructor TMycAtomicStack<T>.Destroy;
|
||||
var
|
||||
Item: PItem;
|
||||
begin
|
||||
Item := PopPtr;
|
||||
while Item <> nil do
|
||||
begin
|
||||
Item.Data := Default ( T );
|
||||
FreeMem( Item );
|
||||
Item := PopPtr;
|
||||
end;
|
||||
|
||||
FSList.Free;
|
||||
inherited;
|
||||
end;
|
||||
|
||||
function TMycAtomicStack<T>.Alloc: PItem;
|
||||
begin
|
||||
Result := AllocMem( sizeof( TItem ) );
|
||||
end;
|
||||
|
||||
function TMycAtomicStack<T>.Pop: T;
|
||||
begin
|
||||
if not TryPop( Result ) then
|
||||
Result := Default ( T );
|
||||
end;
|
||||
|
||||
function TMycAtomicStack<T>.PopPtr: PItem;
|
||||
begin
|
||||
Result := PItem( FSList.Pop );
|
||||
end;
|
||||
|
||||
procedure TMycAtomicStack<T>.Push(const Data: T);
|
||||
var
|
||||
Item: PItem;
|
||||
begin
|
||||
Item := Alloc;
|
||||
Item.Data := Data;
|
||||
PushPtr( Item );
|
||||
end;
|
||||
|
||||
procedure TMycAtomicStack<T>.PushPtr(Item: PItem);
|
||||
begin
|
||||
FSList.Push( PSListEntry(Item) );
|
||||
end;
|
||||
|
||||
function TMycAtomicStack<T>.TryPop(out Item: T): Boolean;
|
||||
var
|
||||
P: PItem;
|
||||
begin
|
||||
P := PopPtr;
|
||||
Result := P <> nil;
|
||||
if Result then
|
||||
begin
|
||||
Item := P.Data;
|
||||
P.Data := Default ( T );
|
||||
FreeMem( P );
|
||||
end;
|
||||
end;
|
||||
|
||||
end.
|
||||
@@ -0,0 +1,250 @@
|
||||
unit Myc.Core.Atomic;
|
||||
|
||||
interface
|
||||
|
||||
{$align on}
|
||||
uses
|
||||
{$ifndef NO_FASTMM}
|
||||
FastMM5,
|
||||
{$endif}
|
||||
Winapi.Windows;
|
||||
|
||||
type
|
||||
TSListEntry = Winapi.Windows.TSListEntry;
|
||||
PSListEntry = Winapi.Windows.PSListEntry;
|
||||
|
||||
PSList = ^TSList;
|
||||
TSList = packed record
|
||||
private
|
||||
FList: TSListHeader;
|
||||
public
|
||||
// Creates and initializes an aligned SList header.
|
||||
class function Create: PSList; static;
|
||||
// Initializes the SList header for use.
|
||||
procedure Init;
|
||||
// Frees the SList header.
|
||||
procedure Free;
|
||||
// Atomically pushes an entry onto the SList.
|
||||
function Push(ListEntry: PSListEntry): PSListEntry;
|
||||
// Atomically pops an entry from the SList.
|
||||
function Pop: PSListEntry;
|
||||
// Returns the current number of entries in the SList.
|
||||
function QueryDepth: Integer;
|
||||
end;
|
||||
|
||||
TMycAtomicStack<T> = record
|
||||
private type
|
||||
PItem = ^TItem;
|
||||
TItem = packed record
|
||||
Next: TSListEntry;
|
||||
Data: T;
|
||||
end;
|
||||
|
||||
var
|
||||
FSList: PSList;
|
||||
|
||||
public
|
||||
// Initializes the atomic stack, creating the underlying SList.
|
||||
class operator Initialize(out Dest: TMycAtomicStack<T>);
|
||||
// Finalizes the atomic stack, freeing all items and the SList.
|
||||
class operator Finalize(var Dest: TMycAtomicStack<T>);
|
||||
|
||||
// Pops an item from the stack; returns Default(T) if empty.
|
||||
function Pop: T; inline;
|
||||
// Tries to pop an item from the stack; returns true if successful.
|
||||
function TryPop(out Item: T): Boolean; inline;
|
||||
// Pushes an item onto the stack.
|
||||
procedure Push(const Data: T); inline;
|
||||
|
||||
// Allocates an aligned memory block for a stack item.
|
||||
function Alloc: PItem; inline;
|
||||
// Pushes a pre-allocated item pointer onto the SList.
|
||||
procedure PushPtr(Item: PItem); inline;
|
||||
// Pops a raw item pointer from the SList.
|
||||
function PopPtr: PItem; inline;
|
||||
end;
|
||||
|
||||
// Allocates memory with a specified alignment.
|
||||
procedure GetMemAligned(var P; Size: NativeUInt);
|
||||
// Frees memory allocated by GetMemAligned.
|
||||
procedure FreeMemAligned(var P);
|
||||
|
||||
implementation
|
||||
|
||||
const
|
||||
AlignmentBoundary = 16;
|
||||
AlignmentMask = AlignmentBoundary - 1;
|
||||
|
||||
{$ifdef NO_FASTMM}
|
||||
|
||||
const
|
||||
MetaDataSize = SizeOf(Pointer);
|
||||
|
||||
procedure GetMemAligned(var P; Size: NativeUInt);
|
||||
var
|
||||
rawAllocatedPtr: Pointer;
|
||||
alignedUserPtrVal: NativeUInt;
|
||||
rawAllocatedPtrVal: NativeUInt;
|
||||
totalSizeToAllocate: NativeUInt;
|
||||
begin
|
||||
totalSizeToAllocate := Size + MetaDataSize + AlignmentMask;
|
||||
System.GetMem(rawAllocatedPtr, totalSizeToAllocate);
|
||||
if rawAllocatedPtr = nil then
|
||||
begin
|
||||
Pointer(P) := nil;
|
||||
exit;
|
||||
end;
|
||||
rawAllocatedPtrVal := NativeUInt(rawAllocatedPtr);
|
||||
alignedUserPtrVal := (rawAllocatedPtrVal + MetaDataSize + AlignmentMask) and not AlignmentMask;
|
||||
Pointer(P) := Pointer(alignedUserPtrVal);
|
||||
PPointer(alignedUserPtrVal - MetaDataSize)^ := rawAllocatedPtr;
|
||||
Assert((NativeUInt(P) and AlignmentMask) = 0, 'GetMemAligned did not return an aligned pointer.');
|
||||
end;
|
||||
|
||||
procedure FreeMemAligned(var P);
|
||||
var
|
||||
alignedUserPtrVal: NativeUInt;
|
||||
rawAllocatedPtr: Pointer;
|
||||
ptrToRawAllocatedPtr: PPointer;
|
||||
begin
|
||||
if Pointer(P) = nil then
|
||||
exit;
|
||||
alignedUserPtrVal := NativeUInt(P);
|
||||
ptrToRawAllocatedPtr := PPointer(alignedUserPtrVal - MetaDataSize);
|
||||
rawAllocatedPtr := ptrToRawAllocatedPtr^;
|
||||
System.FreeMem(rawAllocatedPtr);
|
||||
Pointer(P) := nil;
|
||||
end;
|
||||
|
||||
{$else}
|
||||
|
||||
procedure GetMemAligned(var P; Size: NativeUInt); inline;
|
||||
begin
|
||||
FastMM_EnterMinimumAddressAlignment(maa16Bytes);
|
||||
try
|
||||
GetMem(Pointer(P), Size);
|
||||
finally
|
||||
FastMM_ExitMinimumAddressAlignment(maa16Bytes);
|
||||
end;
|
||||
end;
|
||||
|
||||
procedure FreeMemAligned(var P); inline;
|
||||
begin
|
||||
FreeMem(Pointer(P));
|
||||
Pointer(P) := nil;
|
||||
end;
|
||||
|
||||
{$endif}
|
||||
|
||||
{ TSList }
|
||||
|
||||
class function TSList.Create: PSList;
|
||||
begin
|
||||
GetMemAligned(Result, SizeOf(TSList));
|
||||
Result.Init;
|
||||
end;
|
||||
|
||||
procedure TSList.Free;
|
||||
var
|
||||
tempSelf: Pointer;
|
||||
begin
|
||||
tempSelf := Pointer(@Self);
|
||||
FreeMemAligned(tempSelf);
|
||||
end;
|
||||
|
||||
procedure TSList.Init;
|
||||
begin
|
||||
Assert((NativeUInt(@FList) and AlignmentMask) = 0, 'TSList.FList member not aligned');
|
||||
InitializeSListHead(@FList);
|
||||
end;
|
||||
|
||||
function TSList.Pop: PSListEntry;
|
||||
begin
|
||||
Result := InterlockedPopEntrySList(@FList);
|
||||
end;
|
||||
|
||||
function TSList.Push(ListEntry: PSListEntry): PSListEntry;
|
||||
begin
|
||||
Assert((NativeUInt(ListEntry) and AlignmentMask) = 0, 'ListEntry to be pushed is not aligned');
|
||||
Result := InterlockedPushEntrySList(@FList, ListEntry);
|
||||
end;
|
||||
|
||||
function TSList.QueryDepth: Integer;
|
||||
begin
|
||||
Result := QueryDepthSList(@FList);
|
||||
end;
|
||||
|
||||
{ TMycAtomicStack<T> }
|
||||
|
||||
class operator TMycAtomicStack<T>.Initialize(out Dest: TMycAtomicStack<T>);
|
||||
begin
|
||||
FSList := TSList.Create;
|
||||
end;
|
||||
|
||||
class operator TMycAtomicStack<T>.Finalize(var Dest: TMycAtomicStack<T>);
|
||||
var
|
||||
item: PItem;
|
||||
begin
|
||||
item := PopPtr;
|
||||
while item <> nil do
|
||||
begin
|
||||
item.Data := Default(T);
|
||||
FreeMemAligned(item);
|
||||
item := PopPtr;
|
||||
end;
|
||||
FSList.Free;
|
||||
end;
|
||||
|
||||
function TMycAtomicStack<T>.Alloc: PItem;
|
||||
begin
|
||||
GetMemAligned(Pointer(Result), SizeOf(TItem));
|
||||
FillChar(Result^, SizeOf(TItem), 0);
|
||||
Result.Data := Default(T);
|
||||
end;
|
||||
|
||||
function TMycAtomicStack<T>.Pop: T;
|
||||
begin
|
||||
if not TryPop(Result) then
|
||||
begin
|
||||
Result := Default(T);
|
||||
end;
|
||||
end;
|
||||
|
||||
function TMycAtomicStack<T>.PopPtr: PItem;
|
||||
begin
|
||||
Result := PItem(FSList.Pop);
|
||||
end;
|
||||
|
||||
procedure TMycAtomicStack<T>.Push(const Data: T);
|
||||
var
|
||||
item: PItem;
|
||||
begin
|
||||
item := Alloc;
|
||||
item.Data := Data;
|
||||
PushPtr(item);
|
||||
end;
|
||||
|
||||
procedure TMycAtomicStack<T>.PushPtr(Item: PItem);
|
||||
begin
|
||||
FSList.Push(PSListEntry(Item));
|
||||
end;
|
||||
|
||||
function TMycAtomicStack<T>.TryPop(out Item: T): Boolean;
|
||||
var
|
||||
currentPItem: PItem;
|
||||
begin
|
||||
currentPItem := PopPtr;
|
||||
Result := currentPItem <> nil;
|
||||
if Result then
|
||||
begin
|
||||
Item := currentPItem.Data;
|
||||
currentPItem.Data := Default(T);
|
||||
FreeMemAligned(currentPItem);
|
||||
end
|
||||
else
|
||||
begin
|
||||
Item := Default(T);
|
||||
end;
|
||||
end;
|
||||
|
||||
end.
|
||||
@@ -1,144 +0,0 @@
|
||||
unit Myc.Heap;
|
||||
|
||||
interface
|
||||
|
||||
{$align on}
|
||||
uses
|
||||
{$ifndef NO_FASTMM}
|
||||
FastMM5,
|
||||
{$endif}
|
||||
Winapi.Windows;
|
||||
|
||||
type
|
||||
TSListEntry = Winapi.Windows.TSListEntry;
|
||||
PSListEntry = Winapi.Windows.PSListEntry;
|
||||
|
||||
PSList = ^TSList;
|
||||
TSList = packed record
|
||||
private
|
||||
FList: TSListHeader;
|
||||
|
||||
public
|
||||
class function Create: PSList; static;
|
||||
procedure Init;
|
||||
procedure Free;
|
||||
function Push( ListEntry: PSListEntry ): PSListEntry;
|
||||
function Pop: PSListEntry;
|
||||
function QueryDepth: Integer;
|
||||
end;
|
||||
|
||||
procedure GetMemAligned( var P; Size: NativeUInt );
|
||||
procedure FreeMemAligned( var P );
|
||||
|
||||
procedure InitializeSListHead( ListHead: PSListHeader ); stdcall; external kernel32;
|
||||
function InterlockedPushEntrySList( ListHead: PSListHeader; ListEntry: PSListEntry ): PSListEntry; stdcall; external kernel32;
|
||||
function InterlockedPopEntrySList( ListHead: PSListHeader ): PSListEntry; stdcall; external kernel32;
|
||||
function QueryDepthSList( ListHead: PSListHeader ): Word; stdcall; external kernel32;
|
||||
|
||||
implementation
|
||||
|
||||
const
|
||||
// Defines the alignment boundary (16 bytes for SList and common SIMD operations)
|
||||
AlignmentBoundary = 16;
|
||||
// Mask to achieve alignment, (AlignmentBoundary - 1)
|
||||
AlignmentMask = AlignmentBoundary - 1;
|
||||
|
||||
{$ifdef NO_FASTMM}
|
||||
|
||||
const
|
||||
MetaDataSize = SizeOf(Pointer);
|
||||
|
||||
procedure GetMemAligned(var P; Size: NativeUInt);
|
||||
var
|
||||
rawAllocatedPtr: Pointer;
|
||||
alignedUserPtrVal: NativeUInt;
|
||||
rawAllocatedPtrVal: NativeUInt;
|
||||
totalSizeToAllocate: NativeUInt;
|
||||
begin
|
||||
totalSizeToAllocate := Size + MetaDataSize + AlignmentMask;
|
||||
System.GetMem(rawAllocatedPtr, totalSizeToAllocate);
|
||||
if rawAllocatedPtr = nil then
|
||||
begin
|
||||
Pointer(P) := nil;
|
||||
Exit;
|
||||
end;
|
||||
rawAllocatedPtrVal := NativeUInt(rawAllocatedPtr);
|
||||
alignedUserPtrVal := (rawAllocatedPtrVal + MetaDataSize + AlignmentMask) and not AlignmentMask;
|
||||
Pointer(P) := Pointer(alignedUserPtrVal);
|
||||
PPointer(alignedUserPtrVal - MetaDataSize)^ := rawAllocatedPtr;
|
||||
Assert((NativeUInt(P) and AlignmentMask) = 0, 'GetMemAligned did not return an aligned pointer.');
|
||||
end;
|
||||
|
||||
procedure FreeMemAligned( var P );
|
||||
var
|
||||
alignedUserPtrVal: NativeUInt;
|
||||
rawAllocatedPtr: Pointer;
|
||||
ptrToRawAllocatedPtr: PPointer;
|
||||
begin
|
||||
if Pointer(P) = nil then
|
||||
Exit;
|
||||
alignedUserPtrVal := NativeUInt(P);
|
||||
ptrToRawAllocatedPtr := PPointer(alignedUserPtrVal - MetaDataSize);
|
||||
rawAllocatedPtr := ptrToRawAllocatedPtr^;
|
||||
System.FreeMem(rawAllocatedPtr);
|
||||
Pointer(P) := nil;
|
||||
end;
|
||||
|
||||
{$else}
|
||||
|
||||
procedure GetMemAligned(var P; Size: NativeUInt); inline;
|
||||
begin
|
||||
FastMM_EnterMinimumAddressAlignment(maa16Bytes);
|
||||
try
|
||||
GetMem( Pointer(P), Size );
|
||||
finally
|
||||
FastMM_ExitMinimumAddressAlignment(maa16Bytes)
|
||||
end;
|
||||
end;
|
||||
|
||||
procedure FreeMemAligned( var P ); inline;
|
||||
begin
|
||||
FreeMem( Pointer(P) );
|
||||
end;
|
||||
|
||||
{$endif}
|
||||
|
||||
{ TSList }
|
||||
|
||||
class function TSList.Create: PSList;
|
||||
begin
|
||||
GetMemAligned( Result, sizeof( TSList ) );
|
||||
Result.Init;
|
||||
end;
|
||||
|
||||
procedure TSList.Free;
|
||||
var
|
||||
P: Pointer;
|
||||
begin
|
||||
P := @Self;
|
||||
FreeMemAligned( P );
|
||||
end;
|
||||
|
||||
procedure TSList.Init;
|
||||
begin
|
||||
Assert( NativeUInt( @FList ) and AlignmentMask = 0, 'ListHeader not aligned' );
|
||||
InitializeSListHead( @FList );
|
||||
end;
|
||||
|
||||
function TSList.Pop: PSListEntry;
|
||||
begin
|
||||
Result := InterlockedPopEntrySList( @FList );
|
||||
end;
|
||||
|
||||
function TSList.Push( ListEntry: PSListEntry ): PSListEntry;
|
||||
begin
|
||||
Assert( NativeUInt( ListEntry ) and AlignmentMask = 0, 'ListEntry not aligned' );
|
||||
Result := InterlockedPushEntrySList( @FList, ListEntry );
|
||||
end;
|
||||
|
||||
function TSList.QueryDepth: Integer;
|
||||
begin
|
||||
Result := QueryDepthSList( @FList );
|
||||
end;
|
||||
|
||||
end.
|
||||
Reference in New Issue
Block a user