unit Myc.Atomic; interface uses Myc.Heap; type IAtomicStack = interface function Pop: T; function TryPop( out Item: T ): Boolean; procedure Push( const Data: T ); end; TMycAtomicStack = class( TInterfacedObject, IAtomicStack ) 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.Create; begin inherited Create; FSList := TSList.Create; end; destructor TMycAtomicStack.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.Alloc: PItem; begin Result := AllocMem( sizeof( TItem ) ); end; function TMycAtomicStack.Pop: T; begin if not TryPop( Result ) then Result := Default ( T ); end; function TMycAtomicStack.PopPtr: PItem; begin Result := PItem( FSList.Pop ); end; procedure TMycAtomicStack.Push(const Data: T); var Item: PItem; begin Item := Alloc; Item.Data := Data; PushPtr( Item ); end; procedure TMycAtomicStack.PushPtr(Item: PItem); begin FSList.Push( PSListEntry(Item) ); end; function TMycAtomicStack.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.