一个队列类的实现(比delphi自带的速度快70倍)(线程安全版本)
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倍)(线程安全版本)的更多相关文章
- 10 DelayQueue 延时队列类——Live555源码阅读(一)基本组件类
这是Live555源码阅读的第一部分,包括了时间类,延时队列类,处理程序描述类,哈希表类这四个大类. 本文由乌合之众 lym瞎编,欢迎转载 www.cnblogs.com/oloroso/ 本文由乌合 ...
- C++学习笔记50:队列类模板
队列是只能向一端添加元素,从另一端删除元素的线性群体 循环队列 在想象中将数组弯曲成环形,元素出队时,后继元素不移动,每当队尾达到数组最后一个元素时,便再回到数组开头. 队列类模板 //Queue.h ...
- 控制uniFrame显示的一个管理类
控制uniFrame显示的一个管理类 (2016-03-29 06:41:17) 转载▼ 标签: delphi 分类: uniGUI 利用uniGUI Frame的机制来搭建项目,是非常好的实现方式, ...
- WorldWind源码剖析系列:下载队列类DownloadQueue
下载队列类DownloadQueue代表具有优先级的下载队列,该类的存储下载请求的数组链表专门按一定的优先级来存储下载请求的.该类的类图如下. 下载队列类DownloadQueue各个字段的含义说明如 ...
- 固定尺寸内存块的缓冲队列类及C++实现源代码
-------------------------------------------------------------------------------- 标题: 固定尺寸内存块的缓冲队列类及实 ...
- 有意思的RTL函数RegisterClass(在持久化中,你生成的一个新类的对象,系统并不知道他是如何来的,因此需要你注册)good
例子1:Delphi中使用纯正的面向对象方法(这个例子最直接) Delphi的VCL技术使很多程序员能够非常快速的入门:程序员门只要简单的拖动再加上少量的几个Pascal语句,呵呵,一个可以运行得非常 ...
- PHP用单例模式实现一个数据库类
使用单例模式的出发点: 1.php的应用主要在于数据库应用, 所以一个应用中会存在大量的数据库操作, 使用单例模式, 则可以避免大量的new 操作消耗的资源. 2.如果系统中需要有一个类来全局控制某些 ...
- 使用代码向一个普通的类注入Spring的实例
转载请在页首注明作者与原文地址 一:应用场景 什么是普通的类,就是没有@Controller,@Service,@Repository,@Component等注解修饰的类,同时xml文件中,也没有相应 ...
- 一个Java文件至多包含一个公共类
编写一个java源文件时,该源文件又称为编译单元.一个java文件可以包含多个类,但至多包含一个公共类,作为编译时该java文件的公用接口,公共类的名字和源文件的名字要相同,源文件名字的格式为[公共类 ...
随机推荐
- 【计算机网络】HTTP协议详解
详见:http://blog.csdn.net/gueter/article/details/1524447 不让转载,但写得很好
- Linux操作常识
1.分区 linux如果手动选择分区,必须的两个分区是根分区和swap分区,swap分区是与内存的交换分区,通常设置大小为内存的两倍(如果内存够大也可以不用设置) 2.关机重启 命令:shu ...
- MYSQL的longtext字段能放多少数据?
生产上遇到问题, 同事说MYSQL里的字段放不下5m大小的数据. 于是,将django model里textfield里的max_length变长了. 依然无效, 于是,更改mysql的设置: set ...
- codeforces-103B
题目连接:http://codeforces.com/contest/103/problem/B B. Cthulhu time limit per test 2 seconds memory lim ...
- 洛谷 P1064 金明的预算方案【有依赖的分组背包】
题目描述 金明今天很开心,家里购置的新房就要领钥匙了,新房里有一间金明自己专用的很宽敞的房间.更让他高兴的是,妈妈昨天对他说:"你的房间需要购买哪些物品,怎么布置,你说了算,只要不超过N元钱 ...
- Codeforces Round #191 (Div. 2) A. Flipping Game【*枚举/DP/每次操作可将区间[i,j](1=<i<=j<=n)内牌的状态翻转(即0变1,1变0),求一次翻转操作后,1的个数尽量多】
A. Flipping Game time limit per test 1 second memory limit per test 256 megabytes input standard ...
- 2018 JUST Programming Contest 1.0 题解
题目链接 gym101778 Problem A 转化成绝对值之后算一下概率.这个题有点像 2018 ZOJ Monthly March Problem D ? 不过那个题要难一些~ #includ ...
- poj2774(最长公共子串)
poj2774 题意 求两个字符串的最长公共子串 分析 论文 将两个字符串合并,中间插入分隔符,在找最大的 height 值的时候保证,两个字符串后缀的起始点分别来自原来的两个字符串. code #i ...
- [POI2014]Criminals
题目大意: 给你一个长度为$n(n\le10^6)$的颜色序列,其中每个颜色互不相同.两个人$A$和$B$分别从某个点出发从左往右.从右往左任意地选择颜色,然后在中间的某一点相遇.分别给出两人所选择的 ...
- iOS 7.1 arm64 编辑报错 警告解决办法
昨天把我的4S更新到iOS7.1,今天发下需要更新Xcode到5.1,发现打包项目Archive的时候,多了一堆警告和错误,很是郁闷. 郁闷没有用,作为一个合格的程序员,要学会淡定!看看警告和错误的大 ...