Heap Tests

Src/Myc.Atomic.pas

@@ -0,0 +1,108 @@
+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.