TList completely implemented

fcl/inc/lists.inc

@@ -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 
+  if (Index<0) or (Index>=FCount) then 
-    Runerror(255)
+    Runerror(255);
-  While Index>Capacity do Grow;
+  Flist^[Index]:=Item;
-  Flist[I^ndex]:=Item;
-  If Index>Count then Count:=Index; 
 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;
+    If NewCount>FCapacity then 
-    FillByte (Flist[count],(Newcount-Count)*SizeOF(Pointer),0);
+      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;
+    FCapacity:=0;
-    FCount:=Nil;    
+    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];
+  If ((Index1>FCount) or (Index2>FCount)) or
-  Items[Index1]:=Items[Index2];
+     ((Index1<0) or (Index2<0)) then
-  Items[Index2]:=Temp;
+    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;
+  // Wouldn't it be better to return Nil if count is zero ?
-  Result:=Nil;
+  Result:=Items[0];
-  While (I<Count-1) and (FList[I]=Nil) do Inc(i);
-  Result:=FList[I];
 end;
 
 
 
 function TList.IndexOf(Item: Pointer): Integer;
 
-Var I : longint;
-
 begin
-  I:=0;
+  Result:=0;
-  Result:=-1;
+  While (Result<FCount) and (Flist^[Result]<>Item) do Result:=Result+1;
-  if Count=0 then exit;
+  If Result=FCount  then Result:=-1;
-  While (I<Count) and (Flist[I]<>Item) do Inc(I);
-  If Flist[I]=Item then Result:=I;
 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 FCount=FCapacity Then Self.Expand;
-  If Index<Count then 
+  If Index<FCount then 
-    Move (Flist[Index],Flist[Index+1],(Count-Index)*SizeOf(Pointer));
+    System.Move (Flist^[Index],Flist^[Index+1],(FCount-Index)*SizeOf(Pointer));
-  Item[Index]:=Item;
+  FList^[Index]:=Item;
+  FCount:=FCount+1;
 end;
 
 
@@ -182,45 +221,116 @@ function TList.Last: Pointer;
 Var I : longint;
 
 begin
-  I:=Count-1;
+  // Wouldn't it be better to return nil if the count is zero ? 
-  Result:=Nil;
+  Result:=Items[FCount-1];
-  While (I>-1) and (FList[I]=Nil) dec Inc(i);
-  if I>-1 then Result:=FList[I];
 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
+  Result:=IndexOf(Item);
-    RunError(255);
+  If Result<>-1 then
-  While Index+1>Capacity do Grow;
+    Self.Delete (Result);
-  System.Move (Flist[Index],Flist[Index+1],(Count-Index)*SizeOf(Pointer));
-  Item[Index]:=Item;
 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