Ответ 1
Следующий код может помочь (что связано с моим собственным компилятором для стыковки интерфейсов:
function GetExecutableMem(Size: Integer): Pointer;
procedure RaiseOutofMemory;
begin
raise EOutOfResources.Create('UnitProxyGenerator.GetExecutableMem: Out of memory error.');
end;
var
LastCommitTop: PChar;
begin
// We round the memory needed up to 16 bytes which seems to be a cache line amound on the P4.
Size := (Size + $F) and (not $F);
//
Result := MemUsed;
Inc(MemUsed, Size);
// Do we need to commit some more memory?
if MemUsed > MemCommitTop then begin
// Do we need more mem than we reserved initially?
if MemUsed > MemTop then RaiseOutOfMemory;
// Try to commit the memory requested.
LastCommitTop := MemCommitTop;
MemCommitTop := PChar((Longword(MemUsed) + (SystemInfo.dwPageSize - 1)) and (not (SystemInfo.dwPageSize - 1)));
if not Assigned(VirtualAlloc(LastCommitTop, MemCommitTop - LastCommitTop, MEM_COMMIT, PAGE_EXECUTE_READWRITE)) then RaiseOutOfMemory;
end;
end;
initialization
GetSystemInfo(SystemInfo);
MemBase := VirtualAlloc(nil, MemSize, MEM_RESERVE, PAGE_NOACCESS);
if MemBase = nil then Halt; // VERY BAD ...
MemUsed := MemBase;
MemCommitTop := MemBase;
MemTop := MemBase + MemSize;
finalization
VirtualFree(MemBase, MemSize, MEM_DECOMMIT);
VirtualFree(MemBase, 0, MEM_RELEASE);
end.
Обратите внимание на PAGE_EXECUTE_READWRITE в вызове VirtualAlloc.
Когда процесс запускается DEP, выполняется следующее:
type
TTestProc = procedure( out A: Integer ); stdcall;
procedure Encode( var P: PByte; Code: array of Byte ); overload;
var
i: Integer;
begin
for i := 0 to High( Code ) do begin
P^ := Code[ i ];
Inc( P );
end;
end;
procedure Encode( var P: PByte; Code: Integer ); overload;
begin
PInteger( P )^ := Code;
Inc( P, sizeof( Integer ) );
end;
procedure Encode( var P: PByte; Code: Pointer ); overload;
begin
PPointer( P )^ := Code;
Inc( P, sizeof( Pointer ) );
end;
// returns address where exceptiuon handler will be.
function EncodeTry( var P: PByte ): PByte;
begin
Encode( P, [ $33, $C0, $55,$68 ] ); // xor eax,eax; push ebp; push @handle
Result := P;
Encode( P, nil );
Encode( P, [ $64, $FF, $30, $64, $89, $20 ] ); // push dword ptr fs:[eax]; mov fs:[eax],esp
end;
procedure EncodePopTry( var P: PByte );
begin
Encode( P, [ $33, $C0, $5A, $59, $59, $64, $89, $10 ] ); // xor eax,eax; pop edx; pop ecx; pop ecx; mov fs:[eax],edx
end;
function Delta( P, Q: PByte ): Integer;
begin
Result := Integer( P ) - Integer( Q );
end;
function GetHandleFinally(): pointer;
asm
lea eax, [email protected]
end;
procedure TForm10.Button5Click( Sender: TObject );
var
P, Q, R, S, T: PByte;
A: Integer;
begin
P := VirtualAlloc( nil, $10000, MEM_RESERVE or MEM_COMMIT, PAGE_EXECUTE_READWRITE );
if not Assigned( P ) then Exit;
try
// ------------------------------------------------------------------------
// Equivalent
//
// A:=10;
// try
// A:=20
// PInteger(nil)^:=20
// finally
// A:=30;
// end;
// A:=40;
//
// ------------------------------------------------------------------------
// Stack frame
Q := P;
Encode( Q, [ $55, $8B, $EC ] ); // push ebp, mov ebp, esp
// A := 10;
Encode( Q, [ $8B, $45, $08, $C7, $00 ] );
Encode( Q, 10 ); // mov eax,[ebp+$08], mov [eax],<int32>
// try
R := EncodeTry( Q );
// TRY CODE !!!!
// A := 20;
Encode( Q, [ $8B, $45, $08, $C7, $00 ] );
Encode( Q, 20 ); // mov eax,[ebp+$08], mov [eax],<int32>
// REMOVE THIS AND NO EXCEPTION WILL OCCUR.
Encode( Q, [ $33, $C0, $C7, $00 ] ); // EXCEPTION: xor eax, eax, mov [eax], 20
Encode( Q, 20 );
// END OF REMOVE
// END OF TRY CODE
EncodePopTry( Q );
Encode( Q, [ $68 ] ); // push @<afterfinally>
S := Q;
Encode( Q, nil );
// FINALLY CODE!!!!
T := Q;
// A := 30;
Encode( Q, [ $8B, $45, $08, $C7, $00 ] );
Encode( Q, 30 ); // mov eax,[ebp+$08], mov [eax],<int32>
// AFter finally
Encode( Q, [ $C3 ] ); // ret
Encode( R, Q ); // Fixup try
// SEH handler
Encode( Q, [ $E9 ] ); // jmp
Encode( Q, Delta( GetHandleFinally(), Q ) - sizeof( Pointer ) ); // <diff:i32>
Encode( Q, [ $E9 ] ); // jmp
Encode( Q, Delta( T, Q ) - sizeof( Pointer ) ); // <diff:i32>
// After SEH frame
Encode( S, Q );
// A := 40;
Encode( Q, [ $8B, $45, $08, $C7, $00 ] );
Encode( Q, 40 ); // mov eax,[ebp+$08], mov [eax],<int32>
// pop stack frame
Encode( Q, [ $5D, $C2, $04, $00 ] ); // pop ebp, ret 4
// ------------------------------------------------------------------------
// And.... execute
A := 0;
try
TTestProc( P )( A );
except
;
end;
Caption := IntToStr( A )+'!1';
// Dofferent protection... execute
VirtualProtect( P, $10000, PAGE_EXECUTE_READ, nil );
A := 0;
try
TTestProc( P )( A );
except
;
end;
Caption := IntToStr( A ) + '!2';
finally
// Cleanup
VirtualFree( P, $10000, MEM_RELEASE );
end;
end;
Он работает на Windows 7 с отключенным и включенным DEP и, кажется, является минимальным фрагментом кода JIT с блоком try-finally Delphi. Может быть, это проблема с другой/более новой платформой Windows?