mirror of
https://gitlab.com/freepascal.org/fpc/source.git
synced 2025-04-18 20:39:43 +02:00
TList completely implemented
This commit is contained in:
michael
parent
458c36408c
commit
7e4ff5bbcf
@ -11,6 +11,7 @@
|
||||
MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.
|
||||
|
||||
**********************************************************************}
|
||||
|
||||
{****************************************************************************}
|
||||
{* TList *}
|
||||
{****************************************************************************}
|
||||
@ -21,11 +22,14 @@
|
||||
FCount: Integer;
|
||||
FCapacity: Integer;
|
||||
}
|
||||
Const
|
||||
// Ratio of Pointer and Word Size.
|
||||
WordRatio = SizeOf(Pointer) Div SizeOf(Word);
|
||||
|
||||
function TList.Get(Index: Integer): Pointer;
|
||||
|
||||
begin
|
||||
If (Index<0) or (Index>Count) then
|
||||
If (Index<0) or (Index>FCount) then
|
||||
Runerror (255);
|
||||
Result:=FList^[Index];
|
||||
end;
|
||||
@ -35,7 +39,7 @@ end;
|
||||
procedure TList.Grow;
|
||||
|
||||
begin
|
||||
|
||||
// Only for compatibility with Delphi. Not needed.
|
||||
end;
|
||||
|
||||
|
||||
@ -43,18 +47,42 @@ end;
|
||||
procedure TList.Put(Index: Integer; Item: Pointer);
|
||||
|
||||
begin
|
||||
if Index<0 then
|
||||
Runerror(255)
|
||||
While Index>Capacity do Grow;
|
||||
Flist[I^ndex]:=Item;
|
||||
If Index>Count then Count:=Index;
|
||||
if (Index<0) or (Index>=FCount) then
|
||||
Runerror(255);
|
||||
Flist^[Index]:=Item;
|
||||
end;
|
||||
|
||||
|
||||
|
||||
procedure TList.SetCapacity(NewCapacity: Integer);
|
||||
|
||||
Var NewList,ToFree : PPointerList;
|
||||
|
||||
begin
|
||||
If (NewCapacity<0) or (NewCapacity>MaxListSize) then
|
||||
RunError (255);
|
||||
If NewCapacity>FCapacity then
|
||||
begin
|
||||
GetMem (NewList,NewCapacity*SizeOf(Pointer));
|
||||
If NewList=Nil then
|
||||
Runerror(255);
|
||||
If Assigned(FList) then
|
||||
begin
|
||||
System.Move (FList^,NewList^,FCapacity*Sizeof(Pointer));
|
||||
FillWord (NewList^[FCapacity],(NewCapacity-FCapacity)*WordRatio, 0);
|
||||
FreeMem (Flist,FCapacity*SizeOf(Pointer));
|
||||
end;
|
||||
Flist:=NewList;
|
||||
FCapacity:=NewCapacity;
|
||||
end
|
||||
else if NewCapacity<FCapacity then
|
||||
begin
|
||||
If NewCapacity<0 then
|
||||
RunError(255);
|
||||
ToFree:=Flist+NewCapacity*SizeOf(Pointer);
|
||||
FreeMem (ToFree, (FCapacity-NewCapacity)*SizeOf(Pointer));
|
||||
FCapacity:=NewCapacity;
|
||||
end;
|
||||
end;
|
||||
|
||||
|
||||
@ -62,14 +90,16 @@ end;
|
||||
procedure TList.SetCount(NewCount: Integer);
|
||||
|
||||
begin
|
||||
If NewCount<0 then
|
||||
If (NewCount<0) or (NewCount>MaxListSize)then
|
||||
RunError(255);
|
||||
If NewCount<Count then
|
||||
If NewCount<FCount then
|
||||
FCount:=NewCount
|
||||
else
|
||||
else If NewCount>FCount then
|
||||
begin
|
||||
While NewCount>Capacity do Grow;
|
||||
FillByte (Flist[count],(Newcount-Count)*SizeOF(Pointer),0);
|
||||
If NewCount>FCapacity then
|
||||
SetCapacity (NewCount);
|
||||
If FCount<NewCount then
|
||||
FillWord (Flist^[FCount],(NewCount-FCount)* WordRatio ,0);
|
||||
FCount:=Newcount;
|
||||
end;
|
||||
end;
|
||||
@ -79,7 +109,7 @@ end;
|
||||
destructor TList.Destroy;
|
||||
|
||||
begin
|
||||
Clear;
|
||||
Self.Clear;
|
||||
inherited Destroy;
|
||||
end;
|
||||
|
||||
@ -88,6 +118,7 @@ Function TList.Add(Item: Pointer): Integer;
|
||||
|
||||
begin
|
||||
Self.Insert (Count,Item);
|
||||
Result:=Count-1;
|
||||
end;
|
||||
|
||||
|
||||
@ -97,10 +128,10 @@ Procedure TList.Clear;
|
||||
begin
|
||||
If Assigned(FList) then
|
||||
begin
|
||||
FreeMem (Flist,FCapacity);
|
||||
FreeMem (Flist,FCapacity*SizeOf(Pointer));
|
||||
FList:=Nil;
|
||||
FCapacity:=nil;
|
||||
FCount:=Nil;
|
||||
FCapacity:=0;
|
||||
FCount:=0;
|
||||
end;
|
||||
end;
|
||||
|
||||
@ -109,57 +140,64 @@ end;
|
||||
Procedure TList.Delete(Index: Integer);
|
||||
|
||||
begin
|
||||
If (Index<0) or (Index>=FCount) then
|
||||
Runerror(255);
|
||||
FCount:=FCount-1;
|
||||
System.Move (FList^[Index+1],FList^[Index],(FCount-Index)*SizeOf(Pointer));
|
||||
end;
|
||||
|
||||
|
||||
class procedure TList.Error(const Msg: string; Data: Integer);
|
||||
|
||||
begin
|
||||
Writeln (Msg);
|
||||
RunError(255);
|
||||
end;
|
||||
|
||||
procedure TList.Exchange(Index1, Index2: Integer);
|
||||
|
||||
var Temp1,Temp2 : Pointer;
|
||||
var Temp : Pointer;
|
||||
|
||||
begin
|
||||
Temp:=FList[Index1];
|
||||
Items[Index1]:=Items[Index2];
|
||||
Items[Index2]:=Temp;
|
||||
If ((Index1>FCount) or (Index2>FCount)) or
|
||||
((Index1<0) or (Index2<0)) then
|
||||
RunError(255);
|
||||
Temp:=FList^[Index1];
|
||||
FList^[Index1]:=FList^[Index2];
|
||||
FList^[Index2]:=Temp;
|
||||
end;
|
||||
|
||||
|
||||
|
||||
function TList.Expand: TList;
|
||||
|
||||
Var IncSize : Longint;
|
||||
|
||||
begin
|
||||
If Count=FCapacity then Grow;
|
||||
if FCount<FCapacity then exit;
|
||||
IncSize:=4;
|
||||
if FCapacity>3 then IncSize:=IncSize+4;
|
||||
if FCapacity>8 then IncSize:=IncSize+8;
|
||||
SetCapacity(FCapacity+IncSize);
|
||||
Result:=Self;
|
||||
end;
|
||||
|
||||
|
||||
function TList.First: Pointer;
|
||||
|
||||
Var I : longint;
|
||||
|
||||
begin
|
||||
I:=0;
|
||||
Result:=Nil;
|
||||
While (I<Count-1) and (FList[I]=Nil) do Inc(i);
|
||||
Result:=FList[I];
|
||||
// Wouldn't it be better to return Nil if count is zero ?
|
||||
Result:=Items[0];
|
||||
end;
|
||||
|
||||
|
||||
|
||||
function TList.IndexOf(Item: Pointer): Integer;
|
||||
|
||||
Var I : longint;
|
||||
|
||||
begin
|
||||
I:=0;
|
||||
Result:=-1;
|
||||
if Count=0 then exit;
|
||||
While (I<Count) and (Flist[I]<>Item) do Inc(I);
|
||||
If Flist[I]=Item then Result:=I;
|
||||
Result:=0;
|
||||
While (Result<FCount) and (Flist^[Result]<>Item) do Result:=Result+1;
|
||||
If Result=FCount then Result:=-1;
|
||||
end;
|
||||
|
||||
|
||||
@ -167,12 +205,13 @@ end;
|
||||
procedure TList.Insert(Index: Integer; Item: Pointer);
|
||||
|
||||
begin
|
||||
If (Index<0) then
|
||||
If (Index<0) or (Index>FCount )then
|
||||
RunError(255);
|
||||
While Index+1>Capacity do Grow;
|
||||
If Index<Count then
|
||||
Move (Flist[Index],Flist[Index+1],(Count-Index)*SizeOf(Pointer));
|
||||
Item[Index]:=Item;
|
||||
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;
|
||||
|
||||
|
||||
@ -182,45 +221,116 @@ function TList.Last: Pointer;
|
||||
Var I : longint;
|
||||
|
||||
begin
|
||||
I:=Count-1;
|
||||
Result:=Nil;
|
||||
While (I>-1) and (FList[I]=Nil) dec Inc(i);
|
||||
if I>-1 then Result:=FList[I];
|
||||
// Wouldn't it be better to return nil if the count is zero ?
|
||||
Result:=Items[FCount-1];
|
||||
end;
|
||||
|
||||
|
||||
procedure TList.Move(CurIndex, NewIndex: Integer);
|
||||
|
||||
Var Temp : Pointer;
|
||||
|
||||
begin
|
||||
If ((CurIndex<0) or (CurIndex>Count-1)) or (NewINdex<0) then
|
||||
RunError(255);
|
||||
Temp:=FList^[CurIndex];
|
||||
Self.Delete(CurIndex);
|
||||
// ?? If NewIndex>CurIndex then NewIndex:=NewIndex-1;
|
||||
// Newindex changes when deleting ??
|
||||
Self.Insert (NewIndex,Temp);
|
||||
end;
|
||||
|
||||
|
||||
function TList.Remove(Item: Pointer): Integer;
|
||||
|
||||
begin
|
||||
If (Index<0) or (Index>Count-1) then
|
||||
RunError(255);
|
||||
While Index+1>Capacity do Grow;
|
||||
System.Move (Flist[Index],Flist[Index+1],(Count-Index)*SizeOf(Pointer));
|
||||
Item[Index]:=Item;
|
||||
Result:=IndexOf(Item);
|
||||
If Result<>-1 then
|
||||
Self.Delete (Result);
|
||||
end;
|
||||
|
||||
|
||||
|
||||
procedure TList.Pack;
|
||||
Procedure TList.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;
|
||||
|
||||
// Needed by Sort method.
|
||||
|
||||
Procedure QuickSort (Flist : PPointerList; L,R : Longint;
|
||||
Compare : TListSortCompare);
|
||||
|
||||
Var I,J : Longint;
|
||||
P,Q : Pointer;
|
||||
|
||||
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;
|
||||
end;
|
||||
|
||||
|
||||
|
||||
procedure TList.Sort(Compare: TListSortCompare);
|
||||
|
||||
begin
|
||||
If Not Assigned(FList) or (FCount<2) then exit;
|
||||
QuickSort (Flist, 0, FCount-1,Compare);
|
||||
end;
|
||||
|
||||
|
||||
{****************************************************************************}
|
||||
{* TThreadList *}
|
||||
{****************************************************************************}
|
||||
@ -272,9 +382,14 @@ procedure TThreadList.UnlockList;
|
||||
|
||||
begin
|
||||
end;
|
||||
|
||||
|
||||
{
|
||||
$Log$
|
||||
Revision 1.2 1998-05-04 15:54:07 michael
|
||||
Revision 1.3 1998-05-05 15:54:31 michael
|
||||
TList completely implemented
|
||||
|
||||
Revision 1.2 1998/05/04 15:54:07 michael
|
||||
+ Partial implementation of TList
|
||||
|
||||
Revision 1.1 1998/05/04 14:30:12 michael
|
||||
|
||||
Loading…
Reference in New Issue
Block a user