unit sfContnrs;

interface

{$DEFINE MULTI_THREAD_QUEUE} //线程安全版本,如果不需要线程安全,请注释掉此行代码

{$IFDEF MULTI_THREAD_QUEUE}
uses
    Windows;
{$ENDIF}

type
  TsfQueue=class
  private
    FCapacity:Integer;
    FTmpBuff:Pointer;
    FBuff:Pointer;
    FPosition:Integer;
  {$IFDEF MULTI_THREAD_QUEUE}
    FCS:TRTLCriticalSection;
  {$ENDIF}
    //\\
    FPushIndex:Integer;
    FPopIndex:Integer;

procedure Lock();
    procedure UnLock();
    procedure Inernal_SetCapacity(const Value:Integer);
    //\\
    procedure setCapacity(const Value: Integer);
    function getCapacity: Integer;
  public
    constructor Create(InitCapacity: Integer=1024);
    destructor  Destroy();override;
    //\\
    function Push(AItem: Pointer): Pointer;
    function Pop(): Pointer;
  public
    property Capacity:Integer read getCapacity write setCapacity;
  end;

implementation

{ TsfQueue }

constructor TsfQueue.Create(InitCapacity:Integer);
begin
  {$IFDEF MULTI_THREAD_QUEUE}
     InitializeCriticalSection(FCS);
  {$ENDIF}

if InitCapacity < 1024 then InitCapacity := 1024;

Inernal_SetCapacity(InitCapacity);

end;

destructor TsfQueue.Destroy;
begin
  FreeMem(FBuff);
  if FTmpBuff <> nil then
    FreeMem(FTmpBuff);
  //\\
  {$IFDEF MULTI_THREAD_QUEUE}
     DeleteCriticalSection(FCS);
  {$ENDIF}

inherited;
end;

procedure TsfQueue.Lock;
begin
  {$IFDEF MULTI_THREAD_QUEUE}
     EnterCriticalSection(FCS);
  {$ENDIF}
end;

procedure TsfQueue.UnLock;
begin
  {$IFDEF MULTI_THREAD_QUEUE}
      LeaveCriticalSection(FCS);
  {$ENDIF}
end;

procedure TsfQueue.Inernal_SetCapacity(const Value: Integer);
var
  PageCount,ASize:Integer;
begin
    if Value > FCapacity then
    begin
      if FTmpBuff <> nil then
        FreeMem(FTmpBuff);

//扩容
      ASize := Value * 4;//计算出所需要的字节数量
      Pagecount := ASize div 4096;
      if (ASize mod 4096) > 0 then Inc(PageCount);

