1 {
2  *****************************************************************************
3   This file is part of LazUtils.
4 
5   See the file COPYING.modifiedLGPL.txt, included in this distribution,
6   for details about the license.
7  *****************************************************************************
8 
9   Authors: Mattias Gaertner, Jeroen van Iddekinge
10 
11   Abstract:
12     Defines the simple double connected queue TLinkList.
13     It supports Adding, Deleting, getting First and getting Last in O(1).
14     Finding can be done in time O(n).
15 }
16 unit LazLinkedList;
17 
18 {$mode objfpc}{$H+}
19 
20 interface
21 
22 uses
23   Classes, SysUtils;
24 
25 type
26   TLinkListItem = class
27     Next  : TLinkListItem;
28     Prior : TLinkListItem;
29     procedure ResetItem; virtual;
30   end;
31 
32   TLinkList = class
33   private
34     FFirstFree: TLinkListItem;
35     FFreeCount: integer;
36     FFirst: TLinkListItem;
37     FLast: TLinkListItem;
38     FCount: integer;
39     procedure DisposeItem(AnItem: TLinkListItem);
40     procedure Unbind(AnItem: TLinkListItem);
41   protected
CreateItemnull42     function CreateItem: TLinkListItem; virtual; abstract;
GetNewItemnull43     function GetNewItem: TLinkListItem;
44     procedure AddAsLast(AnItem: TLinkListItem);
45   public
46     property First: TLinkListItem read FFirst;
47     property Last: TLinkListItem read FLast;
48     property Count: integer read FCount;
49     procedure Delete(AnItem: TLinkListItem);
50     procedure MoveToLast(AnItem: TLinkListItem);
51     procedure Clear;
ConsistencyChecknull52     function ConsistencyCheck: integer;
53     constructor Create;
54     destructor Destroy; override;
55   end;
56 
57 implementation
58 
59 { TLinkList }
60 
61 procedure TLinkListItem.ResetItem;
62 begin
63   Next := nil;
64   Prior := nil;
65 end;
66 
67 constructor TLinkList.Create;
68 begin
69   inherited Create;
70 end;
71 
72 destructor TLinkList.Destroy;
73 var AnItem: TLinkListItem;
74 begin
75   Clear;
76   // clear the free list
77   while FFirstFree<>nil do begin
78     AnItem:=FFirstFree;
79     FFirstFree:=AnItem.Next;
80     AnItem.Destroy;
81   end;
82   inherited Destroy;
83 end;
84 
85 procedure TLinkList.Delete(AnItem: TLinkListItem);
86 begin
87   if AnItem=nil then exit;
88   Unbind(AnItem);
89   AnItem.Destroy;
90 end;
91 
92 procedure TLinkList.MoveToLast(AnItem: TLinkListItem);
93 begin
94   if AnItem=nil then exit;
95   Unbind(AnItem);
96   AddAsLast(AnItem);
97 end;
98 
99 procedure TLinkList.Clear;
100 begin
101   while First<>nil do Delete(First);
102 end;
103 
TLinkList.GetNewItemnull104 function TLinkList.GetNewItem: TLinkListItem;
105 begin
106   if FFirstFree<>nil then begin
107     Result:=FFirstFree;
108     FFirstFree:=FFirstFree.Next;
109     if FFirstFree<>nil then
110       FFirstFree.Prior:=nil;
111     dec(FFreeCount);
112   end else begin
113     Result := CreateItem;
114   end;
115   Result.Next:=nil;
116   Result.Prior:=nil;
117 end;
118 
119 procedure TLinkList.DisposeItem(AnItem: TLinkListItem);
120 var i: integer;
121 begin
122   if FFreeCount<=2*FCount then begin
123     AnItem.ResetItem;
124     AnItem.Next:=FFirstFree;
125     FFirstFree:=AnItem;
126     if AnItem.Next<>nil then AnItem.Next.Prior:=AnItem;
127     inc(FFreeCount);
128   end else begin
129     AnItem.Destroy;
130     if (FCount+5)<2*FFreeCount then begin
131       for i:=1 to 2 do begin
132         if FFirstFree<>nil then begin
133           AnItem:=FFirstFree;
134           FFirstFree:=FFirstFree.Next;
135           if FFirstFree<>nil then
136             FFirstFree.Prior:=nil;
137 	  AnItem.Destroy;
138           dec(FFreeCount);
139         end;
140       end;
141     end;
142   end;
143 end;
144 
145 procedure TLinkList.Unbind(AnItem: TLinkListItem);
146 begin
147   if AnItem=nil then exit;
148   if FFirst=AnItem then FFirst:=FFirst.Next;
149   if FLast=AnItem then FLast:=FLast.Prior;
150   if AnItem.Prior<>nil then AnItem.Prior.Next:=AnItem.Next;
151   if AnItem.Next<>nil then AnItem.Next.Prior:=AnItem.Prior;
152   AnItem.Prior:=nil;
153   AnItem.Next:=nil;
154   dec(FCount);
155 end;
156 
157 procedure TLinkList.AddAsLast(AnItem: TLinkListItem);
158 begin
159   AnItem.Prior:=FLast;
160   AnItem.Next:=nil;
161   FLast:=AnItem;
162   if AnItem.Prior<>nil then
163     AnItem.Prior.Next:=AnItem
164   else
165     FFirst:=AnItem;
166   inc(FCount);
167 end;
168 
TLinkList.ConsistencyChecknull169 function TLinkList.ConsistencyCheck: integer;
170 var RealCount: integer;
171   AnItem: TLinkListItem;
172 begin
173   // test free list
174   RealCount:=0;
175   AnItem:=FFirstFree;
176   while AnItem<>nil do begin
177     inc(RealCount);
178     AnItem:=AnItem.Next;
179   end;
180   if FFreeCount<>RealCount then begin
181     Result:=-1;  exit;
182   end;
183   // test items
184   RealCount:=0;
185   AnItem:=FFirst;
186   while AnItem<>nil do begin
187     if (AnItem.Next<>nil) and (AnItem.Next.Prior<>AnItem) then begin
188       Result:=-2;  exit;
189     end;
190     if (AnItem.Prior<>nil) and (AnItem.Prior.Next<>AnItem) then begin
191       Result:=-3;  exit;
192     end;
193     inc(RealCount);
194     AnItem:=AnItem.Next;
195   end;
196   if FCount<>RealCount then begin
197     Result:=-4;  exit;
198   end;
199   Result:=0;
200 end;
201 
202 end.
203 
204