diff --git a/fcl/inc/lists.inc b/fcl/inc/lists.inc index 16354bf4dc..a215cd4a95 100644 --- a/fcl/inc/lists.inc +++ b/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 - 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 NewCapacityMaxListSize)then RunError(255); - If NewCountFCount then begin - While NewCount>Capacity do Grow; - FillByte (Flist[count],(Newcount-Count)*SizeOF(Pointer),0); + If NewCount>FCapacity then + SetCapacity (NewCount); + If FCount=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 FCount3 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 (IItem) do Inc(I); - If Flist[I]=Item then Result:=I; + Result:=0; + While (ResultItem) 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-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 runnerNil) and (RunnerNil) and (J0 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=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