paweld/lazarus
1
0
Fork 0
mirror of https://gitlab.com/freepascal.org/lazarus/lazarus.git synced 2025-08-04 23:15:59 +02:00
Code Issues Packages Projects Releases Wiki Activity

lcl: formatting

Browse Source 
git-svn-id: trunk@24707 -
This commit is contained in:
paul 2010-04-19 01:56:33 +00:00
parent 3def3ea76c
commit a06ad84100
1 changed files with 125 additions and 128 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

253
lcl/lclrescache.pas
View File

@ -135,8 +135,7 @@ type
public public
constructor Create(TheDataSize: integer); constructor Create(TheDataSize: integer);
function FindDescriptor(DescPtr: Pointer): TBlockResourceCacheDescriptor; function FindDescriptor(DescPtr: Pointer): TBlockResourceCacheDescriptor;
function AddResource(Handle: TLCLHandle; DescPtr: Pointer function AddResource(Handle: TLCLHandle; DescPtr: Pointer): TBlockResourceCacheDescriptor;
): TBlockResourceCacheDescriptor;
function CompareDescriptors(Tree: TAvgLvlTree; function CompareDescriptors(Tree: TAvgLvlTree;
Desc1, Desc2: Pointer): integer; override; Desc1, Desc2: Pointer): integer; override;
public public
@ -169,21 +168,20 @@ end;
{ TResourceCacheItem } { TResourceCacheItem }
constructor TResourceCacheItem.Create(TheCache: TResourceCache; constructor TResourceCacheItem.Create(TheCache: TResourceCache; TheHandle: TLCLHandle);
TheHandle: TLCLHandle);
begin begin
Cache:=TheCache; Cache := TheCache;
Handle:=TheHandle; Handle := TheHandle;
end; end;
destructor TResourceCacheItem.Destroy; destructor TResourceCacheItem.Destroy;
begin begin
if FDestroying then if FDestroying then
RaiseGDBException(''); RaiseGDBException('');
FDestroying:=true; FDestroying := True;
Cache.RemoveItem(Self); Cache.RemoveItem(Self);
//debugln('TResourceCacheItem.Destroy B ',dbgs(Self)); //debugln('TResourceCacheItem.Destroy B ',dbgs(Self));
Handle:=0; Handle := 0;
inherited Destroy; inherited Destroy;
//debugln('TResourceCacheItem.Destroy END ',dbgs(Self)); //debugln('TResourceCacheItem.Destroy END ',dbgs(Self));
end; end;
@ -191,9 +189,9 @@ end;
procedure TResourceCacheItem.IncreaseRefCount; procedure TResourceCacheItem.IncreaseRefCount;
begin begin
inc(FReferenceCount); inc(FReferenceCount);
if FReferenceCount=1 then if FReferenceCount = 1 then
Cache.ItemUsed(Self); Cache.ItemUsed(Self);
if (FReferenceCount=1000) or (FReferenceCount=10000) then if (FReferenceCount = 1000) or (FReferenceCount = 10000) then
WarnReferenceHigh; WarnReferenceHigh;
end; end;
@ -206,33 +204,32 @@ procedure TResourceCacheItem.DecreaseRefCount;
begin begin
//debugln('TResourceCacheItem.DecreaseRefCount ',ClassName,' ',dbgs(Self),' ',dbgs(FReferenceCount)); //debugln('TResourceCacheItem.DecreaseRefCount ',ClassName,' ',dbgs(Self),' ',dbgs(FReferenceCount));
if FReferenceCount=0 then if FReferenceCount = 0 then
RaiseRefCountZero; RaiseRefCountZero;
dec(FReferenceCount); dec(FReferenceCount);
if FReferenceCount=0 then if FReferenceCount =0 then
Cache.ItemUnused(Self); Cache.ItemUnused(Self);
//debugln('TResourceCacheItem.DecreaseRefCount END '); //debugln('TResourceCacheItem.DecreaseRefCount END ');
end; end;
procedure TResourceCacheItem.AddToList(var First, Last: TResourceCacheItem procedure TResourceCacheItem.AddToList(var First, Last: TResourceCacheItem);
);
// add as last // add as last
begin begin
Next:=nil; Next := nil;
Prev:=Last; Prev := Last;
Last:=Self; Last := Self;
if First=nil then First:=Self; if First = nil then First := Self;
if Prev<>nil then Prev.Next:=Self; if Prev <> nil then Prev.Next := Self;
end; end;
procedure TResourceCacheItem.RemoveFromList(var First,Last: TResourceCacheItem); procedure TResourceCacheItem.RemoveFromList(var First,Last: TResourceCacheItem);
begin begin
if First=Self then First:=Next; if First = Self then First := Next;
if Last=Self then Last:=Prev; if Last = Self then Last := Prev;
if Next<>nil then Next.Prev:=Prev; if Next <> nil then Next.Prev := Prev;
if Prev<>nil then Prev.Next:=Next; if Prev <> nil then Prev.Next := Next;
Next:=nil; Next := nil;
Prev:=nil; Prev := nil;
end; end;
procedure TResourceCacheItem.WarnReferenceHigh; procedure TResourceCacheItem.WarnReferenceHigh;
@ -247,49 +244,49 @@ end;
constructor TResourceCacheDescriptor.Create(TheCache: TResourceCache; constructor TResourceCacheDescriptor.Create(TheCache: TResourceCache;
TheItem: TResourceCacheItem); TheItem: TResourceCacheItem);
begin begin
Cache:=TheCache; Cache := TheCache;
Item:=TheItem; Item := TheItem;
Item.IncreaseRefCount; Item.IncreaseRefCount;
AddToList(Item.FirstDescriptor,Item.LastDescriptor); AddToList(Item.FirstDescriptor, Item.LastDescriptor);
end; end;
destructor TResourceCacheDescriptor.Destroy; destructor TResourceCacheDescriptor.Destroy;
begin begin
if FDestroying then if FDestroying then
RaiseGDBException(''); RaiseGDBException('');
FDestroying:=true; FDestroying := True;
Cache.RemoveDescriptor(Self); Cache.RemoveDescriptor(Self);
inherited Destroy; inherited Destroy;
end; end;
procedure TResourceCacheDescriptor.AddToList( procedure TResourceCacheDescriptor.AddToList(var First, Last: TResourceCacheDescriptor);
var First, Last: TResourceCacheDescriptor);
// add as last // add as last
begin begin
Next:=nil; Next := nil;
Prev:=Last; Prev := Last;
Last:=Self; Last := Self;
if First=nil then First:=Self; if First = nil then First := Self;
if Prev<>nil then Prev.Next:=Self; if Prev <> nil then Prev.Next := Self;
end; end;
procedure TResourceCacheDescriptor.RemoveFromList( procedure TResourceCacheDescriptor.RemoveFromList(var First, Last: TResourceCacheDescriptor);
var First, Last: TResourceCacheDescriptor);
begin begin
if First=Self then First:=Next; if First = Self then First := Next;
if Last=Self then Last:=Prev; if Last = Self then Last := Prev;
if Next<>nil then Next.Prev:=Prev; if Next <> nil then Next.Prev := Prev;
if Prev<>nil then Prev.Next:=Next; if Prev <> nil then Prev.Next := Next;
Next:=nil; Next := nil;
Prev:=nil; Prev := nil;
end; end;
{ TResourceCache } { TResourceCache }
procedure TResourceCache.RemoveItem(Item: TResourceCacheItem); procedure TResourceCache.RemoveItem(Item: TResourceCacheItem);
begin begin
if not FDestroying then begin if not FDestroying then
while Item.FirstDescriptor<>nil do begin begin
while Item.FirstDescriptor <> nil do
begin
if Item.FirstDescriptor.FDestroying then if Item.FirstDescriptor.FDestroying then
RaiseGDBException('TResourceCache.RemoveItem'); RaiseGDBException('TResourceCache.RemoveItem');
Item.FirstDescriptor.Free; Item.FirstDescriptor.Free;
@ -302,13 +299,13 @@ procedure TResourceCache.RemoveDescriptor(Desc: TResourceCacheDescriptor);
var var
Item: TResourceCacheItem; Item: TResourceCacheItem;
begin begin
if not FDestroying then begin if not FDestroying then
Item:=Desc.Item; begin
if Item<>nil then Item := Desc.Item;
Desc.RemoveFromList(Item.FirstDescriptor,Item.LastDescriptor); if Item <> nil then
Desc.RemoveFromList(Item.FirstDescriptor, Item.LastDescriptor);
FDescriptors.Remove(Desc); FDescriptors.Remove(Desc);
if (Item<>nil) and (Item.FirstDescriptor=nil) and (not Item.FDestroying) if (Item <> nil) and (Item.FirstDescriptor = nil) and (not Item.FDestroying) then
then
Item.Free; Item.Free;
end; end;
end; end;
@ -316,9 +313,10 @@ end;
procedure TResourceCache.ItemUsed(Item: TResourceCacheItem); procedure TResourceCache.ItemUsed(Item: TResourceCacheItem);
// called after creation or when Item is used again // called after creation or when Item is used again
begin begin
if not ItemIsUsed(Item) then begin if not ItemIsUsed(Item) then
begin
// remove from unused list // remove from unused list
Item.RemoveFromList(FFirstUnusedItem,FLastUnusedItem); Item.RemoveFromList(FFirstUnusedItem, FLastUnusedItem);
dec(FUnUsedItemCount); dec(FUnUsedItemCount);
end; end;
end; end;
@ -335,13 +333,14 @@ begin
if not ItemIsUsed(Item) then if not ItemIsUsed(Item) then
raise Exception.Create('TResourceCache.ItemUnused'); raise Exception.Create('TResourceCache.ItemUnused');
//debugln('TResourceCache.ItemUnused B ',ClassName,' ',dbgs(Self)); //debugln('TResourceCache.ItemUnused B ',ClassName,' ',dbgs(Self));
Item.AddToList(FFirstUnusedItem,FLastUnusedItem); Item.AddToList(FFirstUnusedItem, FLastUnusedItem);
inc(FUnUsedItemCount); inc(FUnUsedItemCount);
//debugln('TResourceCache.ItemUnused C ',ClassName,' ',dbgs(Self)); //debugln('TResourceCache.ItemUnused C ',ClassName,' ',dbgs(Self));
if FUnUsedItemCount>FMaxUnusedItem then begin if FUnUsedItemCount > FMaxUnusedItem then
begin
// maximum unused resources reached -> free the oldest // maximum unused resources reached -> free the oldest
DeleteItem:=FFirstUnusedItem; DeleteItem := FFirstUnusedItem;
DeleteItem.RemoveFromList(FFirstUnusedItem,FLastUnusedItem); DeleteItem.RemoveFromList(FFirstUnusedItem, FLastUnusedItem);
DeleteItem.Free; DeleteItem.Free;
end; end;
//debugln('TResourceCache.ItemUnused END ',ClassName,' ',dbgs(Self)); //debugln('TResourceCache.ItemUnused END ',ClassName,' ',dbgs(Self));
@ -349,23 +348,22 @@ end;
function TResourceCache.ItemIsUsed(Item: TResourceCacheItem): boolean; function TResourceCache.ItemIsUsed(Item: TResourceCacheItem): boolean;
begin begin
Result:=(FFirstUnusedItem<>Item) and (Item.Next=nil) Result := (FFirstUnusedItem <> Item) and (Item.Next = nil) and (Item.Prev = nil)
and (Item.Prev=nil)
end; end;
constructor TResourceCache.Create; constructor TResourceCache.Create;
begin begin
FMaxUnusedItem:=100; FMaxUnusedItem := 100;
FItems:=TAvgLvlTree.CreateObjectCompare(@CompareItems); FItems := TAvgLvlTree.CreateObjectCompare(@CompareItems);
FDescriptors:=TAvgLvlTree.CreateObjectCompare(@CompareDescriptors); FDescriptors := TAvgLvlTree.CreateObjectCompare(@CompareDescriptors);
FResourceCacheItemClass:=TResourceCacheItem; FResourceCacheItemClass := TResourceCacheItem;
FResourceCacheDescriptorClass:=TResourceCacheDescriptor; FResourceCacheDescriptorClass := TResourceCacheDescriptor;
end; end;
procedure TResourceCache.Clear; procedure TResourceCache.Clear;
begin begin
while FFirstUnusedItem<>nil do while FFirstUnusedItem <> nil do
FFirstUnusedItem.RemoveFromList(FFirstUnusedItem,FLastUnusedItem); FFirstUnusedItem.RemoveFromList(FFirstUnusedItem, FLastUnusedItem);
FItems.FreeAndClear; FItems.FreeAndClear;
FDescriptors.FreeAndClear; FDescriptors.FreeAndClear;
end; end;
@ -381,11 +379,10 @@ begin
inherited Destroy; inherited Destroy;
end; end;
function TResourceCache.CompareItems(Tree: TAvgLvlTree; Item1, Item2: Pointer function TResourceCache.CompareItems(Tree: TAvgLvlTree; Item1, Item2: Pointer): integer;
): integer;
begin begin
Result:=CompareLCLHandles(TResourceCacheItem(Item1).Handle, Result := CompareLCLHandles(TResourceCacheItem(Item1).Handle,
TResourceCacheItem(Item2).Handle); TResourceCacheItem(Item2).Handle);
end; end;
procedure TResourceCache.ConsistencyCheck; procedure TResourceCache.ConsistencyCheck;
@ -399,49 +396,52 @@ begin
RaiseGDBException(''); RaiseGDBException('');
// check items // check items
if FItems.ConsistencyCheck<>0 then if FItems.ConsistencyCheck <> 0 then
RaiseGDBException(''); RaiseGDBException('');
ANode:=FItems.FindLowest; ANode := FItems.FindLowest;
while ANode<>nil do begin while ANode <> nil do
Item:=TResourceCacheItem(ANode.Data); begin
if Item.FirstDescriptor=nil then Item := TResourceCacheItem(ANode.Data);
if Item.FirstDescriptor = nil then
RaiseGDBException(''); RaiseGDBException('');
if Item.LastDescriptor=nil then if Item.LastDescriptor = nil then
RaiseGDBException(''); RaiseGDBException('');
if Item.FirstDescriptor.Prev<>nil then if Item.FirstDescriptor.Prev <> nil then
RaiseGDBException(''); RaiseGDBException('');
if Item.LastDescriptor.Next<>nil then if Item.LastDescriptor.Next <> nil then
RaiseGDBException(''); RaiseGDBException('');
Desc:=Item.FirstDescriptor; Desc := Item.FirstDescriptor;
while Desc<>nil do begin while Desc <> nil do
if Desc.Item<>Item then begin
if Desc.Item <> Item then
RaiseGDBException(''); RaiseGDBException('');
if (Desc.Next<>nil) and (Desc.Next.Prev<>Desc) then if (Desc.Next <> nil) and (Desc.Next.Prev <> Desc) then
RaiseGDBException(''); RaiseGDBException('');
if (Desc.Prev<>nil) and (Desc.Prev.Next<>Desc) then if (Desc.Prev <> nil) and (Desc.Prev.Next <> Desc) then
RaiseGDBException(''); RaiseGDBException('');
if (Desc.Next=nil) and (Item.LastDescriptor<>Desc) then if (Desc.Next = nil) and (Item.LastDescriptor <> Desc) then
RaiseGDBException(''); RaiseGDBException('');
Desc:=Desc.Next; Desc := Desc.Next;
end; end;
ANode:=FItems.FindSuccessor(ANode); ANode := FItems.FindSuccessor(ANode);
end; end;
// check Descriptors // check Descriptors
if FDescriptors.ConsistencyCheck<>0 then if FDescriptors.ConsistencyCheck <> 0 then
RaiseGDBException(''); RaiseGDBException('');
ANode:=FDescriptors.FindLowest; ANode := FDescriptors.FindLowest;
while ANode<>nil do begin while ANode <> nil do
Desc:=TResourceCacheDescriptor(ANode.Data); begin
Item:=Desc.Item; Desc := TResourceCacheDescriptor(ANode.Data);
if Item=nil then Item := Desc.Item;
if Item = nil then
RaiseGDBException(''); RaiseGDBException('');
Desc2:=Item.FirstDescriptor; Desc2 := Item.FirstDescriptor;
while (Desc2<>nil) and (Desc2<>Desc) do while (Desc2 <> nil) and (Desc2 <> Desc) do
Desc2:=Desc2.Next; Desc2 := Desc2.Next;
if Desc<>Desc2 then if Desc <> Desc2 then
RaiseGDBException(''); RaiseGDBException('');
ANode:=FItems.FindSuccessor(ANode); ANode := FItems.FindSuccessor(ANode);
end; end;
end; end;
@ -451,12 +451,12 @@ function THandleResourceCache.FindItem(Handle: TLCLHandle): TResourceCacheItem;
var var
ANode: TAvgLvlTreeNode; ANode: TAvgLvlTreeNode;
begin begin
ANode:=FItems.FindKey(@Handle, ANode := FItems.FindKey(@Handle,
TListSortCompare(@ComparePHandleWithResourceCacheItem)); TListSortCompare(@ComparePHandleWithResourceCacheItem));
if ANode<>nil then if ANode <> nil then
Result:=TResourceCacheItem(ANode.Data) Result := TResourceCacheItem(ANode.Data)
else else
Result:=nil; Result := nil;
end; end;
{ TBlockResourceCache } { TBlockResourceCache }
@ -464,26 +464,23 @@ end;
constructor TBlockResourceCache.Create(TheDataSize: integer); constructor TBlockResourceCache.Create(TheDataSize: integer);
begin begin
inherited Create; inherited Create;
FDataSize:=TheDataSize; FDataSize := TheDataSize;
FResourceCacheDescriptorClass:=TBlockResourceCacheDescriptor; FResourceCacheDescriptorClass := TBlockResourceCacheDescriptor;
FOnCompareDescPtrWithDescriptor:= FOnCompareDescPtrWithDescriptor := TListSortCompare(@CompareDescPtrWithBlockResDesc);
TListSortCompare(@CompareDescPtrWithBlockResDesc);
end; end;
function TBlockResourceCache.FindDescriptor(DescPtr: Pointer function TBlockResourceCache.FindDescriptor(DescPtr: Pointer): TBlockResourceCacheDescriptor;
): TBlockResourceCacheDescriptor;
var var
ANode: TAvgLvlTreeNode; ANode: TAvgLvlTreeNode;
begin begin
ANode:=FDescriptors.FindKey(DescPtr,FOnCompareDescPtrWithDescriptor); ANode := FDescriptors.FindKey(DescPtr,FOnCompareDescPtrWithDescriptor);
if ANode<>nil then if ANode <> nil then
Result:=TBlockResourceCacheDescriptor(ANode.Data) Result := TBlockResourceCacheDescriptor(ANode.Data)
else else
Result:=nil; Result := nil;
end; end;
function TBlockResourceCache.AddResource(Handle: TLCLHandle; DescPtr: Pointer function TBlockResourceCache.AddResource(Handle: TLCLHandle; DescPtr: Pointer): TBlockResourceCacheDescriptor;
): TBlockResourceCacheDescriptor;
var var
Item: TResourceCacheItem; Item: TResourceCacheItem;
@ -502,28 +499,28 @@ begin
{$IFDEF CheckResCacheConsistency} {$IFDEF CheckResCacheConsistency}
ConsistencyCheck; ConsistencyCheck;
{$ENDIF} {$ENDIF}
Result:=FindDescriptor(DescPtr); Result := FindDescriptor(DescPtr);
if Result<>nil then if Result <> nil then
RaiseDescriptorAlreadyAdded; RaiseDescriptorAlreadyAdded;
Item:=FindItem(Handle); Item := FindItem(Handle);
if Item=nil then begin if Item = nil then
Item:=FResourceCacheItemClass.Create(Self,Handle); begin
Item := FResourceCacheItemClass.Create(Self, Handle);
FItems.Add(Item); FItems.Add(Item);
end; end;
Result:=TBlockResourceCacheDescriptor( Result := TBlockResourceCacheDescriptor(FResourceCacheDescriptorClass.Create(Self, Item));
FResourceCacheDescriptorClass.Create(Self,Item)); ReAllocMem(Result.Data, DataSize);
ReAllocMem(Result.Data,DataSize); System.Move(DescPtr^, Result.Data^, DataSize);
System.Move(DescPtr^,Result.Data^,DataSize);
FDescriptors.Add(Result); FDescriptors.Add(Result);
end; end;
function TBlockResourceCache.CompareDescriptors(Tree: TAvgLvlTree; Desc1, function TBlockResourceCache.CompareDescriptors(Tree: TAvgLvlTree; Desc1,
Desc2: Pointer): integer; Desc2: Pointer): integer;
begin begin
Result:=CompareMemRange(TBlockResourceCacheDescriptor(Desc1).Data, Result := CompareMemRange(TBlockResourceCacheDescriptor(Desc1).Data,
TBlockResourceCacheDescriptor(Desc2).Data, TBlockResourceCacheDescriptor(Desc2).Data,
DataSize); DataSize);
end; end;
{ TBlockResourceCacheDescriptor } { TBlockResourceCacheDescriptor }
@ -531,7 +528,7 @@ end;
destructor TBlockResourceCacheDescriptor.Destroy; destructor TBlockResourceCacheDescriptor.Destroy;
begin begin
inherited Destroy; inherited Destroy;
ReAllocMem(Data,0); ReAllocMem(Data, 0);
end; end;
end. end.