//转移数据
      GetMem(FTmpBuff,PageCount * 4096);
      FillChar(FTmpBuff^,PageCount * 4096,#0);

if FBuff <> nil then
      begin
        Move(FBuff^,FTmpBuff^,FCapacity * 4);
        FreeMem(FBuff);
      end;

FBuff := FTmpBuff;

//计算新的容量
      FCapacity := (PageCount * 4096) div 4;

if FCapacity >= 2048 then
      begin
         //FTmpBuff 分配用于Pop时候,移动内存用
         GetMem(FTmpBuff,PageCount * 4096);
      end
      else
        FTmpBuff := nil;
    end;
end;

function TsfQueue.Pop: Pointer;
  procedure AdjuestMem();
  var
    pSrc:PInteger;
    pTmp:Pointer;
  begin
    FillChar(FTmpBuff^,FCapacity * 4,#0);
    pSrc := PInteger(FBuff);
    Inc(pSrc,FPopIndex);
    Move(pSrc^,FTmpBuff^,(FCapacity - FPopIndex) * 4);
    //\\
    //交换指针
    pTmp    := FBuff;
    FBuff   := FTmpBuff;
    FTmpBuff := pTmp;
    //\\
  end;

const
    _MoveRange_ = 2048;

var
  P:PInteger;
begin
  Lock();
  try
    Result := nil;
    if (FPopIndex = FPushIndex) then
      Exit;
    P := PInteger(FBuff);
    Inc(P,FPopIndex);
    Result := Pointer(P^);
    Inc(FPopIndex);
    //队列底部空余内存达到 8192 整体搬迁
    if FPopIndex = _MoveRange_ then
    begin
      AdjuestMem();
      FPopIndex := 0;
      Dec(FPushIndex,_MoveRange_);
    end;
  finally
    UnLock();
  end;
end;

function TsfQueue.Push(AItem: Pointer): Pointer;
var
  P:PInteger;
begin
  Lock();
  try
    P := PInteger(FBuff);
    Inc(P,FPushIndex);
    P^ := Integer(AItem);
    Inc(FPushIndex);
    if FPushIndex >= FCapacity then
    begin
      //扩容加 1024 个位置
      Inernal_SetCapacity(FCapacity + 1024);
    end;
  finally
    UnLock();
  end;
end;

procedure TsfQueue.setCapacity(const Value: Integer);
begin
  Lock();
  try
    Inernal_SetCapacity(Value);
  finally
    UnLock();
  end;
end;

function TsfQueue.getCapacity: Integer;
begin
  Lock();
  try
    Result := Self.FCapacity;
  finally
    UnLock();
  end;
end;

end.

//测试函数

procedure TfrmMain.btnQueueClick(Sender: TObject);
var
  A:TsfQueue; //优化后的高速队类实现(线程安全)
  B:TQueue;
  Index:Integer;
begin
  A := TsfQueue.Create();
  B := TQueue.Create();
  SW.Start();
  for Index := 1 to 10000 * 2 do
  begin
    b.Push(0);
  end;
  for Index := 1 to 10000 * 2 do
  begin
    b.Pop();
  end;

SW.Stop();

showMessage(IntToStr(SW.ElapsedMiliseconds));

end;

转自:http://www.cnblogs.com/lwm8246/archive/2011/10/06/2200009.html

一个队列类的实现(比delphi自带的速度快70倍)(线程安全版本)的更多相关文章

  1. 10 DelayQueue 延时队列类——Live555源码阅读(一)基本组件类

    这是Live555源码阅读的第一部分,包括了时间类,延时队列类,处理程序描述类,哈希表类这四个大类. 本文由乌合之众 lym瞎编,欢迎转载 www.cnblogs.com/oloroso/ 本文由乌合 ...

  2. C++学习笔记50:队列类模板

    队列是只能向一端添加元素,从另一端删除元素的线性群体 循环队列 在想象中将数组弯曲成环形,元素出队时,后继元素不移动,每当队尾达到数组最后一个元素时,便再回到数组开头. 队列类模板 //Queue.h ...

  3. 控制uniFrame显示的一个管理类

    控制uniFrame显示的一个管理类 (2016-03-29 06:41:17) 转载▼ 标签: delphi 分类: uniGUI 利用uniGUI Frame的机制来搭建项目,是非常好的实现方式, ...

  4. WorldWind源码剖析系列:下载队列类DownloadQueue

    下载队列类DownloadQueue代表具有优先级的下载队列,该类的存储下载请求的数组链表专门按一定的优先级来存储下载请求的.该类的类图如下. 下载队列类DownloadQueue各个字段的含义说明如 ...

  5. 固定尺寸内存块的缓冲队列类及C++实现源代码

    -------------------------------------------------------------------------------- 标题: 固定尺寸内存块的缓冲队列类及实 ...

  6. 有意思的RTL函数RegisterClass(在持久化中,你生成的一个新类的对象,系统并不知道他是如何来的,因此需要你注册)good

    例子1:Delphi中使用纯正的面向对象方法(这个例子最直接) Delphi的VCL技术使很多程序员能够非常快速的入门:程序员门只要简单的拖动再加上少量的几个Pascal语句,呵呵,一个可以运行得非常 ...

  7. PHP用单例模式实现一个数据库类

    使用单例模式的出发点: 1.php的应用主要在于数据库应用, 所以一个应用中会存在大量的数据库操作, 使用单例模式, 则可以避免大量的new 操作消耗的资源. 2.如果系统中需要有一个类来全局控制某些 ...

  8. 使用代码向一个普通的类注入Spring的实例

    转载请在页首注明作者与原文地址 一:应用场景 什么是普通的类,就是没有@Controller,@Service,@Repository,@Component等注解修饰的类,同时xml文件中,也没有相应 ...

  9. 一个Java文件至多包含一个公共类

    编写一个java源文件时,该源文件又称为编译单元.一个java文件可以包含多个类,但至多包含一个公共类,作为编译时该java文件的公用接口,公共类的名字和源文件的名字要相同,源文件名字的格式为[公共类 ...

随机推荐

  1. poj2181 jumping cow

    umping Cows Time Limit: 1000MS   Memory Limit: 65536K Total Submissions: 7579   Accepted: 4559 Descr ...

  2. 去除整站下载文件中的tppabs等冗余代码

    用TeleprotUltra复制了一个网站,结果网页中出现了很多形如tppabs=””的冗余代码,点击vs中的“在文件中查找”图标,打开“查找和替换”对话框,转到“快速替换”,然后进行以下设置: “查 ...

  3. spark完整的数据倾斜解决方案

    1.数据倾斜的原理 2.数据倾斜的现象 3.数据倾斜的产生原因与定位 在执行shuffle操作的时候,大家都知道,我们之前讲解过shuffle的原理. 是按照key,来进行values的数据的输出.拉 ...

  4. FZU-2219 StarCraft(贪心)

     Problem 2219 StarCraft Accept: 294    Submit: 860Time Limit: 1000 mSec    Memory Limit : 32768 KB   ...

  5. 【bzoj2957】【楼房重建】另类的线段树(浅尝ACM-H)

    [pixiv] https://www.pixiv.net/member_illust.php?mode=medium&illust_id=62609346 向大(hei)佬(e)势力学(di ...

  6. jsp笔记3(内置对象)

    jsp脚本中的9个内置对象: 1.application:javax.servlet.ServletContext的实例对象,该实例对象代表jsp所属的web应用本身,可用于在jsp页面或Servle ...

  7. ARM常用汇编指令介绍

    b     跳转指令(跳转范围为32Mb) bl    带返回地址的跳转,指令自动将下一条指令的地址复制到R14寄存器,然后跳转到指定地址去执行,执行完后返回到下一条指令处执行 pc    寄存器R1 ...

  8. Jackson反序列JSON为实体对象出现:no String-argument constructor/factory method to deserialize from String value的问题

    解决方法: 1.JSON字符串中有转义字符,可以替换,也可以直接toString之后清除转移字符. 参考: https://stackoverflow.com/questions/40986738/s ...

  9. easyui text-box multiline

    //多行文本输入框 <input id="payDescribe" class="easyui-textbox" data-options="m ...

  10. Unable to list target platforms. Please make sure the android sdk path is correct. See the Console for more details.

    在android上发布遇到 androidSDK无法找到的问题 http://www.jianshu.com/p/fe4c334ee9fe