MycLib/Src/Myc.Atomic.pas

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.