* patch by Rika: Use Index* for pointer lists, resolves #40218

This commit is contained in:
florian 2023-03-25 21:32:29 +01:00
parent 3ad8b4199c
commit 466561f09f
4 changed files with 66 additions and 66 deletions

View File

@ -69,8 +69,6 @@ type
const const
MaxListSize = Maxint div 16; MaxListSize = Maxint div 16;
type type
PPointerList = ^TPointerList;
TPointerList = array[0..MaxListSize - 1] of Pointer;
TListSortCompare = function (Item1, Item2: Pointer): Integer; TListSortCompare = function (Item1, Item2: Pointer): Integer;
TListCallback = procedure(data,arg:pointer) of object; TListCallback = procedure(data,arg:pointer) of object;
TListStaticCallback = procedure(data,arg:pointer); TListStaticCallback = procedure(data,arg:pointer);
@ -78,7 +76,7 @@ type
TDirection = (FromBeginning,FromEnd); TDirection = (FromBeginning,FromEnd);
TFPList = class(TObject) TFPList = class(TObject)
private private
FList: PPointerList; FList: PPointer;
FCount: Integer; FCount: Integer;
FCapacity: Integer; FCapacity: Integer;
protected protected
@ -87,7 +85,7 @@ type
procedure SetCapacity(NewCapacity: Integer); procedure SetCapacity(NewCapacity: Integer);
procedure SetCount(NewCount: Integer); procedure SetCount(NewCount: Integer);
Procedure RaiseIndexError(Index : Integer); Procedure RaiseIndexError(Index : Integer);
property List: PPointerList read FList; property List: PPointer read FList;
public public
destructor Destroy; override; destructor Destroy; override;
function Add(Item: Pointer): Integer; function Add(Item: Pointer): Integer;
@ -593,6 +591,7 @@ type
implementation implementation
{***************************************************************************** {*****************************************************************************
Memory debug Memory debug
*****************************************************************************} *****************************************************************************}
@ -721,14 +720,14 @@ function TFPList.Get(Index: Integer): Pointer;
begin begin
If (Index < 0) or (Index >= FCount) then If (Index < 0) or (Index >= FCount) then
RaiseIndexError(Index); RaiseIndexError(Index);
Result:=FList^[Index]; Result:=FList[Index];
end; end;
procedure TFPList.Put(Index: Integer; Item: Pointer); procedure TFPList.Put(Index: Integer; Item: Pointer);
begin begin
if (Index < 0) or (Index >= FCount) then if (Index < 0) or (Index >= FCount) then
RaiseIndexError(Index); RaiseIndexError(Index);
Flist^[Index] := Item; Flist[Index] := Item;
end; end;
function TFPList.Extract(item: Pointer): Pointer; function TFPList.Extract(item: Pointer): Pointer;
@ -740,7 +739,7 @@ begin
if i >= 0 then if i >= 0 then
begin begin
Result := item; Result := item;
FList^[i] := nil; FList[i] := nil;
Delete(i); Delete(i);
end; end;
end; end;
@ -764,7 +763,7 @@ begin
If NewCount > FCapacity then If NewCount > FCapacity then
SetCapacity(NewCount); SetCapacity(NewCount);
If FCount < NewCount then If FCount < NewCount then
FillChar(Flist^[FCount], (NewCount-FCount) * sizeof(Pointer), 0); FillChar(Flist[FCount], (NewCount-FCount) * sizeof(Pointer), 0);
end; end;
FCount := Newcount; FCount := Newcount;
end; end;
@ -779,7 +778,7 @@ function TFPList.Add(Item: Pointer): Integer;
begin begin
if FCount = FCapacity then if FCount = FCapacity then
Self.Expand; Self.Expand;
FList^[FCount] := Item; FList[FCount] := Item;
Result := FCount; Result := FCount;
inc(FCount); inc(FCount);
end; end;
@ -799,7 +798,7 @@ begin
If (Index<0) or (Index>=FCount) then If (Index<0) or (Index>=FCount) then
Error (SListIndexError, Index); Error (SListIndexError, Index);
dec(FCount); dec(FCount);
System.Move (FList^[Index+1], FList^[Index], (FCount - Index) * SizeOf(Pointer)); System.Move (FList[Index+1], FList[Index], (FCount - Index) * SizeOf(Pointer));
{ Shrink the list if appropriate } { Shrink the list if appropriate }
if (FCapacity > 256) and (FCount < FCapacity shr 2) then if (FCapacity > 256) and (FCount < FCapacity shr 2) then
begin begin
@ -821,9 +820,9 @@ begin
Error(SListIndexError, Index1); Error(SListIndexError, Index1);
If ((Index2 >= FCount) or (Index2 < 0)) then If ((Index2 >= FCount) or (Index2 < 0)) then
Error(SListIndexError, Index2); Error(SListIndexError, Index2);
Temp := FList^[Index1]; Temp := FList[Index1];
FList^[Index1] := FList^[Index2]; FList[Index1] := FList[Index2];
FList^[Index2] := Temp; FList[Index2] := Temp;
end; end;
function TFPList.Expand: TFPList; function TFPList.Expand: TFPList;
@ -852,21 +851,16 @@ begin
end; end;
function TFPList.IndexOf(Item: Pointer): Integer; function TFPList.IndexOf(Item: Pointer): Integer;
var
psrc : PPointer;
Index : Integer;
begin begin
Result:=-1; Result:=
psrc:=@FList^[0]; {$if sizeof(pointer)=sizeof(dword)}
For Index:=0 To FCount-1 Do IndexDWord
begin {$elseif sizeof(pointer)=sizeof(qword)}
if psrc^=Item then IndexQWord
begin {$else}
Result:=Index; {$error unknown pointer size}
exit; {$endif}
end; (FList^, FCount, PtrUint(Item));
inc(psrc);
end;
end; end;
function TFPList.IndexOfItem(Item: Pointer; Direction: TDirection): Integer; function TFPList.IndexOfItem(Item: Pointer; Direction: TDirection): Integer;
@ -881,7 +875,7 @@ begin
Result:=-1; Result:=-1;
if FCount>0 then if FCount>0 then
begin begin
psrc:=@FList^[FCount-1]; psrc:=@FList[FCount-1];
For Index:=FCount-1 downto 0 Do For Index:=FCount-1 downto 0 Do
begin begin
if psrc^=Item then if psrc^=Item then
@ -901,8 +895,8 @@ begin
Error(SlistIndexError, Index); Error(SlistIndexError, Index);
iF FCount = FCapacity then Self.Expand; iF FCount = FCapacity then Self.Expand;
if Index<FCount then if Index<FCount then
System.Move(Flist^[Index], Flist^[Index+1], (FCount - Index) * SizeOf(Pointer)); System.Move(Flist[Index], Flist[Index+1], (FCount - Index) * SizeOf(Pointer));
FList^[Index] := Item; FList[Index] := Item;
FCount := FCount + 1; FCount := FCount + 1;
end; end;
@ -922,11 +916,11 @@ begin
Error(SListIndexError, CurIndex); Error(SListIndexError, CurIndex);
if (NewINdex < 0) then if (NewINdex < 0) then
Error(SlistIndexError, NewIndex); Error(SlistIndexError, NewIndex);
Temp := FList^[CurIndex]; Temp := FList[CurIndex];
FList^[CurIndex] := nil; FList[CurIndex] := nil;
Self.Delete(CurIndex); Self.Delete(CurIndex);
Self.Insert(NewIndex, nil); Self.Insert(NewIndex, nil);
FList^[NewIndex] := Temp; FList[NewIndex] := Temp;
end; end;
function TFPList.Remove(Item: Pointer): Integer; function TFPList.Remove(Item: Pointer): Integer;
@ -944,7 +938,7 @@ var
psrc : PPointer; psrc : PPointer;
begin begin
NewCount:=0; NewCount:=0;
psrc:=@FList^[0]; psrc:=@FList[0];
pdest:=psrc; pdest:=psrc;
For I:=0 To FCount-1 Do For I:=0 To FCount-1 Do
begin begin
@ -960,7 +954,7 @@ begin
end; end;
Procedure QuickSort(FList: PPointerList; L, R : Longint;Compare: TListSortCompare); Procedure QuickSort(FList: PPointer; L, R : Longint;Compare: TListSortCompare);
var var
I, J, P: Longint; I, J, P: Longint;
PItem, Q : Pointer; PItem, Q : Pointer;
@ -970,16 +964,16 @@ begin
J := R; J := R;
P := (L + R) div 2; P := (L + R) div 2;
repeat repeat
PItem := FList^[P]; PItem := FList[P];
while Compare(PItem, FList^[i]) > 0 do while Compare(PItem, FList[i]) > 0 do
I := I + 1; I := I + 1;
while Compare(PItem, FList^[J]) < 0 do while Compare(PItem, FList[J]) < 0 do
J := J - 1; J := J - 1;
If I <= J then If I <= J then
begin begin
Q := FList^[I]; Q := FList[I];
Flist^[I] := FList^[J]; Flist[I] := FList[J];
FList^[J] := Q; FList[J] := Q;
if P = I then if P = I then
P := J P := J
else if P = J then else if P = J then
@ -1017,7 +1011,7 @@ var
begin begin
For I:=0 To Count-1 Do For I:=0 To Count-1 Do
begin begin
p:=FList^[i]; p:=FList[i];
if assigned(p) then if assigned(p) then
proc2call(p,arg); proc2call(p,arg);
end; end;
@ -1031,7 +1025,7 @@ var
begin begin
For I:=0 To Count-1 Do For I:=0 To Count-1 Do
begin begin
p:=FList^[i]; p:=FList[i];
if assigned(p) then if assigned(p) then
proc2call(p,arg); proc2call(p,arg);
end; end;

