http://ru.wikipedia.org/wiki/%D0%90%D0%BD%D0%BE%D0%BD%D0%B8%D0%BC%D0%BD%D0%B0%D1%8F_%D1%84%D1%83%D0%BD%D0%BA%D1%86%D0%B8%D1%8F
http://www.delphimaster.ru/cgi-bin/faq.pl?look=1&id=19-988623694
Зравствуете Акжан.
У вас в разделе есть следующий ворос и несколько ответов на него:
Вот всю жизнь в TVision в итераторах нужно было (параметром) передавать указатель на локальную процедуру, а тут задумал сделать свой итератор для обхода некоей древовидной структуры и на тебе - компилятор ругается. Да еще и в хелпе носом тыкают, что так мол в принципе нельзя делать... Гм. И как быть?
- могу предложить собственное решение данной проблемы. Тем более, что мой способ работает с рекурсивными вызовами любого уровня сложности:
type
Long = LongInt;
Bool = Boolean; // - так уж у меня в библиотеке сложилось
Tl3IteratorAction = function(Data: Pointer; Index: Long): Bool;
{$IfDef Win32}
register;
{$EndIf Win32}
var
l3StubHead : THandle = 0;
function l3AllocStub: THandle;
{-}
(* register;
asm
mov ecx, l3StubHead
jecxz @Alloc
mov eax, ecx
mov ecx, [ecx]
mov l3StubHead, ecx
ret
@Alloc:
xor eax, eax
push 16 { SizeOf(TCode) -> stack }
push eax { GMem_Fixed -> stack }
call GlobalAlloc
@ret:
end;{asm}*)
begin
if (l3StubHead = 0) then
Result := Windows{l3System}.GlobalAlloc(GMem_Fixed, 16)
else begin
Result := l3StubHead;
l3StubHead := PHandle(Result)^;
end;
end;
procedure l3FreeLocalStub(Stub: Pointer);
{-}
begin
PHandle(Stub)^ := l3StubHead;
l3StubHead := THandle(Stub);
end;
(*procedure l3FreeLocalStub(Stub: Pointer);
{eax}
register;
{-}
asm
push eax { Handle -> stack }
call GlobalFree
end;{asm}*)
procedure l3FreeStubs;
var
Prev : THandle;
Next : THandle;
begin
Prev := l3StubHead;
while (Prev <> 0) do begin
Next := PHandle(Prev)^;
Windows{l3System}.GlobalFree(Prev);
Prev := Next;
end;{Prev <> 0}
l3StubHead := 0;
end;
(*type
TCode = array [0..11] of Byte;
const
Code : TCode = (
$66, $58, { pop eax }
$68, $FF, $FF, { push $FFFF } { OldBP }
$66, $50, { push eax }
$EA, $EE, $EE, $FF, $FF { jmp $FFFF:$EEEE } { Action }
);*)
function l3LocalStub(Action: Pointer): Pointer;
{eax}
register;
{-}
asm
push edi { Save edi }
push eax { Save Action }
call l3AllocStub
{! --- !}
{xor eax, eax { 0 -> eax }
{push 16 { SizeOf(TCode) -> stack }
{push eax { GMem_Fixed -> stack }
{call GlobalAlloc}
{! --- !}
{ Создаем новый код: }
mov edi, eax { Handle -> edi }
mov edx, eax { Handle -> edx }
cld { Move forward }
mov eax, $68
stosb
mov eax, ebp { предыдущий ebp -> eax }
stosd { "push OldBP" -> [edi] }
mov eax, $B9
stosb
pop eax { Action -> eax }
stosd { "mov ecx, Action" -> [edi] }
mov eax, $D1FF
stosw { "call ecx" -> [edi] }
mov eax, $59
stosb { "pop ecx" -> es:[di] }
mov eax, $C3
stosb { "ret" -> [edi] }
mov eax, edx { Handle -> eax }
pop edi { Restore edi }
end;{asm}
function l3L2IA(Action: Pointer): Tl3IteratorAction;
{eax}
register;
{-}
asm
jmp l3LocalStub
end;{asm}
procedure l3FreeIA(Stub: Tl3IteratorAction);
{eax}
register;
{-}
asm
jmp l3FreeLocalStub
end;{asm}
теперь простейшая реализация итератора:
procedure Tl3VList.Iterate(aLo, aHi: Tl3Index; Action: Tl3IteratorAction);
{virtual;{!v19} {edx, ecx}
register;
{-}
(*asm
push ebx
mov ebx, eax
mov eax, [eax].Tl3VList.f_Count
or eax, eax
jle @@ret // список пуст
dec eax
cmp ecx, eax
jle @@aHiLECount
mov ecx, eax
@@aHiLECount:
mov eax, [ebx].Tl3VList.f_List
or eax, eax
jz @@ret // список пуст
or edx, edx
jge @@aLoGE0
xor edx, edx
@@aLoGE0:
sub ecx, edx
jl @@ret // верхний индекс меньше нижнего
mov ebx, edx
shl ebx, 2
add eax, ebx
pop ebx
inc ecx
@@loop:
push eax
push edx
push ecx
call Action
pop ecx
pop edx
or al, al
jz @@loopend
pop eax
add eax, 4
inc edx
loop @@loop
jmp @@ex
@@loopend:
pop eax
jmp @@ex
@@ret:
pop ebx
@@ex:
end;//asm*)
var
i, j, k : Long;
l_TmpItem : Pointer;
begin
if (f_List <> nil) then begin
j := Max(0, aLo);
k := Min(Pred(Count), aHi);
if IsMultiThread then
for i := j to k do begin
l_TmpItem := Items[i];
if not Action(@l_TmpItem, i) then break;
end
else
for i := j to k do
if not Action(PChar(f_List) + i * SizeOf(Pointer), i) then break;
end;{f_List <> nil}
end;
procedure Tl3VStorage.IterateF(I1, I2: Tl3Index; Action: Tl3IteratorAction);
{-}
begin
try
Iterate(I1, I2, Action);
finally
l3FreeIA(Action);
end;{try..finally}
end;
и его вызов:
function Tl3VList.IndexOf(Item: Pointer): LongInt;
function FindItem(P: PPointer; Index: Long): Bool; far;
begin
if (P^ = Item) then begin
IndexOf := Index;
Result := false;
end else
Result := true;
end;
begin
Result := -1;
IterateAllF(l3L2IA(@FindItem));
end;
- забавно, что метод Iterate можно вызывать как для глобального, так и для локального метода (естественно с предшествующим вызовом l3L2IA).
в секции finalization модуля где живет l3L2IA надо не забыть вызвать метод: l3FreeStubs.
- это схематично идеи, просто выдирать все целиком из своей библиотеки - тяжело да и некогда.
-- Прислал: Alex W. Lulin lulin@garant.ru http://lulinalex.chat.ru --
