Просмотр исходного кода

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: trunk@2790 -

peter 19 лет назад
Родитель
Сommit
38c0ae73da

+ 2 - 2
compiler/aasmbase.pas

@@ -111,7 +111,7 @@ interface
          name,
          realname     : string[80];
          symbolsearch : tdictionary; { contains ALL assembler symbols }
-         AltSymbollist : tlist;
+         AltSymbollist : TFPObjectList;
          constructor create(const n:string);
          destructor  destroy;override;
          { asmsymbol }
@@ -284,7 +284,7 @@ implementation
         { symbols }
         symbolsearch:=tdictionary.create;
         symbolsearch.usehash;
-        AltSymbollist:=TList.Create;
+        AltSymbollist:=TFPObjectList.Create(false);
         { labels }
         nextaltnr:=1;
         for alt:=low(TAsmLabelType) to high(TAsmLabelType) do

+ 477 - 300
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

+ 2 - 0
compiler/cutils.pas

@@ -572,6 +572,8 @@ uses
          l : longint;
       begin
          val(s,l,w);
+         // remove warning
+         l:=l;
          is_number:=(w=0);
       end;
 

+ 2 - 2
compiler/dbgdwarf.pas

@@ -193,7 +193,7 @@ interface
 
         { collect all defs in one list so we can reset them easily }
         nextdefnumber    : longint;
-        defnumberlist    : tlist;
+        defnumberlist    : TFPObjectList;
 
         isdwarf64,
         writing_def_dwarf : boolean;
@@ -1886,7 +1886,7 @@ implementation
         writing_def_dwarf:=false;
 
         nextdefnumber:=0;
-        defnumberlist:=tlist.create;
+        defnumberlist:=TFPObjectList.create(false);
 
         vardatadef:=search_system_type('TVARDATA').restype.def;
 

+ 2 - 2
compiler/dbgstabs.pas

@@ -36,7 +36,7 @@ interface
       private
         writing_def_stabs  : boolean;
         global_stab_number : word;
-        defnumberlist      : tlist;
+        defnumberlist      : TFPObjectList;
         { tsym writing }
         function  sym_var_value(const s:string;arg:pointer):string;
         function  sym_stabstr_evaluate(sym:tsym;const s:string;const vars:array of string):Pchar;
@@ -1326,7 +1326,7 @@ implementation
         aktfilepos:=current_module.mainfilepos;
 
         global_stab_number:=0;
-        defnumberlist:=tlist.create;
+        defnumberlist:=TFPObjectlist.create(false);
         stabsvarlist:=taasmoutput.create;
         stabstypelist:=taasmoutput.create;
 

+ 2 - 2
compiler/defcmp.pas

@@ -109,7 +109,7 @@ interface
       search for a routine with default parameters, before
       searching for the same definition with no parameters)
     }
-    function compare_paras(para1,para2 : tlist; acp : tcompare_paras_type; cpoptions: tcompare_paras_options):tequaltype;
+    function compare_paras(para1,para2 : TFPObjectList; acp : tcompare_paras_type; cpoptions: tcompare_paras_options):tequaltype;
 
     { True if a function can be assigned to a procvar }
     { changed first argument type to pabstractprocdef so that it can also be }
@@ -1346,7 +1346,7 @@ implementation
       end;
 
 
-    function compare_paras(para1,para2 : tlist; acp : tcompare_paras_type; cpoptions: tcompare_paras_options):tequaltype;
+    function compare_paras(para1,para2 : TFPObjectList; acp : tcompare_paras_type; cpoptions: tcompare_paras_options):tequaltype;
       var
         currpara1,
         currpara2 : tparavarsym;

+ 7 - 17
compiler/ncal.pas

@@ -51,7 +51,7 @@ interface
        tcallnode = class(tbinarynode)
        private
           { info for inlining }
-          inlinelocals: TList;
+          inlinelocals: TFPObjectList;
           { number of parameters passed from the source, this does not include the hidden parameters }
           paralength   : smallint;
           function  gen_self_tree_methodpointer:tnode;
@@ -829,13 +829,13 @@ type
          if not assigned(srsym) or
             (srsym.typ<>procsym) then
            Message1(cg_f_unknown_compilerproc,name);
-         self.create(params,tprocsym(srsym),srsym.owner,nil,[]);
+         create(params,tprocsym(srsym),srsym.owner,nil,[]);
        end;
 
 
     constructor tcallnode.createinternres(const name: string; params: tnode; const res: ttype);
       begin
-        self.createintern(name,params);
+        createintern(name,params);
         restype := res;
         include(callnodeflags,cnf_restypeset);
         { both the normal and specified resulttype either have to be returned via a }
@@ -848,7 +848,7 @@ type
 
     constructor tcallnode.createinternreturn(const name: string; params: tnode; returnnode : tnode);
       begin
-        self.createintern(name,params);
+        createintern(name,params);
         _funcretnode:=returnnode;
         if not paramanager.ret_in_param(symtableprocentry.first_procdef.rettype.def,symtableprocentry.first_procdef.proccalloption) then
           internalerror(200204247);
@@ -891,19 +891,13 @@ type
 
 
     destructor tcallnode.destroy;
-      var
-        i : longint;
       begin
          methodpointer.free;
          methodpointerinit.free;
          methodpointerdone.free;
          _funcretnode.free;
          if assigned(varargsparas) then
-           begin
-             for i:=0 to varargsparas.count-1 do
-               tparavarsym(varargsparas[i]).free;
-             varargsparas.free;
-           end;
+           varargsparas.free;
          inherited destroy;
       end;
 
@@ -1033,7 +1027,7 @@ type
 
         if assigned(varargsparas) then
          begin
-           n.varargsparas:=tvarargsparalist.create;
+           n.varargsparas:=tvarargsparalist.create(true);
            for i:=0 to varargsparas.count-1 do
              begin
                hp:=tparavarsym(varargsparas[i]);
@@ -2277,7 +2271,6 @@ type
         createstatement,deletestatement: tstatementnode;
         createblock,deleteblock: tblocknode;
         body : tnode;