View File

@ -95,9 +95,9 @@ unit optutils;
i : longint; i : longint;
begin begin
for i:=0 to Count-1 do for i:=0 to Count-1 do
if tnode(List^[i]).isequal(node) then if tnode(List[i]).isequal(node) then
begin begin
result:=tnode(List^[i]); result:=tnode(List[i]);
exit; exit;
end; end;
result:=nil; result:=nil;

View File

@ -210,16 +210,16 @@ end;
function TFPList.IndexOf(Item: Pointer): Integer; function TFPList.IndexOf(Item: Pointer): Integer;
Var
C : Integer;
begin begin
Result:=0; Result :=
C:=Count; {$if sizeof(pointer) = sizeof(dword)}
while (Result<C) and (Flist^[Result]<>Item) do IndexDWord
Inc(Result); {$elseif sizeof(pointer) = sizeof(qword)}
If Result>=C then IndexQWord
Result:=-1; {$else}
{$error unknown pointer size}
{$endif}
(FList^, FCount, PtrUint(Item));
end; end;
function TFPList.IndexOfItem(Item: Pointer; Direction: TDirection): Integer; function TFPList.IndexOfItem(Item: Pointer; Direction: TDirection): Integer;

View File

@ -1127,12 +1127,15 @@ end;
function TFPGObjectList.IndexOf(const Item: T): Integer; function TFPGObjectList.IndexOf(const Item: T): Integer;
begin begin
Result := 0; Result :=
{$info TODO: fix inlining to work! InternalItems[Result]^} {$if sizeof(pointer) = sizeof(dword)}
while (Result < FCount) and (PT(FList)[Result] <> Item) do IndexDWord
Inc(Result); {$elseif sizeof(pointer) = sizeof(qword)}
if Result = FCount then IndexQWord
Result := -1; {$else}
{$error unknown pointer size}
{$endif}
(FList^, FCount, PtrUint(Pointer(Item)));
end; end;
procedure TFPGObjectList.Insert(Index: Integer; const Item: T); procedure TFPGObjectList.Insert(Index: Integer; const Item: T);
@ -1259,12 +1262,15 @@ end;
function TFPGInterfacedObjectList.IndexOf(const Item: T): Integer; function TFPGInterfacedObjectList.IndexOf(const Item: T): Integer;
begin begin
Result := 0; Result :=
{$info TODO: fix inlining to work! InternalItems[Result]^} {$if sizeof(pointer) = sizeof(dword)}
while (Result < FCount) and (PT(FList)[Result] <> Item) do IndexDWord
Inc(Result); {$elseif sizeof(pointer) = sizeof(qword)}
if Result = FCount then IndexQWord
Result := -1; {$else}
{$error unknown pointer size}
{$endif}
(FList^, FCount, PtrUint(Pointer(Item)));
end; end;
procedure TFPGInterfacedObjectList.Insert(Index: Integer; const Item: T); procedure TFPGInterfacedObjectList.Insert(Index: Integer; const Item: T);