Merged revisions 2775,2788-2789 via svnmerge from

http://svn.freepascal.org/svn/fpc/branches/linker/compiler

........
r2775 | peter | 2006-03-05 22:43:30 +0100 (Sun, 05 Mar 2006) | 2 lines

  * merge ppu changes to keep ppus the same

........
r2788 | peter | 2006-03-06 12:59:14 +0100 (Mon, 06 Mar 2006) | 2 lines

  * Add TFPList and TFPObjectList

........
r2789 | peter | 2006-03-06 13:01:37 +0100 (Mon, 06 Mar 2006) | 2 lines

  * fix powerpc

........


git-svn-id: http://svn.freepascal.org/svn/fpc/trunk@2790 3ad0048d-3df7-0310-abae-a5850022a9f2

1 files changed, 477 insertions, 300 deletions

diff --git a/compiler/cclasses.pas b/compiler/cclasses.pas
index f3db30f59a..ac4ca0b251 100644
--- a/compiler/cclasses.pas
+++ b/compiler/cclasses.pas
@@ -26,7 +26,8 @@ unit cclasses;
 interface
 
     uses
-      cutils,cstreams;
+      SysUtils,
+      CUtils,CStreams;
 
 {********************************************
                 TMemDebug
@@ -47,7 +48,7 @@ interface
        end;
 
 {*******************************************************
-   TList (Copied from FCL, exception handling stripped)
+     TFPObjectList (From rtl/objpas/classes/classesh.inc)
 ********************************************************}
 
 const
@@ -56,51 +57,98 @@ const
    SListCapacityError = 'The maximum list capacity is reached (%d)';
    SListCountError = 'List count too large (%d)';
 type
-{ TList class }
-
-   PPointerList = ^TPointerList;
-   TPointerList = array[0..MaxListSize - 1] of Pointer;
-   TListSortCompare = function (Item1, Item2: Pointer): Integer;
-
-   TListCallback = procedure(data,arg:pointer) of object;
-   TListStaticCallback = procedure(data,arg:pointer);
-
-   TList = class(TObject)
-   private
-     FList: PPointerList;
-     FCount: Integer;
-     FCapacity: Integer;
-   protected
-     function Get(Index: Integer): Pointer;
-     procedure Grow; virtual;
-     procedure Put(Index: Integer; Item: Pointer);
-     procedure SetCapacity(NewCapacity: Integer);
-     procedure SetCount(NewCount: Integer);
-   public
-     destructor Destroy; override;
-     function Add(Item: Pointer): Integer;
-     procedure Clear; dynamic;
-     procedure Delete(Index: Integer);
-     class procedure Error(const Msg: string; Data: Integer); virtual;
-     procedure Exchange(Index1, Index2: Integer);
-     function Expand: TList;
-     function Extract(item: Pointer): Pointer;
-     function First: Pointer;
-     procedure Assign(Obj:TList);
-     function IndexOf(Item: Pointer): Integer;
-     procedure Insert(Index: Integer; Item: Pointer);
-     function Last: Pointer;
-     procedure Move(CurIndex, NewIndex: Integer);
-     function Remove(Item: Pointer): Integer;
-     procedure Pack;
-     procedure Sort(Compare: TListSortCompare);
-     procedure foreach(proc2call:TListCallback;arg:pointer);
-     procedure foreach_static(proc2call:TListStaticCallback;arg:pointer);
-     property Capacity: Integer read FCapacity write SetCapacity;
-     property Count: Integer read FCount write SetCount;
-     property Items[Index: Integer]: Pointer read Get write Put; default;
-     property List: PPointerList read FList;
-   end;
+   EListError = class(Exception);
+
+type
+  PPointerList = ^TPointerList;
+  TPointerList = array[0..MaxListSize - 1] of Pointer;
+  TListSortCompare = function (Item1, Item2: Pointer): Integer;
+  TListCallback = procedure(data,arg:pointer) of object;
+  TListStaticCallback = procedure(data,arg:pointer);
+
+  TFPList = class(TObject)
+  private
+    FList: PPointerList;
+    FCount: Integer;
+    FCapacity: Integer;
+  protected
+    function Get(Index: Integer): Pointer; {$ifdef CLASSESINLINE} inline; {$endif CLASSESINLINE}
+    procedure Put(Index: Integer; Item: Pointer); {$ifdef CLASSESINLINE} inline; {$endif CLASSESINLINE}
+    procedure SetCapacity(NewCapacity: Integer);
+    procedure SetCount(NewCount: Integer);
+    Procedure RaiseIndexError(Index : Integer);
+  public
+    destructor Destroy; override;
+    function Add(Item: Pointer): Integer; {$ifdef CLASSESINLINE} inline; {$endif CLASSESINLINE}
+    procedure Clear;
+    procedure Delete(Index: Integer); {$ifdef CLASSESINLINE} inline; {$endif CLASSESINLINE}
+    class procedure Error(const Msg: string; Data: PtrInt);
+    procedure Exchange(Index1, Index2: Integer);
+    function Expand: TFPList; {$ifdef CLASSESINLINE} inline; {$endif CLASSESINLINE}
+    function Extract(item: Pointer): Pointer;
+    function First: Pointer;
+    function IndexOf(Item: Pointer): Integer;
+    procedure Insert(Index: Integer; Item: Pointer); {$ifdef CLASSESINLINE} inline; {$endif CLASSESINLINE}
+    function Last: Pointer;
+    procedure Move(CurIndex, NewIndex: Integer);
+    procedure Assign(Obj:TFPList);
+    function Remove(Item: Pointer): Integer;
+    procedure Pack;
+    procedure Sort(Compare: TListSortCompare);
+    procedure ForEachCall(proc2call:TListCallback;arg:pointer);
+    procedure ForEachCall(proc2call:TListStaticCallback;arg:pointer);
+    property Capacity: Integer read FCapacity write SetCapacity;
+    property Count: Integer read FCount write SetCount;
+    property Items[Index: Integer]: Pointer read Get write Put; default;
+    property List: PPointerList read FList;
+  end;
+
+{*******************************************************
+        TFPObjectList (From fcl/inc/contnrs.pp)
+********************************************************}
+
+  TObjectListCallback = procedure(data:TObject;arg:pointer) of object;
+  TObjectListStaticCallback = procedure(data:TObject;arg:pointer);
+
+  TFPObjectList = class(TObject)
+  private
+    FFreeObjects : Boolean;
+    FList: TFPList;
+    function GetCount: integer;
+    procedure SetCount(const AValue: integer);
+  protected
+    function GetItem(Index: Integer): TObject; {$ifdef CLASSESINLINE}inline;{$endif}
+    procedure SetItem(Index: Integer; AObject: TObject); {$ifdef CLASSESINLINE}inline;{$endif}
+    procedure SetCapacity(NewCapacity: Integer);
+    function GetCapacity: integer;
+  public
+    constructor Create;
+    constructor Create(FreeObjects : Boolean);
+    destructor Destroy; override;
+    procedure Clear;
+    function Add(AObject: TObject): Integer; {$ifdef CLASSESINLINE}inline;{$endif}
+    procedure Delete(Index: Integer); {$ifdef CLASSESINLINE}inline;{$endif}
+    procedure Exchange(Index1, Index2: Integer);
+    function Expand: TFPObjectList;
+    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 CLASSESINLINE}inline;{$endif}
+    function First: TObject;
+    function Last: TObject;
+    procedure Move(CurIndex, NewIndex: Integer);
+    procedure Assign(Obj:TFPObjectList);
+    procedure Pack;
+    procedure Sort(Compare: TListSortCompare);
+    procedure ForEachCall(proc2call:TObjectListCallback;arg:pointer);
+    procedure ForEachCall(proc2call:TObjectListStaticCallback;arg:pointer);
+    property Capacity: Integer read GetCapacity write SetCapacity;
+    property Count: Integer read GetCount write SetCount;
+    property OwnsObjects: Boolean read FFreeObjects write FFreeObjects;
+    property Items[Index: Integer]: TObject read GetItem write SetItem; default;
+    property List: TFPList read FList;
+  end;
 
 {********************************************
                 TLinkedList
@@ -404,371 +452,500 @@ implementation
 
 
 {*****************************************************************************
-                                 TList
+               TFPObjectList (Copied from rtl/objpas/classes/lists.inc)
 *****************************************************************************}
 
 Const
-   // Ratio of Pointer and Word Size.
-   WordRatio = SizeOf(Pointer) Div SizeOf(Word);
-
-function TList.Get(Index: Integer): Pointer;
+  // Ratio of Pointer and Word Size.
+  WordRatio = SizeOf(Pointer) Div SizeOf(Word);
 
+procedure TFPList.RaiseIndexError(Index : Integer);
 begin
-   If (Index<0) or (Index>=FCount) then
-     Error(SListIndexError,Index);
-   Result:=FList^[Index];
+  Error(SListIndexError, Index);
 end;
 
-
-
-procedure TList.Grow;
-
+function TFPList.Get(Index: Integer): Pointer; {$ifdef CLASSESINLINE} inline; {$endif CLASSESINLINE}
 begin
-   // Only for compatibility with Delphi. Not needed.
+  If (Index < 0) or (Index >= FCount) then
+    RaiseIndexError(Index);
+  Result:=FList^[Index];
 end;
 
+procedure TFPList.Put(Index: Integer; Item: Pointer); {$ifdef CLASSESINLINE} inline; {$endif CLASSESINLINE}
+begin
+  if (Index < 0) or (Index >= FCount) then
+    RaiseIndexError(Index);
+  Flist^[Index] := Item;
+end;
 
-
-procedure TList.Put(Index: Integer; Item: Pointer);
-
+function TFPList.Extract(item: Pointer): Pointer;
+var
+  i : Integer;
 begin
-   if (Index<0) or (Index>=FCount) then
-     Error(SListIndexError,Index);
-   Flist^[Index]:=Item;
+  result := nil;
+  i := IndexOf(item);
+  if i >= 0 then
+   begin
+     Result := item;
+     FList^[i] := nil;
+     Delete(i);
+   end;
 end;
 
+procedure TFPList.SetCapacity(NewCapacity: Integer);
+begin
+  If (NewCapacity < FCount) or (NewCapacity > MaxListSize) then
+     Error (SListCapacityError, NewCapacity);
+  if NewCapacity = FCapacity then
+    exit;
+  ReallocMem(FList, SizeOf(Pointer)*NewCapacity);
+  FCapacity := NewCapacity;
+end;
 
-function TList.Extract(item: Pointer): Pointer;
-var
-   i : Integer;
+procedure TFPList.SetCount(NewCount: Integer);
 begin
-   result:=nil;
-   i:=IndexOf(item);
-   if i>=0 then
+  if (NewCount < 0) or (NewCount > MaxListSize)then
+    Error(SListCountError, NewCount);
+  If NewCount > FCount then
     begin
-      Result:=item;
-      FList^[i]:=nil;
-      Delete(i);
+    If NewCount > FCapacity then
+      SetCapacity(NewCount);
+    If FCount < NewCount then
+      FillWord(Flist^[FCount], (NewCount-FCount) *  WordRatio, 0);
     end;
+  FCount := Newcount;
 end;
 
-
-procedure TList.SetCapacity(NewCapacity: Integer);
+destructor TFPList.Destroy;
 begin
-   If (NewCapacity<0) or (NewCapacity>MaxListSize) then
-      Error (SListCapacityError,NewCapacity);
-   if NewCapacity=FCapacity then
-     exit;
-   ReallocMem(FList,SizeOf(Pointer)*NewCapacity);
-   if NewCapacity > FCapacity then
-     FillChar (FList^ [FCapacity],
-                              (NewCapacity - FCapacity) * SizeOf (pointer), 0);
-   FCapacity:=NewCapacity;
+  Self.Clear;
+  inherited Destroy;
 end;
 
+function TFPList.Add(Item: Pointer): Integer; {$ifdef CLASSESINLINE} inline; {$endif CLASSESINLINE}
+begin
+  if FCount = FCapacity then
+    Self.Expand;
+  FList^[FCount] := Item;
+  Result := FCount;
+  FCount := FCount + 1;
+end;
 
+procedure TFPList.Clear;
+begin
+  if Assigned(FList) then
+  begin
+    SetCount(0);
+    SetCapacity(0);
+    FList := nil;
+  end;
+end;
 
-procedure TList.SetCount(NewCount: Integer);
+procedure TFPList.Delete(Index: Integer); {$ifdef CLASSESINLINE} inline; {$endif CLASSESINLINE}
+begin
+  If (Index<0) or (Index>=FCount) then
+    Error (SListIndexError, Index);
+  FCount := FCount-1;
+  System.Move (FList^[Index+1], FList^[Index], (FCount - Index) * SizeOf(Pointer));
+  // Shrink the list if appropriate
+  if (FCapacity > 256) and (FCount < FCapacity shr 2) then
+  begin
+    FCapacity := FCapacity shr 1;
+    ReallocMem(FList, SizeOf(Pointer) * FCapacity);
+  end;
+end;
 
+class procedure TFPList.Error(const Msg: string; Data: PtrInt);
 begin
-   If (NewCount<0) or (NewCount>MaxListSize)then
-     Error(SListCountError,NewCount);
-   If NewCount<FCount then
-     FCount:=NewCount
-   else If NewCount>FCount then
-     begin
-     If NewCount>FCapacity then
-       SetCapacity (NewCount);
-     If FCount<NewCount then
-       FillWord (Flist^[FCount],(NewCount-FCount)* WordRatio ,0);
-     FCount:=Newcount;
-     end;
+  Raise EListError.CreateFmt(Msg,[Data]) at get_caller_addr(get_frame);
 end;
 
+procedure TFPList.Exchange(Index1, Index2: Integer);
+var
+  Temp : Pointer;
+begin
+  If ((Index1 >= FCount) or (Index1 < 0)) then
+    Error(SListIndexError, Index1);
+  If ((Index2 >= FCount) or (Index2 < 0)) then
+    Error(SListIndexError, Index2);
+  Temp := FList^[Index1];
+  FList^[Index1] := FList^[Index2];
+  FList^[Index2] := Temp;
+end;
 
+function TFPList.Expand: TFPList; {$ifdef CLASSESINLINE} inline; {$endif CLASSESINLINE}
+var
+  IncSize : Longint;
+begin
+  if FCount < FCapacity then exit;
+  IncSize := 4;
+  if FCapacity > 3 then IncSize := IncSize + 4;
+  if FCapacity > 8 then IncSize := IncSize+8;
+  if FCapacity > 127 then Inc(IncSize, FCapacity shr 2);
+  SetCapacity(FCapacity + IncSize);
+  Result := Self;
+end;
 
-destructor TList.Destroy;
+function TFPList.First: Pointer;
+begin
+  If FCount = 0 then
+    Result := Nil
+  else
+    Result := Items[0];
+end;
 
+function TFPList.IndexOf(Item: Pointer): Integer;
 begin
-   Self.Clear;
-   inherited Destroy;
+  Result := 0;
+  while(Result < FCount) and (Flist^[Result] <> Item) do Result := Result + 1;
+  If Result = FCount  then Result := -1;
 end;
 
+procedure TFPList.Insert(Index: Integer; Item: Pointer); {$ifdef CLASSESINLINE} inline; {$endif CLASSESINLINE}
+begin
+  if (Index < 0) or (Index > FCount )then
+    Error(SlistIndexError, Index);
+  iF FCount = FCapacity then Self.Expand;
+  if Index<FCount then
+    System.Move(Flist^[Index], Flist^[Index+1], (FCount - Index) * SizeOf(Pointer));
+  FList^[Index] := Item;
+  FCount := FCount + 1;
+end;
 
-Function TList.Add(Item: Pointer): Integer;
+function TFPList.Last: Pointer;
+begin
+{ Wouldn't it be better to return nil if the count is zero ?}
+  If FCount = 0 then
+    Result := nil
+  else
+    Result := Items[FCount - 1];
+end;
 
+procedure TFPList.Move(CurIndex, NewIndex: Integer);
+var
+  Temp : Pointer;
 begin
-   Self.Insert (Count,Item);
-   Result:=Count-1;
+  if ((CurIndex < 0) or (CurIndex > Count - 1)) then
+    Error(SListIndexError, CurIndex);
+  if (NewINdex < 0) then
+    Error(SlistIndexError, NewIndex);
+  Temp := FList^[CurIndex];
+  FList^[CurIndex] := nil;
+  Self.Delete(CurIndex);
+  Self.Insert(NewIndex, nil);
+  FList^[NewIndex] := Temp;
 end;
 
+function TFPList.Remove(Item: Pointer): Integer;
+begin
+  Result := IndexOf(Item);
+  If Result <> -1 then
+    Self.Delete(Result);
+end;
 
+procedure TFPList.Pack;
+Var
+  {Last,I,J,}
+  Runner : Longint;
+begin
+  // Not the fastest; but surely correct
+  for Runner := Fcount - 1 downto 0 do
+    if Items[Runner] = Nil then
+      Self.Delete(Runner);
+{ The following may be faster in case of large and defragmented lists
+  If count=0 then exit;
+  Runner:=0;I:=0;
+  TheLast:=Count;
+  while runner<count do
+    begin
+    // Find first Nil
+    While (FList^[Runner]<>Nil) and (Runner<Count) do Runner:=Runner+1;
+    if Runner<Count do
+      begin
+      // Start searching for non-nil from last known nil+1
+      if i<Runner then I:=Runner+1;
+      While (Flist[I]^=Nil) and (I<Count) do I:=I+1;
+      // Start looking for last non-nil of block.
+      J:=I+1;
+      While (Flist^[J]<>Nil) and (J<Count) do J:=J+1;
+      // Move block and zero out
+      Move (Flist^[I],Flist^[Runner],J*SizeOf(Pointer));
+      FillWord (Flist^[I],(J-I)*WordRatio,0);
+      // Update Runner and Last to point behind last block
+      TheLast:=Runner+(J-I);
+      If J=Count then
+         begin
+         // Shortcut, when J=Count we checked all pointers
+         Runner:=Count
+      else
+         begin
+         Runner:=TheLast;
+         I:=j;
+      end;
+    end;
+  Count:=TheLast;
+}
+end;
 
-Procedure TList.Clear;
+// Needed by Sort method.
 
+Procedure QuickSort(FList: PPointerList; L, R : Longint;
+                     Compare: TListSortCompare);
+var
+  I, J : Longint;
+  P, Q : Pointer;
 begin
-   If Assigned(FList) then
+ repeat
+   I := L;
+   J := R;
+   P := FList^[ (L + R) div 2 ];
+   repeat
+     while Compare(P, FList^[i]) > 0 do
+       I := I + 1;
+     while Compare(P, FList^[J]) < 0 do
+       J := J - 1;
+     If I <= J then
      begin
-     FreeMem (Flist,FCapacity*SizeOf(Pointer));
-     FList:=Nil;
-     FCapacity:=0;
-     FCount:=0;
+       Q := FList^[I];
+       Flist^[I] := FList^[J];
+       FList^[J] := Q;
+       I := I + 1;
+       J := J - 1;
      end;
+   until I > J;
+   if L < J then
+     QuickSort(FList, L, J, Compare);
+   L := I;
+ until I >= R;
 end;
 
-
-Procedure TList.Delete(Index: Integer);
+procedure TFPList.Sort(Compare: TListSortCompare);
 begin
-   If (Index<0) or (Index>=FCount) then
-     Error (SListIndexError,Index);
-   FCount:=FCount-1;
-   System.Move (FList^[Index+1],FList^[Index],(FCount-Index)*SizeOf(Pointer));
-   // Shrink the list if appropiate
-   if (FCapacity > 256) and (FCount < FCapacity shr 2) then
-   begin
-     FCapacity := FCapacity shr 1;
-     ReallocMem(FList, SizeOf(Pointer) * FCapacity);
-   end;
+  if Not Assigned(FList) or (FCount < 2) then exit;
+  QuickSort(Flist, 0, FCount-1, Compare);
 end;
 
-
-class procedure TList.Error(const Msg: string; Data: Integer);
-{$ifdef EXTDEBUG}
+procedure TFPList.Assign(Obj: TFPList);
 var
-  s : string;
-{$endif EXTDEBUG}
+  i: Integer;
 begin
-{$ifdef EXTDEBUG}
-  s:=Msg;
-  Replace(s,'%d',ToStr(Data));
-  writeln(s);
-{$endif EXTDEBUG}
-  internalerrorproc(200411151);
+  Clear;
+  for I := 0 to Obj.Count - 1 do
+    Add(Obj[i]);
 end;
 
-procedure TList.Exchange(Index1, Index2: Integer);
-
-var Temp : Pointer;
 
+procedure TFPList.ForEachCall(proc2call:TListCallback;arg:pointer);
+var
+  i : integer;
+  p : pointer;
 begin
-   If ((Index1>=FCount) or (Index1<0)) then
-     Error(SListIndexError,Index1);
-   If ((Index2>=FCount) or (Index2<0)) then
-     Error(SListIndexError,Index2);
-   Temp:=FList^[Index1];
-   FList^[Index1]:=FList^[Index2];
-   FList^[Index2]:=Temp;
+  For I:=0 To Count-1 Do
+    begin
+      p:=FList^[i];
+      if assigned(p) then
+        proc2call(p,arg);
+    end;
 end;
 
 
-
-function TList.Expand: TList;
-
-Var IncSize : Longint;
-
+procedure TFPList.ForEachCall(proc2call:TListStaticCallback;arg:pointer);
+var
+  i : integer;
+  p : pointer;
 begin
-   if FCount<FCapacity then exit;
-   IncSize:=4;
-   if FCapacity>3 then IncSize:=IncSize+4;
-   if FCapacity>8 then IncSize:=IncSize+8;
-   if FCapacity>127 then Inc(IncSize, FCapacity shr 2);
-   SetCapacity(FCapacity+IncSize);
-   Result:=Self;
+  For I:=0 To Count-1 Do
+    begin
+      p:=FList^[i];
+      if assigned(p) then
+        proc2call(p,arg);
+    end;
 end;
 
 
-function TList.First: Pointer;
+{*****************************************************************************
+            TFPObjectList (Copied from rtl/objpas/classes/lists.inc)
+*****************************************************************************}
 
+constructor TFPObjectList.Create(FreeObjects : boolean);
 begin
-   If FCount=0 then
-     Result:=Nil
-   else
-     Result:=Items[0];
+  Create;
+  FFreeObjects := Freeobjects;
 end;
 
-
-
-function TList.IndexOf(Item: Pointer): Integer;
-
+destructor TFPObjectList.Destroy;
 begin
-   Result:=0;
-   While (Result<FCount) and (Flist^[Result]<>Item) do Result:=Result+1;
-   If Result=FCount  then Result:=-1;
+  if (FList <> nil) then
+  begin
+    Clear;
+    FList.Destroy;
+  end;
+  inherited Destroy;
 end;
 
-
-
-procedure TList.Insert(Index: Integer; Item: Pointer);
-
+procedure TFPObjectList.Clear;
+var
+  i: integer;
 begin
-   If (Index<0) or (Index>FCount )then
-     Error(SlistIndexError,Index);
-   IF FCount=FCapacity Then Self.Expand;
-   If Index<FCount then
-     System.Move(Flist^[Index],Flist^[Index+1],(FCount-Index)*SizeOf(Pointer));
-   FList^[Index]:=Item;
-   FCount:=FCount+1;
+  if FFreeObjects then
+    for i := 0 to FList.Count - 1 do
+      TObject(FList[i]).Free;
+  FList.Clear;
 end;
 
-
-
-function TList.Last: Pointer;
-
+constructor TFPObjectList.Create;
 begin
-   // Wouldn't it be better to return nil if the count is zero ?
-   If FCount=0 then
-     Result:=Nil
-   else
-     Result:=Items[FCount-1];
+  inherited Create;
+  FList := TFPList.Create;
+  FFreeObjects := True;
 end;
 
+function TFPObjectList.GetCount: integer;
+begin
+  Result := FList.Count;
+end;
 
-procedure TList.Move(CurIndex, NewIndex: Integer);
+procedure TFPObjectList.SetCount(const AValue: integer);
+begin
+  if FList.Count <> AValue then
+    FList.Count := AValue;
+end;
 
-Var Temp : Pointer;
+function TFPObjectList.GetItem(Index: Integer): TObject; {$ifdef CLASSESINLINE}inline;{$endif}
+begin
+  Result := TObject(FList[Index]);
+end;
 
+procedure TFPObjectList.SetItem(Index: Integer; AObject: TObject); {$ifdef CLASSESINLINE}inline;{$endif}
 begin
-   If ((CurIndex<0) or (CurIndex>Count-1)) then
-     Error(SListIndexError,CurIndex);
-   If (NewINdex<0) then
-     Error(SlistIndexError,NewIndex);
-   Temp:=FList^[CurIndex];
-   FList^[CurIndex]:=Nil;
-   Self.Delete(CurIndex);
-   // ?? If NewIndex>CurIndex then NewIndex:=NewIndex-1;
-   // Newindex changes when deleting ??
-   Self.Insert (NewIndex,Nil);
-   FList^[NewIndex]:=Temp;
+  if OwnsObjects then
+    TObject(FList[Index]).Free;
+  FList[index] := AObject;
 end;
 
+procedure TFPObjectList.SetCapacity(NewCapacity: Integer);
+begin
+  FList.Capacity := NewCapacity;
+end;
 
-function TList.Remove(Item: Pointer): Integer;
+function TFPObjectList.GetCapacity: integer;
+begin
+  Result := FList.Capacity;
+end;
 
+function TFPObjectList.Add(AObject: TObject): Integer; {$ifdef CLASSESINLINE}inline;{$endif}
 begin
-   Result:=IndexOf(Item);
-   If Result<>-1 then
-     Self.Delete (Result);
+  Result := FList.Add(AObject);
 end;
 
+procedure TFPObjectList.Delete(Index: Integer); {$ifdef CLASSESINLINE}inline;{$endif}
+begin
+  if OwnsObjects then
+    TObject(FList[Index]).Free;
+  FList.Delete(Index);
+end;
 
+procedure TFPObjectList.Exchange(Index1, Index2: Integer);
+begin
+  FList.Exchange(Index1, Index2);
+end;
 
-Procedure TList.Pack;
+function TFPObjectList.Expand: TFPObjectList;
+begin
+  FList.Expand;
+  Result := Self;
+end;
 
-Var  {Last,I,J,}Runner : Longint;
+function TFPObjectList.Extract(Item: TObject): TObject;
+begin
+  Result := TObject(FList.Extract(Item));
+end;
 
+function TFPObjectList.Remove(AObject: TObject): Integer;
 begin
-   // Not the fastest; but surely correct
-   For Runner:=Fcount-1 downto 0 do
-     if Items[Runner]=Nil then Self.Delete(Runner);
-{ The following may be faster in case of large and defragmented lists
-   If count=0 then exit;
-   Runner:=0;I:=0;
-   TheLast:=Count;
-   while runner<count do
-     begin
-     // Find first Nil
-     While (FList^[Runner]<>Nil) and (Runner<Count) do Runner:=Runner+1;
-     if Runner<Count do
-       begin
-       // Start searching for non-nil from last known nil+1
-       if i<Runner then I:=Runner+1;
-       While (Flist[I]^=Nil) and (I<Count) do I:=I+1;
-       // Start looking for last non-nil of block.
-       J:=I+1;
-       While (Flist^[J]<>Nil) and (J<Count) do J:=J+1;
-       // Move block and zero out
-       Move (Flist^[I],Flist^[Runner],J*SizeOf(Pointer));
-       FillWord (Flist^[I],(J-I)*WordRatio,0);
-       // Update Runner and Last to point behind last block
-       TheLast:=Runner+(J-I);
-       If J=Count then
-          begin
-          // Shortcut, when J=Count we checked all pointers
-          Runner:=Count
-       else
-          begin
-          Runner:=TheLast;
-          I:=j;
-       end;
-     end;
-   Count:=TheLast;
-}
+  Result := IndexOf(AObject);
+  if (Result <> -1) then
+  begin
+    if OwnsObjects then
+      TObject(FList[Result]).Free;
+    FList.Delete(Result);
+  end;
 end;
 
-// Needed by Sort method.
+function TFPObjectList.IndexOf(AObject: TObject): Integer;
+begin
+  Result := FList.IndexOf(Pointer(AObject));
+end;
 
-Procedure QuickSort (Flist : PPointerList; L,R : Longint;
-                      Compare : TListSortCompare);
+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;
 
-Var I,J : Longint;
-     P,Q : Pointer;
+procedure TFPObjectList.Insert(Index: Integer; AObject: TObject); {$ifdef CLASSESINLINE}inline;{$endif}
+begin
+  FList.Insert(Index, Pointer(AObject));
+end;
 
+procedure TFPObjectList.Move(CurIndex, NewIndex: Integer);
 begin
-  Repeat
-    I:=L;
-    J:=R;
-    P:=FList^[ (L+R) div 2 ];
-    repeat
-      While Compare(P,FList^[i])>0 Do I:=I+1;
-      While Compare(P,FList^[J])<0 Do J:=J-1;
-      If I<=J then
-        begin
-        Q:=Flist^[I];
-        Flist^[I]:=FList^[J];
-        FList^[J]:=Q;
-        I:=I+1;
-        J:=j-1;
-        end;
-    Until I>J;
-    If L<J then QuickSort (FList,L,J,Compare);
-    L:=I;
-  Until I>=R;
+  FList.Move(CurIndex, NewIndex);
 end;
 
-procedure TList.Sort(Compare: TListSortCompare);
+procedure TFPObjectList.Assign(Obj: TFPObjectList);
+var
+  i: Integer;
+begin
+  Clear;
+  for I := 0 to Obj.Count - 1 do
+    Add(Obj[i]);
+end;
 
+procedure TFPObjectList.Pack;
 begin
-   If Not Assigned(FList) or (FCount<2) then exit;
-   QuickSort (Flist, 0, FCount-1,Compare);
+  FList.Pack;
 end;
 
-procedure TList.Assign(Obj:TList);
-// Principle copied from TCollection
+procedure TFPObjectList.Sort(Compare: TListSortCompare);
+begin
+  FList.Sort(Compare);
+end;
 
-var i : Integer;
+function TFPObjectList.First: TObject;
 begin
-   Clear;
-   For I:=0 To Obj.Count-1 Do
-     Add(Obj[i]);
+  Result := TObject(FList.First);
 end;
 
+function TFPObjectList.Last: TObject;
+begin
+  Result := TObject(FList.Last);
+end;
 
-    procedure TList.foreach(proc2call:TListCallback;arg:pointer);
-      var
-        i : longint;
-        p : pointer;
-      begin
-        For I:=0 To Count-1 Do
-          begin
-            p:=FList^[i];
-            if assigned(p) then
-              proc2call(p,arg);
-          end;
-      end;
+procedure TFPObjectList.ForEachCall(proc2call:TObjectListCallback;arg:pointer);
+begin
+  FList.ForEachCall(TListCallBack(proc2call),arg);
+end;
 
+procedure TFPObjectList.ForEachCall(proc2call:TObjectListStaticCallback;arg:pointer);
+begin
+  FList.ForEachCall(TListStaticCallBack(proc2call),arg);
+end;
 
-    procedure TList.foreach_static(proc2call:TListStaticCallback;arg:pointer);
-      var
-        i : longint;
-        p : pointer;
-      begin
-        For I:=0 To Count-1 Do
-          begin
-            p:=FList^[i];
-            if assigned(p) then
-              proc2call(p,arg);
-          end;
-      end;
 
 {****************************************************************************
                              TLinkedListItem