DELPHI, Delphi programming community @Mail.ru   ,     
| |
|
Delphi
FAQ |
, , ;)
|
. DELPHI
|
VCL
, -!
|
|
| |
:)
|
KOL MCK |
KOL MCK - Delphi

: 22.11.00


TVision () , - .


.
:

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


/:
   


  @Mail.ru       ,