paweld/lazarus
1
0
Fork 0
mirror of https://gitlab.com/freepascal.org/lazarus/lazarus.git synced 2025-09-27 11:50:26 +02:00
Code Issues Packages Projects Releases Wiki Activity

finished TDynamicDataQueue

Browse Source 
git-svn-id: trunk@8847 -
This commit is contained in:
mattias 2006-02-28 15:48:09 +00:00
parent b8881b0c6c
commit 8aac77b3c1
1 changed files with 54 additions and 7 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

59
lcl/dynqueue.pas
View File

@ -22,7 +22,7 @@ unit DynQueue;
interface interface
uses uses
Classes, SysUtils; Classes, SysUtils, LCLProc;
type type
TDynamicQueueItem = record TDynamicQueueItem = record
@ -65,6 +65,7 @@ type
destructor Destroy; override; destructor Destroy; override;
procedure Clear; procedure Clear;
procedure ConsistencyCheck; procedure ConsistencyCheck;
procedure WriteDebugReport(WriteData: Boolean);
function Push(const Buffer; Count: integer): integer;// add to end of queue function Push(const Buffer; Count: integer): integer;// add to end of queue
function Push(AStream: TStream; Count: integer): integer;// add to end of queue function Push(AStream: TStream; Count: integer): integer;// add to end of queue
function Pop(var Buffer; Count: integer): integer; // read from start of queue, remove from queue function Pop(var Buffer; Count: integer): integer; // read from start of queue, remove from queue
@ -105,7 +106,7 @@ begin
NewCapacity:=NewCapacity*2; NewCapacity:=NewCapacity*2;
NewSize:=NewCapacity*SizeOf(Pointer); NewSize:=NewCapacity*SizeOf(Pointer);
GetMem(NewItems,NewSize); GetMem(NewItems,NewSize);
FillChar(NewItems,NewSize,0); FillChar(NewItems^,NewSize,0);
// copy old items // copy old items
DestIndex:=0; DestIndex:=0;
@ -123,6 +124,7 @@ begin
FTopIndex:=0; FTopIndex:=0;
FLastIndex:=DestIndex; FLastIndex:=DestIndex;
FItems:=NewItems; FItems:=NewItems;
FItemCapacity:=NewCapacity;
end; end;
procedure TDynamicDataQueue.AddItem(ItemSize: integer); procedure TDynamicDataQueue.AddItem(ItemSize: integer);
@ -151,11 +153,12 @@ begin
NewIndex:=0; NewIndex:=0;
end; end;
end; end;
if (FItems=nil) or (FItems[NewIndex]<>nil) then RaiseInconsistency; if (FItems=nil) then RaiseInconsistency;
if (FItems[NewIndex]<>nil) then RaiseInconsistency;
FLastIndex:=NewIndex; FLastIndex:=NewIndex;
GetMem(FItems[FLastIndex],SizeOf(TDynamicQueueItem.Size)+ItemSize); GetMem(FItems[FLastIndex],SizeOf(TDynamicQueueItem.Size)+ItemSize);
FItems[FLastIndex]^.Size:=Size; FItems[FLastIndex]^.Size:=ItemSize;
end; end;
function TDynamicDataQueue.CalculateItemSize(ItemSize: integer): integer; function TDynamicDataQueue.CalculateItemSize(ItemSize: integer): integer;
@ -259,7 +262,7 @@ begin
// beware: writing to a stream can raise an exception // beware: writing to a stream can raise an exception
if Dest<>nil then begin if Dest<>nil then begin
System.Move(Source^,Dest^,CurCount); System.Move(Source^,Dest[Result],CurCount);
TransferredCount:=CurCount; TransferredCount:=CurCount;
end else end else
TransferredCount:=AStream.Write(Dest^,CurCount); TransferredCount:=AStream.Write(Dest^,CurCount);
@ -381,11 +384,15 @@ procedure TDynamicDataQueue.ConsistencyCheck;
var var
i: LongInt; i: LongInt;
RealSize: int64; RealSize: int64;
CurSize: LongInt;
begin begin
if Size<0 then Error(''); if Size<0 then Error('');
if FMinimumBlockSize>FMaximumBlockSize then Error('');
if FMinimumBlockSize<16 then Error('');
if (FItems=nil) then begin if (FItems=nil) then begin
if Size<>0 then Error(''); if Size<>0 then Error('');
end else begin end else begin
if FItemCapacity<=0 then Error('');
if Size=0 then Error(''); if Size=0 then Error('');
if FTopIndex<0 then Error(''); if FTopIndex<0 then Error('');
if FLastIndex<0 then Error(''); if FLastIndex<0 then Error('');
@ -398,7 +405,12 @@ begin
repeat repeat
if FItems[i]=nil then Error(''); if FItems[i]=nil then Error('');
if FItems[i]^.Size<=0 then Error(''); if FItems[i]^.Size<=0 then Error('');
inc(RealSize,FItems[i]^.Size); CurSize:=FItems[i]^.Size;
if FTopIndex=i then
dec(CurSize,FTopItemSpace);
if FLastIndex=i then
dec(CurSize,FLastItemSpace);
inc(RealSize,CurSize);
if i=FLastIndex then break; if i=FLastIndex then break;
inc(i); inc(i);
if i=FItemCapacity then i:=0; if i=FItemCapacity then i:=0;
@ -424,5 +436,40 @@ begin
end; end;
end; end;
procedure TDynamicDataQueue.WriteDebugReport(WriteData: Boolean);
var
i: LongInt;
DataCount: LongInt;
DataOffset: Integer;
begin
writeln('TDynamicDataQueue.WriteDebugReport FItemCapacity=',FItemCapacity,
' FTopIndex=',FTopIndex,' FTopItemSpace=',FTopItemSpace,
' FLastIndex=',FLastIndex,' FLastItemSpace=',FLastItemSpace,
' Size=',Size,
' MinimumBlockSize=',MinimumBlockSize,
' MaximumBlockSize=',MaximumBlockSize);
if FItems<>nil then begin
i:=FTopIndex;
repeat
DataCount:=FItems[i]^.Size;
DataOffset:=0;
if FTopIndex=i then begin
dec(DataCount,FTopItemSpace);
inc(DataOffset,FTopItemSpace);
end;
if i=FLastIndex then
dec(DataCount,FLastItemSpace);
writeln(i,' Item=',HexStr(Cardinal(FItems[i]),8),' Size=',fItems[i]^.Size,' Start=',DataOffset,' Count=',DataCount);
if WriteData then begin
writeln(dbgMemRange(PByte(@FItems[i]^.Data)+DataOffset,DataCount));
end;
if i=FLastIndex then break;
inc(i);
if i=FItemCapacity then i:=0;
until false;
end;
end;
end. end.