Mas*_*ler 19 windows delphi compiler-construction jit exception-handling
我正在开发一个似乎工作正常的JIT编译器,除了一个问题:当代码引发异常并且异常处理程序在JITted例程中时,操作系统会立即终止进程.当我关闭DEP时不会发生这种情况,所以我认为它与DEP有关.
当DEP关闭时,异常处理程序正确运行,我确保调用VirtualProtect保护值为的JITted例程PAGE_EXECUTE_READ,然后验证它VirtualQuery.
在调试器下对此进行测试会报告致命错误发生在引发异常的位置,而不是稍后,我认为这意味着发生了类似的事情:
有没有人知道我可能做错了什么,以及如何让DEP接受我的异常处理程序？执行JITted代码本身没有任何问题.
编辑:这是生成存根的Delphi代码.它分配内存,加载基本代码,修复跳转修复和尝试块,然后将内存标记为可执行文件.这是DWS项目中外部函数JIT正在进行的工作的一部分.
function MakeExecutable(const value: TBytes; const calls: TFunctionCallArray; call: pointer;
const tryFrame: TTryFrame): pointer;
var
oldprotect: cardinal;
lCall, lOffset: nativeInt;
ptr: pointer;
fixup: TFunctionCall;
info: _MEMORY_BASIC_INFORMATION;
begin
result := VirtualAlloc(nil, length(value), MEM_RESERVE or MEM_COMMIT, PAGE_READWRITE);
system.Move(value[0], result^, length(value));
for fixup in calls do
begin
ptr := @PByte(result)[fixup.offset];
if fixup.call = 0 then
lCall := nativeInt(call)
else lCall := fixup.call;
lOffset := (lCall - NativeInt(ptr)) - sizeof(pointer);
PNativeInt(ptr)^ := lOffset;
end;
if tryFrame[0] <> 0 then
begin
ptr := @PByte(result)[tryFrame[0]];
if PPointer(ptr)^ <> nil then
asm int 3 end;
PPointer(ptr)^ := @PByte(result)[tryFrame[2] - 1];
ptr := @PByte(result)[tryFrame[1]];
if PPointer(ptr)^ <> nil then
asm int 3 end;
PPointer(ptr)^ := @PByte(result)[tryFrame[3]];
end;
if not VirtualProtect(result, length(value), PAGE_EXECUTE_READ, oldProtect) then
RaiseLastOSError;
VirtualQuery(result, info, sizeof(info));
if info.Protect <> PAGE_EXECUTE_READ then
raise Exception.Create('VirtualProtect failed');
end;
重现问题:
dwsExternalFunctionTests.编辑2:这是生成的机器代码例程的转储:
//preamble
02870000 55 push ebp
02870001 89E5 mov ebp,esp
02870003 83C4F4 add esp,-$0c
02870006 51 push ecx
02870007 53 push ebx
02870008 56 push esi
02870009 57 push edi
0287000A 8BDA mov ebx,edx
0287000C 8B33 mov esi,[ebx]
0287000E 31C0 xor eax,eax
//setup exception frame
02870010 55 push ebp
02870011 685D008702 push $0287005d
02870016 64FF30 push dword ptr fs:[eax]
02870019 648920 mov fs:[eax],esp
//procedure body
0287001C 31C9 xor ecx,ecx
0287001E 894DF8 mov [ebp-$08],ecx
02870021 8B06 mov eax,[esi]
02870023 8B5308 mov edx,[ebx+$08]
02870026 8B38 mov edi,[eax]
02870028 FF5710 call dword ptr [edi+$10]
0287002B 8945FC mov [ebp-$04],eax
0287002E 8B4604 mov eax,[esi+$04]
02870031 8B5308 mov edx,[ebx+$08]
02870034 8D4DF8 lea ecx,[ebp-$08]
02870037 8B38 mov edi,[eax]
02870039 FF571C call dword ptr [edi+$1c]
//call to a native routine. This routine raises an exception
0287003C 8B55F8 mov edx,[ebp-$08]
0287003F 8B45FC mov eax,[ebp-$04]
02870042 E8CD1FE6FD call TestStringExc
//cleanup
02870047 31C0 xor eax,eax
02870049 5A pop edx
0287004A 59 pop ecx
0287004B 59 pop ecx
//exception handler: a try/finally block to clean
//up a string variable used in the body of the code
0287004C 648910 mov fs:[eax],edx
0287004F 6864008702 push $02870064
02870054 8D45F8 lea eax,[ebp-$08]
02870057 E86870B9FD call @UStrClr
0287005C C3 ret
0287005D E98666B9FD jmp @HandleFinally
02870062 EBF0 jmp $02870054
//more cleanup
02870064 5F pop edi
02870065 5E pop esi
02870066 5B pop ebx
02870067 59 pop ecx
02870068 8BE5 mov esp,ebp
0287006A 5D pop ebp
0287006B C3 ret
这被设计为与以下Delphi代码等效(如果不相同):
function Stub(const args: TExprBaseListExec): Variant;
var
list: PObjectTightList;
a: integer;
b: string;
//use of a string variable will introduce an implicit try-finally
//block by the compiler to handle cleanup
begin
list := args.List;
a := TExprBase(args[0]).EvalAsInteger(args.exec);
TExprBase(args[1]).EvalAsString(args.exec, b);
TestStringExc(a, b);
end;
TestStringExc例程的目的是引发异常并确保异常处理程序正确清理字符串.
以下代码可能会有所帮助（来自我自己的用于存根接口的编译器：
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.
请注意 VirtualAlloc 调用中的 PAGE_EXECUTE_READWRITE。
当进程运行 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, system.@HandleFinally
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;
它可以在禁用和启用 DEP 的 Windows 7 上运行，并且似乎是一段带有 Delphi try-finally 块的最小“JIT 代码”。是否是不同/较新的 Windows 平台的问题？