Hallo,
ich habe zu testzwecken eine doppelt verkettete liste erstellt.
Diese Klasse hat einen nachfahren, <MTFList2>, bei dem aufgerufene elemente am Anfang eingefügt werden, um so den zugriff auf die letzten elemente zu beschleunigen.
Nun habe ich das Problem, dass für die MTFList2 beim aufruf des n.elements (function GetItem) ein speicherloch von 12 byte per item entsteht (da ich einen neuen pointer auf das element erstelle, dann das element an den anfang verschiebe, dann aber nicht mehr "dispose"n kann). Den restlichen code der klassen habe ich soweit auf speicherlöcher getestet. Dies ist bisher der einzige Fall, wo solche auftreten.
Welche andere Möglichkeit gibt es hier, das zu vermeiden.
Delphi-Quellcode:
Procedure Tlistfield.Setprevious(Item: Plistfield);
Begin
If Fprev <> Item
Then
Begin
Fprev := Item;
If Item <>
Nil Then
Begin
If Item^.Fnext =
Nil Then
Begin
New(Item^.Fnext);
Item^.Fnext^ := Self;
End
Else
If Item^.Fnext^ <> Self
Then
Begin
Dispose(Item^.Fnext);
New(Item^.Fnext);
Item^.Fnext^ := Self;
End;
End;
End;
End;
Destructor Tlinklist2.Destroy;
Begin
Clear;
Act^.Free;
Dispose(Act);
Fst :=
Nil;
Lst :=
Nil;
Act :=
Nil;
Tmp :=
Nil;
Assert(
Not(Assigned(Fst)));
Assert(
Not(Assigned(Lst)));
Assert(
Not(Assigned(Act)));
Assert(
Not(Assigned(Tmp)));
Inherited;
End;
Procedure Tlinklist2.Add(
Const Item: Plistfield);
// am Ende anfügen. Das Ende ist durch einen separaten Pointer auf das zuletzt angehängte element //gekennzeichnet. Am anfang besteht die liste nur durch ein leeres sentinel-element.
Begin
New(Lst^.Fnext);
Lst^.Next^ := Item^;
Item^.Setprevious(Lst);
Lst := Item;
Inc(Fcount)
End;
Procedure Tlinklist2.Clear;
Begin
Act := Lst;
While (Act <>
Nil)
And (Act <> Fst)
Do
Begin
Deletelast;
Act := Lst;
End;
Fcount := 0;
Assert(Fst = Lst)
End;
Procedure Tlinklist2.Deletelast;
Var
Tmp: Ptr;
Begin
If Fcount > 0
Then
Begin
Tmp := Lst^.FPrev;
Tmp^.Fnext^.Free;
Dispose(Tmp^.Fnext);
Tmp^.Fnext :=
Nil;
Dispose(Lst);
Lst := Tmp;
Dec(Fcount);
End
Else
Begin
Fst^.Free;
Dispose(Fst);
Fst :=
Nil;
Act := Fst;
Fcount := 0;
End;
End;
//Property Items[Const Index: Cardinal]: Plistfield Read Getitem; Default;
Function Tlinklist2.Getitem(
Const Index: Cardinal): Plistfield;
Var
I: Cardinal;
Act: Ptr;
Begin
If (
Index >= Fcount)
{ Or (Index < 0) } Then
Raise ERangeError.Create('
Index out of Range')
Else
Begin
I := 1;
Act := Fst^.Next;
While (I <=
Index)
Do
Begin
Act := Act^.Fnext;
Inc(I);
End;
Result := Act;
End;
End;
Function Tmtflist2.Getitem(
Const Index: Cardinal): Plistfield;
Var
Islast: Boolean;
Item: Ptr;
Var
I: Cardinal;
Act, Tmp: Ptr;
Begin
New(Result);
Result^ :=
Inherited^;
// rufe element auf
Mtf(Result);
// und setze an den anfang
End;
Procedure Tmtflist2.MTF(Item: Plistfield);
Var
Islast: Boolean;
Begin
Islast := Item^.Fnext =
Nil;
Try
Tmp := Item;
If Not Islast
Then
Begin
Dispose(Item^.Fnext^.FPrev);
Item^.Fnext^.FPrev := Item^.FPrev;
End
Else // islast
Begin
Lst := Item^.FPrev;
Dispose(Lst^.Fnext);
End;
If Item^.Fprev <>
Nil Then
Item^.FPrev^.Fnext := Item^.Fnext;
Finally
Item^.FPrev :=
Nil;
Item^.Fnext :=
Nil;
End;
If Fst^.Fnext <>
Nil Then
// Dispose(Target^.Fnext^.FPrev);
Fst^.Fnext^.Setprevious(Item);
// Dispose(Target^.Fnext);
Item^.Setprevious(Fst);
End;