-        i: longint;
       begin
         if not(assigned(tprocdef(procdefinition).inlininginfo) and
                assigned(tprocdef(procdefinition).inlininginfo^.code)) then
@@ -2293,7 +2286,7 @@ type
         if assigned(methodpointerinit) then
           addstatement(createstatement,methodpointerinit.getcopy);
 
-        inlinelocals:=tlist.create;
+        inlinelocals:=TFPObjectList.create(true);
         { get copy of the procedure body }
         body:=tprocdef(procdefinition).inlininginfo^.code.getcopy;
         { replace complex parameters with temps }
@@ -2306,9 +2299,6 @@ type
           addstatement(deletestatement,methodpointerdone.getcopy);
 
         { free the temps for the locals }
-        for i := 0 to inlinelocals.count-1 do
-          if assigned(inlinelocals[i]) then
-            tnode(inlinelocals[i]).free;
         inlinelocals.free;
         inlinelocals:=nil;
         addstatement(createstatement,body);

+ 1 - 1
compiler/nflw.pas

@@ -149,7 +149,7 @@ interface
           { when copying trees, this points to the newly created copy of a label }
           copiedto : tlabelnode;
           { contains all goto nodesrefering to this label }
-          referinggotonodes : tlist;
+          referinggotonodes : TFPObjectList;
           constructor create(l:tnode);virtual;
           constructor ppuload(t:tnodetype;ppufile:tcompilerppufile);override;
           procedure ppuwrite(ppufile:tcompilerppufile);override;

+ 5 - 5
compiler/nset.pas

@@ -74,7 +74,7 @@ interface
 
        tcasenode = class(tunarynode)
           labels    : pcaselabel;
-          blocks    : tlist;
+          blocks    : TFPList;
           elseblock : tnode;
           constructor create(l:tnode);virtual;
           destructor destroy;override;
@@ -488,7 +488,7 @@ implementation
       begin
          inherited create(casen,l);
          labels:=nil;
-         blocks:=tlist.create;
+         blocks:=TFPList.create;
          elseblock:=nil;
       end;
 
@@ -517,7 +517,7 @@ implementation
         inherited ppuload(t,ppufile);
         elseblock:=ppuloadnode(ppufile);
         cnt:=ppufile.getlongint();
-        blocks:=tlist.create;
+        blocks:=TFPList.create;
         for i:=0 to cnt-1 do
           addblock(i,ppuloadnode(ppufile));
         labels:=ppuloadcaselabel(ppufile);
@@ -656,7 +656,7 @@ implementation
            n.labels:=nil;
          if assigned(blocks) then
            begin
-             n.blocks:=tlist.create;
+             n.blocks:=TFPList.create;
              for i:=0 to blocks.count-1 do
                begin
                  if not assigned(blocks[i]) then
@@ -687,7 +687,7 @@ implementation
       end;
 
 
-    function caseblocksequal(b1,b2:tlist): boolean;
+    function caseblocksequal(b1,b2:TFPList): boolean;
       var
         i : longint;
       begin

+ 36 - 32
compiler/ogbase.pas

@@ -124,8 +124,8 @@ interface
        { relocation }
        relocations : TLinkedList;
        { Symbols this section references and defines }
-       ObjSymbolRefs     : Tlist;
-       ObjSymbolDefines  : Tlist;
+       ObjSymbolRefs     : TFPObjectList;
+       ObjSymbolDefines  : TFPObjectList;
        { executable linking }
        ExeSection  : TExeSection;
        constructor create(const Aname:string;Aalign:shortint;Aoptions:TObjSectionOptions);virtual;
@@ -153,12 +153,12 @@ interface
        { ObjSections will be stored in order in SectsIndex, this is at least
          required for stabs debuginfo. The SectsDict is only used for lookups (PFV) }
        FObjSectionDict  : TDictionary;
-       FObjSectionList  : TList;
+       FObjSectionList  : TFPObjectList;
        FCObjSection     : TObjSectionClass;
        { Symbols that will be defined in this object file }
-       FObjSymbolList    : TList;
+       FObjSymbolList    : TFPObjectList;
        FObjSymbolDict    : TDictionary;
-       FCachedAsmSymbolList : tlist;
+       FCachedAsmSymbolList : TFPObjectList;
        { Special info sections that are written to during object generation }
        FStabsObjSec,
        FStabStrObjSec : TObjSection;
@@ -206,8 +206,8 @@ interface
        procedure fixuprelocs;
        property Name:string[80] read FName;
        property CurrObjSec:TObjSection read FCurrObjSec;
-       property ObjSymbolList:TList read FObjSymbolList;
-       property ObjSectionList:TList read FObjSectionList;
+       property ObjSymbolList:TFPObjectList read FObjSymbolList;
+       property ObjSectionList:TFPObjectList read FObjSectionList;
      end;
      TObjDataClass = class of TObjData;
 
@@ -256,7 +256,7 @@ interface
       TExeSection = class(tnamedindexitem)
       private
         FSecSymIdx : longint;
-        FObjSectionList : TList;
+        FObjSectionList : TFPObjectList;
       public
         Size,
         DataPos,
@@ -266,7 +266,7 @@ interface
         constructor create(const n:string);virtual;
         destructor  destroy;override;
         procedure AddObjSection(objsec:TObjSection);
-        property ObjSectionList:TList read FObjSectionList;
+        property ObjSectionList:TFPObjectList read FObjSectionList;
         property SecSymIdx:longint read FSecSymIdx write FSecSymIdx;
       end;
       TExeSectionClass=class of TExeSection;
@@ -277,18 +277,18 @@ interface
         FCObjData         : TObjDataClass;
         FCExeSection      : TExeSectionClass;
         FCurrExeSec       : TExeSection;
-        FExeSectionList   : TList;
+        FExeSectionList   : TFPObjectList;
         FExeSectionDict   : TDictionary;
         Fzeronr           : longint;
         { Symbols }
         FExeSymbolDict    : TDictionary;
         FExeSymbolList,
-        FUnresolvedExeSymbols : TList;
+        FUnresolvedExeSymbols : TFPObjectList;
         FExternalObjSymbols,
