paweld/fpc
1
0
Fork 0
mirror of https://gitlab.com/freepascal.org/fpc/source.git synced 2025-04-21 11:29:24 +02:00
Code Issues Packages Projects Releases Wiki Activity

* Merging revisions r43473 from trunk:

Browse Source 
------------------------------------------------------------------------
    r43473 | michael | 2019-11-15 15:12:11 +0100 (Fri, 15 Nov 2019) | 1 line
    
    * Fix bug #0036270: optimize TFPSList.AddList and .Assign
    ------------------------------------------------------------------------

git-svn-id: branches/fixes_3_2@43749 -
This commit is contained in:
michael 2019-12-23 13:43:40 +00:00
parent dccde4e0df
commit a51130badd
1 changed files with 54 additions and 7 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

61
rtl/objpas/fgl.pp
View File

@ -41,6 +41,8 @@ type
TFPSList = class;
TFPSListCompareFunc = function(Key1, Key2: Pointer): Integer of object;
{ TFPSList }
TFPSList = class(TObject)
protected
FList: PByte;
@ -48,6 +50,7 @@ type
FCapacity: Integer; { list has room for capacity+1 items, contains room for a temporary item }
FItemSize: Integer;
procedure CopyItem(Src, Dest: Pointer); virtual;
procedure CopyItems(Src, Dest: Pointer; aCount : Integer); virtual;
procedure Deref(Item: Pointer); virtual; overload;
procedure Deref(FromIndex, ToIndex: Integer); overload;
function Get(Index: Integer): Pointer;
@ -68,6 +71,7 @@ type
public
constructor Create(AItemSize: Integer = sizeof(Pointer));
destructor Destroy; override;
class Function ItemIsManaged : Boolean; virtual;
function Add(Item: Pointer): Integer;
procedure Clear;
procedure Delete(Index: Integer);
@ -113,6 +117,8 @@ type
property Current: T read GetCurrent;
end;
{ TFPGList }
generic TFPGList<T> = class(TFPSList)
private
type
@ -132,6 +138,8 @@ type
procedure SetLast(const Value: T); {$ifdef FGLINLINE} inline; {$endif}
function GetFirst: T; {$ifdef FGLINLINE} inline; {$endif}
procedure SetFirst(const Value: T); {$ifdef FGLINLINE} inline; {$endif}
Protected
class Function ItemIsManaged : Boolean; override;
public
Type
TFPGListEnumeratorSpec = specialize TFPGListEnumerator<T>;
@ -455,6 +463,11 @@ begin
System.Move(Src^, Dest^, FItemSize);
end;
procedure TFPSList.CopyItems(Src, Dest: Pointer; aCount: Integer);
begin
System.Move(Src^, Dest^, FItemSize*aCount);
end;
procedure TFPSList.RaiseIndexError(Index : Integer);
begin
Error(SListIndexError, Index);
@ -547,6 +560,11 @@ begin
Error(SListIndexError, AIndex);
end;
class function TFPSList.ItemIsManaged: Boolean;
begin
Result:=False;
end;
procedure TFPSList.Clear;
begin
@ -838,8 +856,21 @@ var
begin
if Obj.ItemSize <> FItemSize then
Error(SListItemSizeError, 0);
for I := 0 to Obj.Count - 1 do
Add(Obj[i]);
// Do this now.
Capacity:=Capacity+Obj.Count;
if ItemIsManaged then
begin
// nothing for it, need to do it manually to give deref a chance.
For I:=0 to Obj.Count-1 do
Add(Obj[i])
end
else
begin
if Obj.Count=0 then
exit;
CopyItems(Obj.InternalItems[0],InternalItems[FCount],Obj.Count);
FCount:=FCount+Obj.Count;
end
end;
procedure TFPSList.Assign(Obj: TFPSList);
@ -890,7 +921,7 @@ end;
procedure TFPGList.Deref(Item: Pointer);
begin
Finalize(T(Item^));
Finalize(T(Item^));
end;
function TFPGList.Get(Index: Integer): T;
@ -936,6 +967,11 @@ begin
inherited SetFirst(@Value);
end;
class function TFPGList.ItemIsManaged: Boolean;
begin
Result:=IsManagedType(T);
end;
function TFPGList.GetEnumerator: TFPGListEnumeratorSpec;
begin
Result := TFPGListEnumeratorSpec.Create(Self);
@ -976,14 +1012,25 @@ var
i: Integer;
begin
for I := 0 to Source.Count - 1 do
Add(Source[i]);
if IsManagedType(T) then
begin
Capacity:=Capacity+Source.Count;
for I := 0 to Source.Count - 1 do
Add(Source[i]);
end
else
Inherited AddList(TFPSList(source))
end;
procedure TFPGList.Assign(Source: TFPGList);
begin
Clear;
AddList(Source);
if IsManagedType(T) then
begin
Clear;
AddList(Source);
end
else
Inherited Assign(TFPSList(source))
end;
{$endif VER2_4}