This patch adds TFPObjectList to contnrs.
It's a descendent of TFPList and uses same tricks to gain speed.(inline
etc.)
I've tested with bubblesort and it was 1/3 faster.
P.S: I wanted to get rid of inherited calls too but FCount is private in
TFPList ;(
Ales
Index: fcl/inc/contnrs.pp
===================================================================
--- fcl/inc/contnrs.pp (revision 468)
+++ fcl/inc/contnrs.pp (working copy)
@@ -21,7 +21,29 @@
SysUtils,Classes;
Type
+{$inline on}
+ TFPObjectList = class(TFPList)
+ private
+ FFreeObjects : Boolean;
+ protected
+ function GetItem(Index: Integer): TObject; {$ifdef HASINLINE}
inline;{$endif}
+ procedure SetItem(Index: Integer; AObject: TObject); {$ifdef HASINLINE}
inline;{$endif}
+ public
+ constructor Create;
+ constructor Create(FreeObjects : Boolean);
+ function Add(AObject: TObject): Integer; {$ifdef HASINLINE} inline;{$endif}
+ function Extract(Item: TObject): TObject;
+ function Remove(AObject: TObject): Integer;
+ function IndexOf(AObject: TObject): Integer;
+ function FindInstanceOf(AClass: TClass; AExact: Boolean; AStartAt:
Integer): Integer;
+ procedure Insert(Index: Integer; AObject: TObject); {$ifdef HASINLINE}
inline;{$endif}
+ function First: TObject;
+ function Last: TObject;
+ property OwnsObjects: Boolean read FFreeObjects write FFreeObjects;
+ property Items[Index: Integer]: TObject read GetItem write SetItem;
default;
+ end;
+
TObjectList = class(TList)
private
ffreeobjects : boolean;
@@ -131,6 +153,92 @@
implementation
+constructor TFPObjectList.Create(FreeObjects : boolean);
+begin
+ inherited Create;
+ FFreeObjects:=Freeobjects;
+end;
+
+constructor TFPObjectList.Create;
+begin
+ inherited Create;
+ FFreeObjects:=True;
+end;
+
+function TFPObjectList.GetItem(Index: Integer): TObject; {$ifdef HASINLINE}
inline;{$endif}
+begin
+ Result:=TObject(inherited Get(Index));
+end;
+
+procedure TFPObjectList.SetItem(Index: Integer; AObject: TObject); {$ifdef
HASINLINE} inline;{$endif}
+var
+ O : TObject;
+begin
+ if OwnsObjects then
+ begin
+ O:=GetItem(Index);
+ O.Free;
+ end;
+ Put(Index,Pointer(AObject));
+end;
+
+function TFPObjectList.Add(AObject: TObject): Integer; {$ifdef HASINLINE}
inline;{$endif}
+begin
+ Result:=inherited Add(Pointer(AObject));
+end;
+
+function TFPObjectList.Extract(Item: TObject): TObject;
+begin
+ Result:=Tobject(inherited Extract(Pointer(Item)));
+end;
+
+function TFPObjectList.Remove(AObject: TObject): Integer;
+begin
+ Result:=inherited Remove(Pointer(AObject));
+end;
+
+function TFPObjectList.IndexOf(AObject: TObject): Integer;
+begin
+ Result:=inherited indexOF(Pointer(AObject));
+end;
+
+function TFPObjectList.FindInstanceOf(AClass: TClass; AExact: Boolean;
AStartAt : Integer): Integer;
+var
+ I : Integer;
+begin
+ I:=AStartAt;
+ Result:=-1;
+ If AExact then
+ while (I<Count) and (Result=-1) do
+ If Items[i].ClassType=AClass then
+ Result:=I
+ else
+ Inc(I)
+ else
+ while (I<Count) and (Result=-1) do
+ If Items[i].InheritsFrom(AClass) then
+ Result:=I
+ else
+ Inc(I);
+end;
+
+procedure TFPObjectList.Insert(Index: Integer; AObject: TObject); {$ifdef
HASINLINE} inline;{$endif}
+begin
+ inherited Insert(Index,Pointer(AObject));
+end;
+
+function TFPObjectList.First: TObject;
+begin
+ Result := TObject(inherited First);
+end;
+
+function TFPObjectList.Last: TObject;
+begin
+ Result := TObject(inherited Last);
+end;
+
+{ TObjectList }
+
constructor tobjectlist.create(freeobjects : boolean);
begin
_______________________________________________
fpc-devel maillist - fpc-devel@lists.freepascal.org
http://lists.freepascal.org/mailman/listinfo/fpc-devel
