Вызов локальных функций для глобального контекста

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 --