-        FCommonObjSymbols   : TList;
+        FCommonObjSymbols   : TFPObjectList;
         FEntryName          : string;
         { Objects }
-        FObjDataList  : TList;
+        FObjDataList  : TFPObjectList;
         { Position calculation }
         FImageBase    : aint;
         FCurrDataPos,
@@ -333,13 +333,13 @@ interface
         procedure ResolveExternals(const libname:string);virtual;
         function  writeexefile(const fn:string):boolean;
         property Writer:TObjectWriter read FWriter;
-        property ExeSections:TList read FExeSectionList;
-        property ObjDataList:TList read FObjDataList;
+        property ExeSections:TFPObjectList read FExeSectionList;
+        property ObjDataList:TFPObjectList read FObjDataList;
         property ExeSymbolDict:TDictionary read FExeSymbolDict;
-        property ExeSymbolList:TList read FExeSymbolList;
-        property UnresolvedExeSymbols:TList read FUnresolvedExeSymbols;
-        property ExternalObjSymbols:TList read FExternalObjSymbols;
-        property CommonObjSymbols:TList read FCommonObjSymbols;
+        property ExeSymbolList:TFPObjectList read FExeSymbolList;
+        property UnresolvedExeSymbols:TFPObjectList read FUnresolvedExeSymbols;
+        property ExternalObjSymbols:TFPObjectList read FExternalObjSymbols;
+        property CommonObjSymbols:TFPObjectList read FCommonObjSymbols;
         property EntryName:string read FEntryName write FEntryName;
         property ImageBase:aint read FImageBase write FImageBase;
         property CurrExeSec:TExeSection read FCurrExeSec;
@@ -357,6 +357,8 @@ implementation
     uses
       cutils,globals,verbose,fmodule,ogmap;
 
+    const
+      sectiondatagrowsize = 1024;
 
 
 {*****************************************************************************
@@ -468,8 +470,8 @@ implementation
         secsymidx:=0;
         { relocation }
         relocations:=TLinkedList.Create;
-        ObjSymbolRefs:=TList.Create;
-        ObjSymbolDefines:=TList.Create;
+        ObjSymbolRefs:=TFPObjectList.Create(false);
+        ObjSymbolDefines:=TFPObjectList.Create(false);
       end;
 
 
@@ -488,7 +490,7 @@ implementation
         FSecOptions:=FSecOptions+AOptions;
         if (oso_data in secoptions) and
            not assigned(FData) then
-          FData:=TDynamicArray.Create(8192);
+          FData:=TDynamicArray.Create(sectiondatagrowsize);
       end;
 
 
@@ -603,14 +605,14 @@ implementation
           is only used for lookups }
         FObjSectionDict:=tdictionary.create;
         FObjSectionDict.noclear:=true;
-        FObjSectionList:=TList.Create;
+        FObjSectionList:=TFPObjectList.Create(true);
         FStabsObjSec:=nil;
         FStabStrObjSec:=nil;
         { symbols }
         FObjSymbolDict:=tdictionary.create;
         FObjSymbolDict.noclear:=true;
-        FObjSymbolList:=TList.create;
-        FCachedAsmSymbolList:=TList.create;
+        FObjSymbolList:=TFPObjectList.Create(true);
+        FCachedAsmSymbolList:=TFPObjectList.Create(false);
         { section class type for creating of new sections }
         FCObjSection:=TObjSection;
       end;
@@ -1058,7 +1060,7 @@ implementation
         MemPos:=0;
         DataPos:=0;
         FSecSymIdx:=0;
-        FObjSectionList:=TList.Create;
+        FObjSectionList:=TFPObjectList.Create(false);
       end;
 
 
@@ -1096,18 +1098,20 @@ implementation
         { init writer }
         FWriter:=TObjectwriter.create;
         { object files }
-        FObjDataList:=tlist.create;
+        FObjDataList:=TFPObjectList.Create(true);
         { symbols }
         FExeSymbolDict:=tdictionary.create;
+        FExeSymbolDict.noclear:=true;
         FExeSymbolDict.usehash;
-        FExeSymbolList:=TList.Create;
-        FUnresolvedExeSymbols:=TList.create;
-        FExternalObjSymbols:=TList.create;
-        FCommonObjSymbols:=TList.create;
+        FExeSymbolList:=TFPObjectList.Create(true);
+        FUnresolvedExeSymbols:=TFPObjectList.Create(false);
+        FExternalObjSymbols:=TFPObjectList.Create(false);
+        FCommonObjSymbols:=TFPObjectList.Create(false);
         FEntryName:='start';
         { sections }
         FExeSectionDict:=TDictionary.create;
-        FExeSectionList:=TList.create;
+        FExeSectionDict.noclear:=true;
+        FExeSectionList:=TFPObjectList.Create(true);
         FImageBase:=0;
         SectionMemAlign:=$1000;
         SectionDataAlign:=$200;

+ 36 - 36
compiler/ogcoff.pas

@@ -85,13 +85,13 @@ interface
          FCoffSyms,
          FCoffStrs : tdynamicarray;
          procedure write_symbol(const name:string;value:aint;section:smallint;typ,aux:byte);
-         procedure section_write_symbol(p,arg:pointer);
-         procedure section_write_relocs(p,arg:pointer);
+         procedure section_write_symbol(p:TObject;arg:pointer);
+         procedure section_write_relocs(p:TObject;arg:pointer);
          procedure create_symbols(data:TObjData);
-         procedure section_set_datapos(p,arg:pointer);
-         procedure section_set_reloc_datapos(p,arg:pointer);
-         procedure section_write_header(p,arg:pointer);
-         procedure section_write_data(p,arg:pointer);
+         procedure section_set_datapos(p:TObject;arg:pointer);
+         procedure section_set_reloc_datapos(p:TObject;arg:pointer);
+         procedure section_write_header(p:TObject;arg:pointer);
+         procedure section_write_data(p:TObject;arg:pointer);
        protected
          function writedata(data:TObjData):boolean;override;
        public
@@ -129,11 +129,11 @@ interface
          nsects    : word;
          nsyms,
          sympos    : aint;
