ну, если после инициализации выполнить Kernel.Collect, например через коммандер в логе - память очистится или нет? у меня на двусвязном не чистится, а на односвязном чистится.
Это двусвязный:
Код:
TYPE
IteratorItem* = POINTER TO ABSTRACT RECORD
root: Iterator;
prev-, next-: IteratorItem
END;
Iterator* = POINTER TO LIMITED RECORD(IteratorItem)
first-, last-, this-: IteratorItem;
length-: INTEGER
END;
(** Итератор **)
PROCEDURE (i: Iterator) Next* (), NEW;
BEGIN
ASSERT(i.this # NIL, 20);
i.this := i.this.next
END Next;
PROCEDURE (i: Iterator) Prev* (), NEW;
BEGIN
ASSERT(i.this # NIL);
i.this := i.this.prev
END Prev;
PROCEDURE (i: Iterator) First* (), NEW;
BEGIN
i.this := i.first
END First;
PROCEDURE (i: Iterator) Last* (), NEW;
BEGIN
i.this := i.last
END Last;
PROCEDURE (i: Iterator) Add* (item: IteratorItem), NEW;
BEGIN
ASSERT(item # NIL, 20);
item.root := i;
IF (i.last # NIL) & (i.first # NIL) THEN
i.last.next := item;
item.prev := i.last;
item.next := NIL;
i.last := item
ELSE
i.first := item;
i.last := item;
item.next := NIL;
item.prev := NIL
END;
INC(i.length)
END Add;
PROCEDURE (i: Iterator) Remove* (item: IteratorItem), NEW;
BEGIN
ASSERT(item # NIL, 20);
ASSERT(item.root = i, 21);
IF item = i.this THEN i.this := NIL END;
IF item = i.first THEN
i.first := item.next;
IF item.next # NIL THEN item.next.prev := NIL END
ELSIF item = i.last THEN
i.last := item.prev;
IF item.prev # NIL THEN item.prev.next := NIL END
ELSE
item.next.prev := item.prev;
item.prev.next := item.next
END;
item.next := NIL; item.prev := NIL; item.root := NIL;
DEC(i.length)
END Remove;
PROCEDURE (i: Iterator) Insert* (this, before: IteratorItem), NEW;
BEGIN
ASSERT(this # NIL, 20);
IF before = NIL THEN
IF i.first # NIL THEN
i.first.prev := this
END;
i.first := this
ELSE
ASSERT(before.root = i, 21);
ASSERT(before # this, 22);
this.root := i;
this.prev := before.prev; IF before.prev # NIL THEN before.prev.next := this END; before.prev := this;
this.next := before
END;
INC(i.length)
END Insert;
PROCEDURE (i: Iterator)Replace* (this, with: IteratorItem), NEW;
BEGIN
ASSERT(this # NIL, 20);
ASSERT(with # NIL, 21);
ASSERT(this.root = i, 22);
ASSERT(with # this, 24);
with.next := this.next;
with.prev := this.prev;
with.root := i; this.root := NIL; this.next := NIL; this.prev := NIL
END Replace;
PROCEDURE NewIterator* (): Iterator;
VAR it: Iterator;
BEGIN
NEW(it);
RETURN(it)
END NewIterator;
Это односвязный:
Код:
TYPE
List* = POINTER TO LIMITED RECORD
length-: INTEGER;
first, last: Item;
p: Parent
END;
Parent = POINTER TO RECORD END;
Item* = POINTER TO EXTENSIBLE RECORD
p: Parent;
_x: ANYPTR;
next: Item
END;
PROCEDURE (i: Item) SetData (x: ANYPTR), NEW;
BEGIN
i._x := x
END SetData;
PROCEDURE (i: Item) GetData (): ANYPTR, NEW;
BEGIN
RETURN i._x
END GetData;
PROCEDURE (l: List) FINALIZE-;
BEGIN
l.last := NIL;
l.first := NIL
END FINALIZE;
PROCEDURE (l: List) Last* (): Item, NEW;
BEGIN
RETURN l.last
END Last;
PROCEDURE (l: List) First* (): Item, NEW;
BEGIN
RETURN l.first
END First;
PROCEDURE (l: List) Next* (this: Item): Item, NEW;
BEGIN
ASSERT(this # NIL, 20); ASSERT(this.p = l.p, 21);
RETURN this.next
END Next;
PROCEDURE (l: List) Prev* (this: Item): Item, NEW;
VAR x, res: Item;
BEGIN
ASSERT(this # NIL, 20); ASSERT(this.p = l.p, 21);
IF x # l.first THEN
x := l.first;
WHILE (x # NIL) & (res = NIL) DO
IF x.next = this THEN res := x END;
x := x.next
END
END;
RETURN res
END Prev;
PROCEDURE (l: List) InsertAfter* (prev, this: Item), NEW; (* добавить this после prev, если prev=NIL, то в начало *)
BEGIN
ASSERT(this # NIL, 20); ASSERT(this.p = NIL, 21);
IF prev # NIL THEN ASSERT((l.first # NIL), 22); ASSERT(l.p = prev.p, 23) END;
IF (prev = NIL) & (l.first = NIL) THEN l.first := this; l.last := this
ELSIF (prev = NIL) & (l.first # NIL) THEN this.next := l.first; l.first := this
ELSE this.next := prev.next; prev.next := this END;
IF prev = l.last THEN l.last := this END;
INC(l.length); this.p := l.p
END InsertAfter;
PROCEDURE (l: List) Add* (this: Item), NEW;
BEGIN
ASSERT(this # NIL, 20); ASSERT(this.p = NIL, 21);
l.InsertAfter(l.last, this)
END Add;
PROCEDURE (l: List) Remove* (this: Item), NEW;
VAR prev: Item;
BEGIN
ASSERT(this # NIL, 20); ASSERT(this.p = l.p, 21);
prev := l.Prev(this);
IF prev = NIL THEN l.first := this.next
ELSE
prev.next := this.next;
IF this = l.last THEN l.last := prev END
END;
DEC(l.length); this.p := NIL; this.next := NIL
END Remove;
PROCEDURE (l: List) Index* (this: Item);
BEGIN
END Index;
PROCEDURE New* (): List;
VAR l: List;
BEGIN
NEW(l); l.length := 0; NEW(l.p);
RETURN (l)
END New;
PROCEDURE Join* (this, with: List): List;
VAR x, x0: Item;
BEGIN
ASSERT(this#NIL, 20); ASSERT(with#NIL, 21); ASSERT(with#this, 22); ASSERT(this.p#with.p, 23);
INC(this.length, with.length);
x:=with.first;
WHILE x#NIL DO
x0:=x; x:=with.Next(x);
x0.p:=this.p;
END;
IF this.first=NIL THEN this.first:=with.first
ELSIF (this.last#NIL) & (with.first#NIL) & (with.last#NIL) THEN this.last.next:=with.first; this.last:=with.last END;
with.length:=0; with.first:=NIL; with.last:=NIL;
RETURN this;
END Join;