-         procedure ExeSections_pass2_header(p,arg:pointer);
+         procedure ExeSections_pass2_header(p:TObject;arg:pointer);
          procedure write_symbol(const name:string;value:aint;section:smallint;typ,aux:byte);
-         procedure globalsyms_write_symbol(p,arg:pointer);
-         procedure ExeSections_write_header(p,arg:pointer);
-         procedure ExeSections_write_data(p,arg:pointer);
+         procedure globalsyms_write_symbol(p:TObject;arg:pointer);
+         procedure ExeSections_write_header(p:TObject;arg:pointer);
+         procedure ExeSections_write_data(p:TObject;arg:pointer);
        protected
          procedure CalcPos_Header;override;
          procedure CalcPos_Symbols;override;
@@ -170,8 +170,8 @@ interface
          win32     : boolean;
          procedure read_relocs(s:TCoffObjSection);
          procedure read_symbols(objdata:TObjData);
-         procedure ObjSections_read_data(p,arg:pointer);
-         procedure ObjSections_read_relocs(p,arg:pointer);
+         procedure ObjSections_read_data(p:TObject;arg:pointer);
+         procedure ObjSections_read_relocs(p:TObject;arg:pointer);
        protected
          function  readObjData(objdata:TObjData):boolean;override;
        public
@@ -1029,7 +1029,7 @@ const win32stub : array[0..131] of byte=(
       end;
 
 
-    procedure TCoffObjOutput.section_write_symbol(p,arg:pointer);
+    procedure TCoffObjOutput.section_write_symbol(p:TObject;arg:pointer);
       var
         secrec : coffsectionrec;
       begin
@@ -1048,7 +1048,7 @@ const win32stub : array[0..131] of byte=(
       end;
 
 
-    procedure TCoffObjOutput.section_write_relocs(p,arg:pointer);
+    procedure TCoffObjOutput.section_write_relocs(p:TObject;arg:pointer);
       var
         rel  : coffreloc;
         r    : TObjRelocation;
@@ -1108,7 +1108,7 @@ const win32stub : array[0..131] of byte=(
            inc(symidx);
            FCoffSyms.write(filename[1],sizeof(filename)-1);
            { Sections }
-           ObjSectionList.foreach(@section_write_symbol,nil);
+           ObjSectionList.ForEachCall(@section_write_symbol,nil);
            { ObjSymbols }
            for i:=0 to ObjSymbolList.Count-1 do
              begin
@@ -1141,20 +1141,20 @@ const win32stub : array[0..131] of byte=(
       end;
 
 
-    procedure TCoffObjOutput.section_set_datapos(p,arg:pointer);
+    procedure TCoffObjOutput.section_set_datapos(p:TObject;arg:pointer);
       begin
         TObjSection(p).setdatapos(paint(arg)^);
       end;
 
 
-    procedure TCoffObjOutput.section_set_reloc_datapos(p,arg:pointer);
+    procedure TCoffObjOutput.section_set_reloc_datapos(p:TObject;arg:pointer);
       begin
         TCoffObjSection(p).coffrelocpos:=paint(arg)^;
         inc(paint(arg)^,sizeof(coffreloc)*TObjSection(p).relocations.count);
       end;
 
 
-    procedure TCoffObjOutput.section_write_header(p,arg:pointer);
+    procedure TCoffObjOutput.section_write_header(p:TObject;arg:pointer);
       var
         sechdr   : coffsechdr;
         s        : string;
@@ -1197,7 +1197,7 @@ const win32stub : array[0..131] of byte=(
       end;
 
 
-    procedure TCoffObjOutput.section_write_data(p,arg:pointer);
+    procedure TCoffObjOutput.section_write_data(p:TObject;arg:pointer);
       begin
         with TObjSection(p) do
           begin
@@ -1232,10 +1232,10 @@ const win32stub : array[0..131] of byte=(
            { Calculate the filepositions }
            datapos:=sizeof(coffheader)+sizeof(coffsechdr)*ObjSectionList.Count;
            { Sections first }
-           ObjSectionList.foreach(@section_set_datapos,@datapos);
+           ObjSectionList.ForEachCall(@section_set_datapos,@datapos);
            { relocs }
            orgdatapos:=datapos;
-           ObjSectionList.foreach(@section_set_reloc_datapos,@datapos);
+           ObjSectionList.ForEachCall(@section_set_reloc_datapos,@datapos);
            gotreloc:=(orgdatapos<>datapos);
            { Symbols }
            sympos:=datapos;
@@ -1261,11 +1261,11 @@ const win32stub : array[0..131] of byte=(
              end;
            FWriter.write(header,sizeof(header));
            { Section headers }
-           ObjSectionList.foreach(@section_write_header,nil);
+           ObjSectionList.ForEachCall(@section_write_header,nil);
            { ObjSections }
-           ObjSectionList.foreach(@section_write_data,nil);
+           ObjSectionList.ForEachCall(@section_write_data,nil);
            { Relocs }
-           ObjSectionList.foreach(@section_write_relocs,nil);
+           ObjSectionList.ForEachCall(@section_write_relocs,nil);
            { ObjSymbols }
            if Sympos<>FWriter.ObjSize then
              internalerror(200603051);
@@ -1465,7 +1465,7 @@ const win32stub : array[0..131] of byte=(
       end;
 
 
-    procedure TCoffObjInput.ObjSections_read_data(p,arg:pointer);
+    procedure TCoffObjInput.ObjSections_read_data(p:TObject;arg:pointer);
       begin
         with TCoffObjSection(p) do
           begin
@@ -1487,7 +1487,7 @@ const win32stub : array[0..131] of byte=(
       end;
 
 
-    procedure TCoffObjInput.ObjSections_read_relocs(p,arg:pointer);
+    procedure TCoffObjInput.ObjSections_read_relocs(p:TObject;arg:pointer);
       begin
         with TCoffObjSection(p) do
           begin
@@ -1597,9 +1597,9 @@ const win32stub : array[0..131] of byte=(
            { Insert all ObjSymbols }
            read_symbols(objdata);
            { Section Data }
-           ObjSectionList.foreach(@objsections_read_data,nil);
+           ObjSectionList.ForEachCall(@objsections_read_data,nil);
            { Relocs }
-           ObjSectionList.foreach(@objsections_read_relocs,nil);
+           ObjSectionList.ForEachCall(@objsections_read_relocs,nil);
          end;
         FCoffStrs.Free;
         FCoffSyms.Free;
@@ -1679,7 +1679,7 @@ const win32stub : array[0..131] of byte=(
       end;
 
 
-    procedure TCoffexeoutput.globalsyms_write_symbol(p,arg:pointer);
+    procedure TCoffexeoutput.globalsyms_write_symbol(p:TObject;arg:pointer);
       var
         value  : aint;
         globalval : byte;
@@ -1703,7 +1703,7 @@ const win32stub : array[0..131] of byte=(
       end;
 
 
-    procedure TCoffexeoutput.ExeSections_write_header(p,arg:pointer);
+    procedure TCoffexeoutput.ExeSections_write_header(p:TObject;arg:pointer);
       var
         sechdr    : coffsechdr;
       begin
@@ -1741,7 +1741,7 @@ const win32stub : array[0..131] of byte=(
       end;
 
 
-    procedure TCoffexeoutput.ExeSections_pass2_header(p,arg:pointer);
+    procedure TCoffexeoutput.ExeSections_pass2_header(p:TObject;arg:pointer);
       begin
         with TExeSection(p) do
           begin
@@ -1751,7 +1751,7 @@ const win32stub : array[0..131] of byte=(
       end;
 
 
-    procedure Tcoffexeoutput.ExeSections_write_Data(p,arg:pointer);
+    procedure Tcoffexeoutput.ExeSections_write_Data(p:TObject;arg:pointer);
       var
         objsec : TObjSection;
         i      : longint;
@@ -1793,7 +1793,7 @@ const win32stub : array[0..131] of byte=(
           end;
         { retrieve amount of ObjSections }
         nsects:=0;
-        ExeSections.foreach(@ExeSections_pass2_header,@nsects);
+        ExeSections.ForEachCall(@ExeSections_pass2_header,@nsects);
         { calculate start positions after the headers }
         currdatapos:=stubsize+optheadersize+sizeof(coffsechdr)*nsects;
         currmempos:=stubsize+optheadersize+sizeof(coffsechdr)*nsects;
@@ -1923,16 +1923,16 @@ const win32stub : array[0..131] of byte=(
             FWriter.write(djoptheader,sizeof(djoptheader));
           end;
         { Section headers }
-        ExeSections.foreach(@ExeSections_write_header,nil);
+        ExeSections.ForEachCall(@ExeSections_write_header,nil);
         { Section data }
-        ExeSections.foreach(@ExeSections_write_data,nil);
+        ExeSections.ForEachCall(@ExeSections_write_data,nil);
         { Optional ObjSymbols }
         if not(cs_link_strip in aktglobalswitches) then
          begin
            if SymPos<>FWriter.Size then
              internalerror(200602252);
            { ObjSymbols }
-           ExeSymbolList.foreach(@globalsyms_write_symbol,nil);
+           ExeSymbolList.ForEachCall(@globalsyms_write_symbol,nil);
            { Strings }
            i:=FCoffStrs.size+4;
            FWriter.write(i,4);

+ 27 - 27
compiler/ogelf.pas

@@ -82,15 +82,15 @@ interface
          procedure createsymtab;
          procedure writesectionheader(s:TElf32ObjSection);
          procedure writesectiondata(s:TElf32ObjSection);
-         procedure section_write_symbol(p,arg:pointer);
-         procedure section_write_sh_string(p,arg:pointer);
-         procedure section_count_sections(p,arg:pointer);
-         procedure section_create_relocsec(p,arg:pointer);
-         procedure section_set_datapos(p,arg:pointer);
-         procedure section_relocsec_set_datapos(p,arg:pointer);
-         procedure section_write_data(p,arg:pointer);
-         procedure section_write_sechdr(p,arg:pointer);
-         procedure section_write_relocsec(p,arg:pointer);
+         procedure section_write_symbol(p:TObject;arg:pointer);
+         procedure section_write_sh_string(p:TObject;arg:pointer);
+         procedure section_count_sections(p:TObject;arg:pointer);
+         procedure section_create_relocsec(p:TObject;arg:pointer);
+         procedure section_set_datapos(p:TObject;arg:pointer);
+         procedure section_relocsec_set_datapos(p:TObject;arg:pointer);
+         procedure section_write_data(p:TObject;arg:pointer);
+         procedure section_write_sechdr(p:TObject;arg:pointer);
+         procedure section_write_relocsec(p:TObject;arg:pointer);
        protected
          function writedata(data:TObjData):boolean;override;
        public
@@ -489,7 +489,7 @@ implementation
       end;
 
 
-    procedure TElf32ObjectOutput.section_write_symbol(p,arg:pointer);
+    procedure TElf32ObjectOutput.section_write_symbol(p:TObject;arg:pointer);
       var
         elfsym : TElf32symbol;
       begin
@@ -527,7 +527,7 @@ implementation
            inc(symidx);
            inc(localsyms);
            { section }
-           ObjSectionList.foreach(@section_write_symbol,nil);
+           ObjSectionList.ForEachCall(@section_write_symbol,nil);
            { ObjSymbols }
            for i:=0 to ObjSymbolList.Count-1 do
              begin
@@ -592,7 +592,7 @@ implementation
       end;
 
 
-    procedure TElf32ObjectOutput.section_write_sh_string(p,arg:pointer);
+    procedure TElf32ObjectOutput.section_write_sh_string(p:TObject;arg:pointer);
       begin
         TElf32ObjSection(p).shstridx:=elf32data.shstrtabsect.writestr(TObjSection(p).name+#0);
         if assigned(TElf32ObjSection(p).relocsect) then
@@ -610,7 +610,7 @@ implementation
               symtabsect.shstridx:=writestr('.symtab'#0);
               strtabsect.shstridx:=writestr('.strtab'#0);
               shstrtabsect.shstridx:=writestr('.shstrtab'#0);
-              ObjSectionList.foreach(@section_write_sh_string,nil);
+              ObjSectionList.ForEachCall(@section_write_sh_string,nil);
             end;
          end;
       end;
@@ -642,7 +642,7 @@ implementation
       end;
 
 
-    procedure TElf32ObjectOutput.section_count_sections(p,arg:pointer);
+    procedure TElf32ObjectOutput.section_count_sections(p:TObject;arg:pointer);
       begin
         TElf32ObjSection(p).secshidx:=pword(arg)^;
         inc(pword(arg)^);
@@ -651,27 +651,27 @@ implementation
       end;
 
 
-    procedure TElf32ObjectOutput.section_create_relocsec(p,arg:pointer);
+    procedure TElf32ObjectOutput.section_create_relocsec(p:TObject;arg:pointer);
       begin
         if (TElf32ObjSection(p).relocations.count>0) then
           createrelocsection(TElf32ObjSection(p));
       end;
 
 
-    procedure TElf32ObjectOutput.section_set_datapos(p,arg:pointer);
+    procedure TElf32ObjectOutput.section_set_datapos(p:TObject;arg:pointer);
       begin
         TObjSection(p).setdatapos(paint(arg)^);
       end;
 
 
-    procedure TElf32ObjectOutput.section_relocsec_set_datapos(p,arg:pointer);
+    procedure TElf32ObjectOutput.section_relocsec_set_datapos(p:TObject;arg:pointer);
       begin
         if assigned(TElf32ObjSection(p).relocsect) then
           TElf32ObjSection(p).relocsect.setdatapos(paint(arg)^);
       end;
 
 
-    procedure TElf32ObjectOutput.section_write_data(p,arg:pointer);
+    procedure TElf32ObjectOutput.section_write_data(p:TObject;arg:pointer);
       begin
         if (oso_data in TObjSection(p).secoptions) then
           begin
@@ -682,7 +682,7 @@ implementation
       end;
 
 
-    procedure TElf32ObjectOutput.section_write_sechdr(p,arg:pointer);
+    procedure TElf32ObjectOutput.section_write_sechdr(p:TObject;arg:pointer);
       begin
         writesectionheader(TElf32ObjSection(p));
         if assigned(TElf32ObjSection(p).relocsect) then
@@ -690,7 +690,7 @@ implementation
       end;
 
 
-    procedure TElf32ObjectOutput.section_write_relocsec(p,arg:pointer);
+    procedure TElf32ObjectOutput.section_write_relocsec(p:TObject;arg:pointer);
       begin
         if assigned(TElf32ObjSection(p).relocsect) then
           writesectiondata(TElf32ObjSection(p).relocsect);
@@ -712,7 +712,7 @@ implementation
            { calc amount of sections we have }
            nsections:=1;
            { also create the index in the section header table }
-           ObjSectionList.foreach(@section_count_sections,@nsections);
+           ObjSectionList.ForEachCall(@section_count_sections,@nsections);
            { add default sections }
            shstrtabsect.secshidx:=nsections;
            inc(nsections);
@@ -723,14 +723,14 @@ implementation
            { create .symtab and .strtab }
            createsymtab;
            { Create the relocation sections }
-           ObjSectionList.foreach(@section_create_relocsec,nil);
+           ObjSectionList.ForEachCall(@section_create_relocsec,nil);
            { create .shstrtab }
            createshstrtab;
 
            { Calculate the filepositions }
            datapos:=$40; { elfheader + alignment }
            { sections first }
-           ObjSectionList.foreach(@section_set_datapos,@datapos);
+           ObjSectionList.ForEachCall(@section_set_datapos,@datapos);
            { shstrtab }
            shstrtabsect.setdatapos(datapos);
            { section headers }
@@ -741,7 +741,7 @@ implementation
            { strtab }
            strtabsect.setdatapos(datapos);
            { .rel sections }
-           ObjSectionList.foreach(@section_relocsec_set_datapos,@datapos);
+           ObjSectionList.ForEachCall(@section_relocsec_set_datapos,@datapos);
 
            { Write ELF Header }
            fillchar(header,sizeof(header),0);
@@ -760,12 +760,12 @@ implementation
            writer.write(header,sizeof(header));
            writer.writezeros($40-sizeof(header)); { align }
          { Sections }
-           ObjSectionList.foreach(@section_write_data,nil);
+           ObjSectionList.ForEachCall(@section_write_data,nil);
          { .shstrtab }
            writesectiondata(shstrtabsect);
          { section headers, start with an empty header for sh_undef }
            writer.writezeros(sizeof(TElf32sechdr));
-           ObjSectionList.foreach(@section_write_sechdr,nil);
+           ObjSectionList.ForEachCall(@section_write_sechdr,nil);
            writesectionheader(shstrtabsect);
            writesectionheader(symtabsect);
            writesectionheader(strtabsect);
@@ -774,7 +774,7 @@ implementation
          { .strtab }
            writesectiondata(strtabsect);
          { .rel sections }
-           ObjSectionList.foreach(@section_write_relocsec,nil);
+           ObjSectionList.ForEachCall(@section_write_relocsec,nil);
          end;
         result:=true;
       end;

+ 1 - 1
compiler/owar.pas

@@ -166,7 +166,7 @@ begin
    move(fn[1],arhdr.name,length(fn));
   { don't write a date if also no gid/uid/mode is specified }
   if gid<>'' then
-    move(timestamp[1],arhdr.date,sizeof(timestamp));
+    move(timestamp[1],arhdr.date,length(timestamp));
   str(asize,tmp);
   move(tmp[1],arhdr.size,length(tmp));
   move(gid[1],arhdr.gid,length(gid));

+ 1 - 1
compiler/parabase.pas

@@ -81,7 +81,7 @@ unit parabase;
          va_uses_float_reg
        );
 
-       tparalist = class(tlist)
+       tparalist = class(TFPObjectList)
           procedure SortParas;
        end;
 

+ 3 - 3
compiler/pdecl.pas

@@ -368,11 +368,11 @@ implementation
     { reads a type declaration to the symbol table }
     procedure type_dec;
 
-        function parse_generic_parameters:tlist;
+        function parse_generic_parameters:TFPObjectList;
         var
           generictype : ttypesym;
         begin
-          result:=tlist.create;
+          result:=TFPObjectList.Create(false);
           repeat
             if token=_ID then
               begin
@@ -396,7 +396,7 @@ implementation
          isgeneric,
          isunique,
          istyperenaming : boolean;
-         generictypelist : tlist;
+         generictypelist : TFPObjectList;
          generictokenbuf : tdynamicarray;
       begin
          old_block_type:=block_type;

+ 2 - 2
compiler/pdecobj.pas

@@ -30,7 +30,7 @@ interface
       globtype,symtype,symdef;
 
     { parses a object declaration }
-    function object_dec(const n : stringid;genericdef:tstoreddef;genericlist:tlist;fd : tobjectdef) : tdef;
+    function object_dec(const n : stringid;genericdef:tstoreddef;genericlist:TFPObjectList;fd : tobjectdef) : tdef;
 
 implementation
 
@@ -50,7 +50,7 @@ implementation
       current_procinfo = 'error';
 
 
-    function object_dec(const n : stringid;genericdef:tstoreddef;genericlist:tlist;fd : tobjectdef) : tdef;
+    function object_dec(const n : stringid;genericdef:tstoreddef;genericlist:TFPObjectList;fd : tobjectdef) : tdef;
     { this function parses an object or class declaration }
       var
          there_is_a_destructor : boolean;

+ 2 - 2
compiler/pdecsub.pas

@@ -381,7 +381,7 @@ implementation
       type
         tppv = (pv_none,pv_proc,pv_func);
       var
-        sc      : tlist;
+        sc      : TFPObjectList;
         tt      : ttype;
         arrayelementtype : ttype;
         vs      : tparavarsym;
@@ -409,7 +409,7 @@ implementation
         { parsing a proc or procvar ? }
         currparast:=tparasymtable(pd.parast);
         { reset }
-        sc:=tlist.create;
+        sc:=TFPObjectList.create(false);
         defaultrequired:=false;
         paranr:=0;
         { the variables are always public }

+ 7 - 7
compiler/pdecvar.pas

@@ -214,7 +214,7 @@ implementation
          arraytype : ttype;
          def : tdef;
          pt : tnode;
-         sc : tlist;
+         sc : TFPObjectList;
          paranr : word;
          i      : longint;
          hreadparavs,
@@ -252,7 +252,7 @@ implementation
                 Message(parser_e_cant_publish_that_property);
               { create a list of the parameters }
               symtablestack.push(readprocdef.parast);
-              sc:=tlist.create;
+              sc:=TFPObjectList.create(false);
               inc(testcurobject);
               repeat
                 if try_to_consume(_VAR) then
@@ -586,7 +586,7 @@ implementation
 
     procedure read_var_decls(options:Tvar_dec_options);
 
-      procedure read_default_value(sc : tlist;tt : ttype;is_threadvar : boolean);
+      procedure read_default_value(sc : TFPObjectList;tt : ttype;is_threadvar : boolean);
         var
           vs : tabstractnormalvarsym;
           tcsym : ttypedconstsym;
@@ -619,7 +619,7 @@ implementation
         end;
 
       var
-         sc : tlist;
+         sc : TFPObjectList;
          i  : longint;
          old_block_type : tblock_type;
          symdone : boolean;
@@ -648,7 +648,7 @@ implementation
          if not (token in [_ID,_CASE,_END]) then
            consume(_ID);
          { read vars }
-         sc:=tlist.create;
+         sc:=TFPObjectList.create(false);
          while (token=_ID) do
            begin
              sorg:=orgpattern;
@@ -1012,7 +1012,7 @@ implementation
 
     procedure read_record_fields(options:Tvar_dec_options);
       var
-         sc : tlist;
+         sc : TFPObjectList;
          i  : longint;
          old_block_type : tblock_type;
          old_current_object_option : tsymoptions;
@@ -1057,7 +1057,7 @@ implementation
          if not (token in [_ID,_CASE,_END]) then
           consume(_ID);
          { read vars }
-         sc:=tlist.create;
+         sc:=TFPObjectList.create(false);
          while (token=_ID) and
             not((vd_object in options) and
                 (idtoken in [_PUBLIC,_PRIVATE,_PUBLISHED,_PROTECTED,_STRICT])) do

+ 2 - 2
compiler/powerpc/aasmcpu.pas

@@ -435,7 +435,7 @@ uses cutils, cclasses;
       var
         p: tai;
         newjmp: taicpu;
-        labelpositions: tlist;
+        labelpositions: TFPList;
         instrpos: ptrint;
         l: tasmlabel;
         inserted_something: boolean;
@@ -443,7 +443,7 @@ uses cutils, cclasses;
         // if certainly not enough instructions to cause an overflow, don't bother
         if (list.count <= (high(smallint) div 4)) then
           exit;
-        labelpositions := tlist.create;
+        labelpositions := TFPList.create;
         p := tai(list.first);
         instrpos := 1;
         // record label positions

+ 1 - 1
compiler/powerpc64/aasmcpu.pas

@@ -464,7 +464,7 @@ procedure fixup_jmps(list: taasmoutput);
 var
   p: tai;
   newjmp: taicpu;
-  labelpositions: tlist;
+  labelpositions: TFPObjectList;
   instrpos: ptrint;
   l: tasmlabel;
   inserted_something: boolean;

+ 3 - 7
compiler/pstatmnt.pas

@@ -445,7 +445,7 @@ implementation
          refnode  : tnode;
          htype : ttype;
          hasimplicitderef : boolean;
-         withsymtablelist : tlist;
+         withsymtablelist : TFPObjectList;
 
          procedure pushobjchild(obj:tobjectdef);
          begin
@@ -539,7 +539,7 @@ implementation
                 resulttypepass(refnode);
               end;
 
-            withsymtablelist:=tlist.create;
+            withsymtablelist:=TFPObjectList.create(true);
             case p.resulttype.def.deftype of
               objectdef :
                 begin
@@ -573,11 +573,7 @@ implementation
 
             { remove symtables in reverse order from the stack }
             for i:=withsymtablelist.count-1 downto 0 do
-              begin
-                st:=tsymtable(withsymtablelist[i]);
-                symtablestack.pop(st);
-                st.free;
-              end;
+              symtablestack.pop(tsymtable(withsymtablelist[i]));
             withsymtablelist.free;
 
 //            p:=cwithnode.create(right,twithsymtable(withsymtable),levelcount,refnode);

+ 4 - 4
compiler/ptype.pas

@@ -41,7 +41,7 @@ interface
     { tdef }
     procedure single_type(var tt:ttype;isforwarddef:boolean);
 
-    procedure read_named_type(var tt:ttype;const name : stringid;genericdef:tstoreddef;genericlist:tlist;parseprocvardir:boolean);
+    procedure read_named_type(var tt:ttype;const name : stringid;genericdef:tstoreddef;genericlist:TFPObjectList;parseprocvardir:boolean);
     procedure read_anon_type(var tt : ttype;parseprocvardir:boolean);
 
     { reads a type definition }
@@ -80,7 +80,7 @@ implementation
         sym : tsym;
         genericdef : tstoreddef;
         generictype : ttypesym;
-        generictypelist : tlist;
+        generictypelist : TFPObjectList;
       begin
         { retrieve generic def that we are going to replace }
         genericdef:=tstoreddef(pt1.resulttype.def);
@@ -104,7 +104,7 @@ implementation
           the genericdef we need to have a new def }
         err:=false;
         first:=true;
-        generictypelist:=tlist.create;
+        generictypelist:=TFPObjectList.create(false);
         case genericdef.deftype of
           procdef :
             st:=genericdef.getsymtable(gs_para);
@@ -321,7 +321,7 @@ implementation
 
 
     { reads a type definition and returns a pointer to it }
-    procedure read_named_type(var tt : ttype;const name : stringid;genericdef:tstoreddef;genericlist:tlist;parseprocvardir:boolean);
+    procedure read_named_type(var tt : ttype;const name : stringid;genericdef:tstoreddef;genericlist:TFPObjectList;parseprocvardir:boolean);
       var
         pt : tnode;
         tt2 : ttype;

+ 1 - 1
compiler/symdef.pas

@@ -2893,7 +2893,7 @@ implementation
           we need to reresolve this unit (PFV) }
         if assigned(paras) then
           paras.free;
-        paras:=tparalist.create;
+        paras:=tparalist.create(false);
         paracount:=0;
         minparacount:=0;
         maxparacount:=0;

+ 2 - 2
compiler/symsym.pas

@@ -109,7 +109,7 @@ interface
           function last_procdef:Tprocdef;
           function search_procdef_nopara_boolret:Tprocdef;
           function search_procdef_bytype(pt:Tproctypeoption):Tprocdef;
-          function search_procdef_bypara(para:tlist;retdef:tdef;cpoptions:tcompare_paras_options):Tprocdef;
+          function search_procdef_bypara(para:TFPObjectList;retdef:tdef;cpoptions:tcompare_paras_options):Tprocdef;
           function search_procdef_byprocvardef(d:Tprocvardef):Tprocdef;
           function search_procdef_assignment_operator(fromdef,todef:tdef;var besteq:tequaltype):Tprocdef;
           function  write_references(ppufile:tcompilerppufile;locals:boolean):boolean;override;
@@ -833,7 +833,7 @@ implementation
       end;
 
 
-    function Tprocsym.search_procdef_bypara(para:tlist;retdef:tdef;
+    function Tprocsym.search_procdef_bypara(para:TFPObjectList;retdef:tdef;
                                             cpoptions:tcompare_paras_options):Tprocdef;
       var
         pd : pprocdeflist;

+ 9 - 9
compiler/systems/t_win.pas

@@ -61,8 +61,8 @@ interface
 
     texportlibwin32=class(texportlib)
       st : string;
-      EList_indexed:tList;
-      EList_nonindexed:tList;
+      EList_indexed:TFPList;
+      EList_nonindexed:TFPList;
       procedure preparelib(const s:string);override;
       procedure exportprocedure(hp : texported_item);override;
       procedure exportvar(hp : texported_item);override;
@@ -127,7 +127,7 @@ implementation
 
     procedure timportlibwin32.win32importproc(aprocdef:tprocdef;const func,module : string;index : longint;const name : string);
       var
-         hp1 : timportlist;
+         hp1 : timportList;
          hp2 : twin32imported_item;
          hs  : string;
       begin
@@ -209,7 +209,7 @@ implementation
 
     procedure timportlibwin32.importvariable_str(const s:string;const name,module:string);
       var
-         hp1 : timportlist;
+         hp1 : timportList;
          hp2 : twin32imported_item;
          hs  : string;
       begin
@@ -245,7 +245,7 @@ implementation
 
     procedure timportlibwin32.generatenasmlib;
       var
-         hp1 : timportlist;
+         hp1 : timportList;
          hp2 : twin32imported_item;
       begin
          new_section(asmlist[al_imports],sec_code,'',0);
@@ -266,7 +266,7 @@ implementation
 
     procedure timportlibwin32.generatesmartlib;
       var
-         hp1 : timportlist;
+         hp1 : timportList;
          mangledstring : string;
          importname : string;
          suffix : integer;
@@ -417,7 +417,7 @@ implementation
 
     procedure timportlibwin32.generatelib;
       var
-         hp1 : timportlist;
+         hp1 : timportList;
          hp2 : twin32imported_item;
          l1,l2,l3,l4 {$ifdef ARM} ,l5 {$endif ARM} : tasmlabel;
          mangledstring : string;
@@ -573,8 +573,8 @@ implementation
       begin
          if asmlist[al_exports]=nil then
            asmlist[al_exports]:=TAAsmoutput.create;
-         EList_indexed:=tList.Create;
-         EList_nonindexed:=tList.Create;
+         EList_indexed:=tFPList.Create;
+         EList_nonindexed:=tFPList.Create;
          objectlibrary.getdatalabel(edatalabel);
       end;