mirror of
https://gitlab.com/freepascal.org/fpc/source.git
synced 2025-11-04 12:39:38 +01:00
+ SEH support for Win32. Enable by cycling with OPT=-dTEST_WIN32_SEH.
Although basic things work (no regressions in test suite, also with TEST_OPT=-O2), there are some secondary issues/TODOs: - Exception frame around PASCALMAIN is not properly removed in DLLs - No stack traces yet - Stack overallocated in finalizer procedures, their entry/exit code needs cleanup - Signals unit is probably completely broken. git-svn-id: trunk@26225 -
This commit is contained in:
sergei
parent
b2e85d2c56
commit
179586f589
2
.gitattributes
vendored
2
.gitattributes
vendored
@ -204,6 +204,7 @@ compiler/i386/i386prop.inc svneol=native#text/plain
|
||||
compiler/i386/i386tab.inc svneol=native#text/plain
|
||||
compiler/i386/n386add.pas svneol=native#text/plain
|
||||
compiler/i386/n386cal.pas svneol=native#text/plain
|
||||
compiler/i386/n386flw.pas svneol=native#text/plain
|
||||
compiler/i386/n386inl.pas svneol=native#text/plain
|
||||
compiler/i386/n386mat.pas svneol=native#text/plain
|
||||
compiler/i386/n386mem.pas svneol=native#text/plain
|
||||
@ -9112,6 +9113,7 @@ rtl/win32/gprt0.as svneol=native#text/plain
|
||||
rtl/win32/initc.pp svneol=native#text/plain
|
||||
rtl/win32/objinc.inc svneol=native#text/plain
|
||||
rtl/win32/rtldefs.inc svneol=native#text/plain
|
||||
rtl/win32/seh32.inc svneol=native#text/plain
|
||||
rtl/win32/signals.pp svneol=native#text/plain
|
||||
rtl/win32/sysinit.inc svneol=native#text/plain
|
||||
rtl/win32/sysinitcyg.pp svneol=native#text/plain
|
||||
|
||||
@ -294,13 +294,13 @@ unit cgcpu;
|
||||
|
||||
procedure tcg386.g_proc_exit(list : TAsmList;parasize:longint;nostackframe:boolean);
|
||||
|
||||
procedure increase_fp(a : tcgint);
|
||||
procedure increase_sp(a : tcgint);
|
||||
var
|
||||
href : treference;
|
||||
begin
|
||||
reference_reset_base(href,current_procinfo.framepointer,a,0);
|
||||
reference_reset_base(href,NR_STACK_POINTER_REG,a,0);
|
||||
{ normally, lea is a better choice than an add }
|
||||
list.concat(Taicpu.op_ref_reg(A_LEA,TCGSize2OpSize[OS_ADDR],href,current_procinfo.framepointer));
|
||||
list.concat(Taicpu.op_ref_reg(A_LEA,TCGSize2OpSize[OS_ADDR],href,NR_STACK_POINTER_REG));
|
||||
end;
|
||||
|
||||
var
|
||||
@ -314,7 +314,8 @@ unit cgcpu;
|
||||
{ remove stackframe }
|
||||
if not nostackframe then
|
||||
begin
|
||||
if current_procinfo.framepointer=NR_STACK_POINTER_REG then
|
||||
if (current_procinfo.framepointer=NR_STACK_POINTER_REG) or
|
||||
(current_procinfo.procdef.proctypeoption=potype_exceptfilter) then
|
||||
begin
|
||||
stacksize:=current_procinfo.calc_stackframe_size;
|
||||
if (target_info.stackalign>4) and
|
||||
@ -325,9 +326,11 @@ unit cgcpu;
|
||||
(po_assembler in current_procinfo.procdef.procoptions)) then
|
||||
stacksize := align(stacksize+sizeof(aint),target_info.stackalign) - sizeof(aint);
|
||||
if stacksize<>0 then
|
||||
increase_fp(stacksize);
|
||||
increase_sp(stacksize);
|
||||
if (not paramanager.use_fixed_stack) then
|
||||
internal_restore_regs(list,true);
|
||||
if (current_procinfo.procdef.proctypeoption=potype_exceptfilter) then
|
||||
list.concat(Taicpu.op_reg(A_POP,tcgsize2opsize[OS_ADDR],NR_FRAME_POINTER_REG));
|
||||
end
|
||||
else
|
||||
begin
|
||||
|
||||
@ -54,6 +54,9 @@ unit cpunode;
|
||||
n386mem,
|
||||
n386set,
|
||||
n386inl,
|
||||
{$ifdef TEST_WIN32_SEH}
|
||||
n386flw,
|
||||
{$endif TEST_WIN32_SEH}
|
||||
n386mat
|
||||
;
|
||||
|
||||
|
||||
680
compiler/i386/n386flw.pas
Normal file
680
compiler/i386/n386flw.pas
Normal file
@ -0,0 +1,680 @@
|
||||
{
|
||||
Copyright (c) 2011 by Free Pascal development team
|
||||
|
||||
Generate Win32-specific exception handling code
|
||||
|
||||
This program is free software; you can redistribute it and/or modify
|
||||
it under the terms of the GNU General Public License as published by
|
||||
the Free Software Foundation; either version 2 of the License, or
|
||||
(at your option) any later version.
|
||||
|
||||
This program is distributed in the hope that it will be useful,
|
||||
but WITHOUT ANY WARRANTY; without even the implied warranty of
|
||||
MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
|
||||
GNU General Public License for more details.
|
||||
|
||||
You should have received a copy of the GNU General Public License
|
||||
along with this program; if not, write to the Free Software
|
||||
Foundation, Inc., 675 Mass Ave, Cambridge, MA 02139, USA.
|
||||
|
||||
****************************************************************************
|
||||
}
|
||||
unit n386flw;
|
||||
|
||||
{$i fpcdefs.inc}
|
||||
|
||||
interface
|
||||
|
||||
uses
|
||||
node,nflw,ncgflw,psub;
|
||||
|
||||
type
|
||||
ti386raisenode=class(tcgraisenode)
|
||||
function pass_1 : tnode;override;
|
||||
end;
|
||||
|
||||
ti386onnode=class(tcgonnode)
|
||||
procedure pass_generate_code;override;
|
||||
end;
|
||||
|
||||
ti386tryexceptnode=class(tcgtryexceptnode)
|
||||
procedure pass_generate_code;override;
|
||||
end;
|
||||
|
||||
ti386tryfinallynode=class(tcgtryfinallynode)
|
||||
finalizepi: tcgprocinfo;
|
||||
constructor create(l,r:TNode);override;
|
||||
constructor create_implicit(l,r,_t1:TNode);override;
|
||||
function pass_1: tnode;override;
|
||||
function simplify(forinline: boolean): tnode;override;
|
||||
procedure pass_generate_code;override;
|
||||
end;
|
||||
|
||||
implementation
|
||||
|
||||
uses
|
||||
cutils,globtype,globals,verbose,systems,
|
||||
nbas,ncal,nmem,nutils,
|
||||
symconst,symbase,symtable,symsym,symdef,
|
||||
cgbase,cgobj,cgcpu,cgutils,tgobj,
|
||||
cpubase,htypechk,
|
||||
parabase,paramgr,pdecsub,pass_1,pass_2,ncgutil,cga,
|
||||
aasmbase,aasmtai,aasmdata,aasmcpu,procinfo,cpupi;
|
||||
|
||||
var
|
||||
endexceptlabel: tasmlabel;
|
||||
|
||||
|
||||
{ ti386raisenode }
|
||||
|
||||
function ti386raisenode.pass_1 : tnode;
|
||||
var
|
||||
statements : tstatementnode;
|
||||
raisenode : tcallnode;
|
||||
begin
|
||||
{ difference from generic code is that address stack is not popped on reraise }
|
||||
if (target_info.system<>system_i386_win32) or assigned(left) then
|
||||
result:=inherited pass_1
|
||||
else
|
||||
begin
|
||||
result:=internalstatements(statements);
|
||||
raisenode:=ccallnode.createintern('fpc_reraise',nil);
|
||||
include(raisenode.callnodeflags,cnf_call_never_returns);
|
||||
addstatement(statements,raisenode);
|
||||
end;
|
||||
end;
|
||||
|
||||
{ ti386onnode }
|
||||
|
||||
procedure ti386onnode.pass_generate_code;
|
||||
var
|
||||
oldflowcontrol : tflowcontrol;
|
||||
exceptvarsym : tlocalvarsym;
|
||||
begin
|
||||
if (target_info.system<>system_i386_win32) then
|
||||
begin
|
||||
inherited pass_generate_code;
|
||||
exit;
|
||||
end;
|
||||
|
||||
location_reset(location,LOC_VOID,OS_NO);
|
||||
|
||||
oldflowcontrol:=flowcontrol;
|
||||
flowcontrol:=flowcontrol*[fc_unwind]+[fc_inflowcontrol];
|
||||
|
||||
{ RTL will put exceptobject into EAX when jumping here }
|
||||
cg.a_reg_alloc(current_asmdata.CurrAsmList,NR_FUNCTION_RESULT_REG);
|
||||
|
||||
{ Retrieve exception variable }
|
||||
if assigned(excepTSymtable) then
|
||||
exceptvarsym:=tlocalvarsym(excepTSymtable.SymList[0])
|
||||
else
|
||||
exceptvarsym:=nil;
|
||||
|
||||
if assigned(exceptvarsym) then
|
||||
begin
|
||||
exceptvarsym.localloc.loc:=LOC_REFERENCE;
|
||||
exceptvarsym.localloc.size:=OS_ADDR;
|
||||
tg.GetLocal(current_asmdata.CurrAsmList,sizeof(pint),voidpointertype,exceptvarsym.localloc.reference);
|
||||
cg.a_load_reg_ref(current_asmdata.CurrAsmList,OS_ADDR,OS_ADDR,NR_FUNCTION_RESULT_REG,exceptvarsym.localloc.reference);
|
||||
end;
|
||||
cg.a_reg_dealloc(current_asmdata.CurrAsmList,NR_FUNCTION_RESULT_REG);
|
||||
|
||||
if assigned(right) then
|
||||
secondpass(right);
|
||||
|
||||
{ deallocate exception symbol }
|
||||
if assigned(exceptvarsym) then
|
||||
begin
|
||||
tg.UngetLocal(current_asmdata.CurrAsmList,exceptvarsym.localloc.reference);
|
||||
exceptvarsym.localloc.loc:=LOC_INVALID;
|
||||
end;
|
||||
cg.g_call(current_asmdata.CurrAsmList,'FPC_DONEEXCEPTION');
|
||||
cg.a_jmp_always(current_asmdata.CurrAsmList,endexceptlabel);
|
||||
|
||||
flowcontrol:=oldflowcontrol+(flowcontrol-[fc_inflowcontrol]);
|
||||
end;
|
||||
|
||||
{ ti386tryfinallynode }
|
||||
|
||||
function reset_regvars(var n: tnode; arg: pointer): foreachnoderesult;
|
||||
begin
|
||||
case n.nodetype of
|
||||
temprefn:
|
||||
make_not_regable(n,[]);
|
||||
calln:
|
||||
include(tprocinfo(arg).flags,pi_do_call);
|
||||
end;
|
||||
result:=fen_true;
|
||||
end;
|
||||
|
||||
function copy_parasize(var n: tnode; arg: pointer): foreachnoderesult;
|
||||
begin
|
||||
case n.nodetype of
|
||||
calln:
|
||||
tcgprocinfo(arg).allocate_push_parasize(tcallnode(n).pushed_parasize);
|
||||
end;
|
||||
result:=fen_true;
|
||||
end;
|
||||
|
||||
constructor ti386tryfinallynode.create(l, r: TNode);
|
||||
begin
|
||||
inherited create(l,r);
|
||||
if (target_info.system<>system_i386_win32) or (
|
||||
{ Don't create child procedures for generic methods, their nested-like
|
||||
behavior causes compilation errors because real nested procedures
|
||||
aren't allowed for generics. Not creating them doesn't harm because
|
||||
generic node tree is discarded without generating code. }
|
||||
assigned(current_procinfo.procdef.struct) and
|
||||
(df_generic in current_procinfo.procdef.struct.defoptions)
|
||||
) then
|
||||
exit;
|
||||
finalizepi:=tcgprocinfo(cprocinfo.create(current_procinfo));
|
||||
finalizepi.force_nested;
|
||||
finalizepi.procdef:=create_finalizer_procdef;
|
||||
finalizepi.entrypos:=r.fileinfo;
|
||||
finalizepi.entryswitches:=r.localswitches;
|
||||
finalizepi.exitpos:=current_filepos; // last_endtoken_pos?
|
||||
finalizepi.exitswitches:=current_settings.localswitches;
|
||||
{ Regvar optimization for symbols is suppressed when using exceptions, but
|
||||
temps may be still placed into registers. This must be fixed. }
|
||||
foreachnodestatic(r,@reset_regvars,finalizepi);
|
||||
end;
|
||||
|
||||
constructor ti386tryfinallynode.create_implicit(l, r, _t1: TNode);
|
||||
begin
|
||||
inherited create_implicit(l, r, _t1);
|
||||
if (target_info.system<>system_i386_win32) then
|
||||
exit;
|
||||
|
||||
{ safecall procedures can handle implicit finalization as part of "except" flow }
|
||||
if implicitframe and (current_procinfo.procdef.proccalloption=pocall_safecall) then
|
||||
exit;
|
||||
|
||||
if assigned(current_procinfo.procdef.struct) and
|
||||
(df_generic in current_procinfo.procdef.struct.defoptions) then
|
||||
InternalError(2013012501);
|
||||
|
||||
finalizepi:=tcgprocinfo(cprocinfo.create(current_procinfo));
|
||||
finalizepi.force_nested;
|
||||
finalizepi.procdef:=create_finalizer_procdef;
|
||||
finalizepi.entrypos:=current_filepos;
|
||||
finalizepi.exitpos:=current_filepos; // last_endtoken_pos?
|
||||
finalizepi.entryswitches:=r.localswitches;
|
||||
finalizepi.exitswitches:=current_settings.localswitches;
|
||||
include(finalizepi.flags,pi_has_assembler_block);
|
||||
include(finalizepi.flags,pi_do_call);
|
||||
end;
|
||||
|
||||
|
||||
function ti386tryfinallynode.pass_1: tnode;
|
||||
var
|
||||
selfsym: tparavarsym;
|
||||
begin
|
||||
result:=inherited pass_1;
|
||||
if (target_info.system=system_i386_win32) then
|
||||
begin
|
||||
{ safecall method will access 'self' from except block -> make it non-regable }
|
||||
if implicitframe and (current_procinfo.procdef.proccalloption=pocall_safecall) and
|
||||
is_class(current_procinfo.procdef.struct) then
|
||||
begin
|
||||
selfsym:=tparavarsym(current_procinfo.procdef.parast.Find('self'));
|
||||
if (selfsym=nil) or (selfsym.typ<>paravarsym) then
|
||||
InternalError(2011123101);
|
||||
selfsym.varregable:=vr_none;
|
||||
end;
|
||||
end;
|
||||
end;
|
||||
|
||||
|
||||
function ti386tryfinallynode.simplify(forinline: boolean): tnode;
|
||||
begin
|
||||
result:=inherited simplify(forinline);
|
||||
if (target_info.system<>system_i386_win32) then
|
||||
exit;
|
||||
|
||||
if (result=nil) and assigned(finalizepi) then
|
||||
begin
|
||||
finalizepi.code:=right;
|
||||
foreachnodestatic(right,@copy_parasize,finalizepi);
|
||||
right:=ccallnode.create(nil,tprocsym(finalizepi.procdef.procsym),nil,nil,[]);
|
||||
firstpass(right);
|
||||
{ For implicit frames, no actual code is available at this time,
|
||||
it is added later in assembler form. So store the nested procinfo
|
||||
for later use. }
|
||||
if implicitframe then
|
||||
begin
|
||||
current_procinfo.finalize_procinfo:=finalizepi;
|
||||
{ don't leave dangling pointer }
|
||||
tcgprocinfo(current_procinfo).final_asmnode:=nil;
|
||||
end;
|
||||
end;
|
||||
end;
|
||||
|
||||
procedure emit_scope_start(handler,data: TAsmSymbol);
|
||||
var
|
||||
href: treference;
|
||||
hreg: tregister;
|
||||
begin
|
||||
hreg:=cg.getintregister(current_asmdata.CurrAsmList,OS_ADDR);
|
||||
reference_reset_base(href,hreg,0,sizeof(pint));
|
||||
href.segment:=NR_FS;
|
||||
emit_reg_reg(A_XOR,S_L,hreg,hreg);
|
||||
emit_sym(A_PUSH,S_L,data);
|
||||
emit_reg(A_PUSH,S_L,NR_FRAME_POINTER_REG);
|
||||
emit_sym(A_PUSH,S_L,handler);
|
||||
emit_ref(A_PUSH,S_L,href);
|
||||
emit_reg_ref(A_MOV,S_L,NR_ESP,href);
|
||||
end;
|
||||
|
||||
procedure emit_scope_end;
|
||||
var
|
||||
href: treference;
|
||||
hreg,hreg2: tregister;
|
||||
begin
|
||||
hreg:=cg.getintregister(current_asmdata.CurrAsmList,OS_ADDR);
|
||||
hreg2:=cg.getintregister(current_asmdata.CurrAsmList,OS_ADDR);
|
||||
reference_reset_base(href,hreg,0,sizeof(pint));
|
||||
href.segment:=NR_FS;
|
||||
emit_reg_reg(A_XOR,S_L,hreg,hreg);
|
||||
emit_reg(A_POP,S_L,hreg2);
|
||||
emit_const_reg(A_ADD,S_L,3*sizeof(pint),NR_ESP);
|
||||
emit_reg_ref(A_MOV,S_L,hreg2,href);
|
||||
end;
|
||||
|
||||
procedure ti386tryfinallynode.pass_generate_code;
|
||||
var
|
||||
finallylabel,
|
||||
exceptlabel,
|
||||
safecalllabel,
|
||||
endfinallylabel,
|
||||
exitfinallylabel,
|
||||
continuefinallylabel,
|
||||
breakfinallylabel,
|
||||
oldCurrExitLabel,
|
||||
oldContinueLabel,
|
||||
oldBreakLabel : tasmlabel;
|
||||
oldflowcontrol,tryflowcontrol : tflowcontrol;
|
||||
is_safecall: boolean;
|
||||
hreg: tregister;
|
||||
begin
|
||||
if (target_info.system<>system_i386_win32) then
|
||||
begin
|
||||
inherited pass_generate_code;
|
||||
exit;
|
||||
end;
|
||||
location_reset(location,LOC_VOID,OS_NO);
|
||||
tryflowcontrol:=[];
|
||||
oldBreakLabel:=nil;
|
||||
oldContinueLabel:=nil;
|
||||
continuefinallylabel:=nil;
|
||||
breakfinallylabel:=nil;
|
||||
exceptlabel:=nil;
|
||||
safecalllabel:=nil;
|
||||
is_safecall:=implicitframe and (current_procinfo.procdef.proccalloption=pocall_safecall);
|
||||
|
||||
{ check if child nodes do a break/continue/exit }
|
||||
oldflowcontrol:=flowcontrol;
|
||||
flowcontrol:=[fc_inflowcontrol];
|
||||
current_asmdata.getjumplabel(finallylabel);
|
||||
current_asmdata.getjumplabel(endfinallylabel);
|
||||
|
||||
{ the finally block must catch break, continue and exit }
|
||||
{ statements }
|
||||
oldCurrExitLabel:=current_procinfo.CurrExitLabel;
|
||||
if implicitframe then
|
||||
exitfinallylabel:=finallylabel
|
||||
else
|
||||
current_asmdata.getjumplabel(exitfinallylabel);
|
||||
current_procinfo.CurrExitLabel:=exitfinallylabel;
|
||||
if assigned(current_procinfo.CurrBreakLabel) then
|
||||
begin
|
||||
oldContinueLabel:=current_procinfo.CurrContinueLabel;
|
||||
oldBreakLabel:=current_procinfo.CurrBreakLabel;
|
||||
if implicitframe then
|
||||
begin
|
||||
breakfinallylabel:=finallylabel;
|
||||
continuefinallylabel:=finallylabel;
|
||||
end
|
||||
else
|
||||
begin
|
||||
current_asmdata.getjumplabel(breakfinallylabel);
|
||||
current_asmdata.getjumplabel(continuefinallylabel);
|
||||
end;
|
||||
current_procinfo.CurrContinueLabel:=continuefinallylabel;
|
||||
current_procinfo.CurrBreakLabel:=breakfinallylabel;
|
||||
end;
|
||||
|
||||
{ Start of scope }
|
||||
if is_safecall then
|
||||
begin
|
||||
with cg.rg[R_INTREGISTER] do
|
||||
used_in_proc:=used_in_proc+[RS_EBX,RS_ESI,RS_EDI];
|
||||
|
||||
current_asmdata.getjumplabel(exceptlabel);
|
||||
emit_scope_start(
|
||||
current_asmdata.RefAsmSymbol('__FPC_except_safecall'),
|
||||
exceptlabel
|
||||
);
|
||||
end
|
||||
else
|
||||
emit_scope_start(
|
||||
current_asmdata.RefAsmSymbol('__FPC_finally_handler'),
|
||||
current_asmdata.RefAsmSymbol(finalizepi.procdef.mangledname)
|
||||
);
|
||||
|
||||
{ try code }
|
||||
if assigned(left) then
|
||||
begin
|
||||
secondpass(left);
|
||||
tryflowcontrol:=flowcontrol;
|
||||
if codegenerror then
|
||||
exit;
|
||||
end;
|
||||
|
||||
{ don't generate line info for internal cleanup }
|
||||
current_asmdata.CurrAsmList.concat(tai_marker.create(mark_NoLineInfoStart));
|
||||
|
||||
cg.a_label(current_asmdata.CurrAsmList,finallylabel);
|
||||
emit_scope_end;
|
||||
if is_safecall then
|
||||
begin
|
||||
current_asmdata.getjumplabel(safecalllabel);
|
||||
hreg:=cg.GetIntRegister(current_asmdata.CurrAsmList,OS_INT);
|
||||
cg.a_load_const_reg(current_asmdata.CurrAsmList,OS_INT,0,hreg);
|
||||
cg.a_jmp_always(current_asmdata.CurrAsmList,safecalllabel);
|
||||
{ RTL handler will jump here on exception }
|
||||
cg.a_label(current_asmdata.CurrAsmList,exceptlabel);
|
||||
handle_safecall_exception;
|
||||
cg.a_load_reg_reg(current_asmdata.CurrAsmList,OS_INT,OS_INT,NR_FUNCTION_RESULT_REG,hreg);
|
||||
cg.a_label(current_asmdata.CurrAsmList,safecalllabel);
|
||||
end;
|
||||
|
||||
{ end cleanup }
|
||||
current_asmdata.CurrAsmList.concat(tai_marker.create(mark_NoLineInfoEnd));
|
||||
|
||||
{ generate finally code as a separate procedure }
|
||||
{ !!! this resets flowcontrol, how to check flow away? }
|
||||
if not implicitframe then
|
||||
tcgprocinfo(current_procinfo).generate_exceptfilter(finalizepi);
|
||||
|
||||
flowcontrol:=[fc_inflowcontrol];
|
||||
{ right is a call to finalizer procedure }
|
||||
secondpass(right);
|
||||
|
||||
{ goto is allowed if it stays inside the finally block,
|
||||
this is checked using the exception block number }
|
||||
if (flowcontrol-[fc_gotolabel])<>[fc_inflowcontrol] then
|
||||
CGMessage(cg_e_control_flow_outside_finally);
|
||||
if codegenerror then
|
||||
exit;
|
||||
|
||||
{ don't generate line info for internal cleanup }
|
||||
current_asmdata.CurrAsmList.concat(tai_marker.create(mark_NoLineInfoStart));
|
||||
|
||||
if not implicitframe then
|
||||
begin
|
||||
if tryflowcontrol*[fc_exit,fc_break,fc_continue]<>[] then
|
||||
cg.a_jmp_always(current_asmdata.CurrAsmList,endfinallylabel);
|
||||
{ do some magic for exit,break,continue in the try block }
|
||||
if fc_exit in tryflowcontrol then
|
||||
begin
|
||||
cg.a_label(current_asmdata.CurrAsmList,exitfinallylabel);
|
||||
cg.g_call(current_asmdata.CurrAsmList,'_FPC_leave');
|
||||
cg.a_jmp_always(current_asmdata.CurrAsmList,oldCurrExitLabel);
|
||||
end;
|
||||
if fc_break in tryflowcontrol then
|
||||
begin
|
||||
cg.a_label(current_asmdata.CurrAsmList,breakfinallylabel);
|
||||
cg.g_call(current_asmdata.CurrAsmList,'_FPC_leave');
|
||||
cg.a_jmp_always(current_asmdata.CurrAsmList,oldBreakLabel);
|
||||
end;
|
||||
if fc_continue in tryflowcontrol then
|
||||
begin
|
||||
cg.a_label(current_asmdata.CurrAsmList,continuefinallylabel);
|
||||
cg.g_call(current_asmdata.CurrAsmList,'_FPC_leave');
|
||||
cg.a_jmp_always(current_asmdata.CurrAsmList,oldContinueLabel);
|
||||
end;
|
||||
end;
|
||||
if is_safecall then
|
||||
cg.a_load_reg_reg(current_asmdata.CurrAsmList,OS_INT,OS_INT,hreg,NR_FUNCTION_RETURN_REG);
|
||||
cg.a_label(current_asmdata.CurrAsmList,endfinallylabel);
|
||||
|
||||
{ end cleanup }
|
||||
current_asmdata.CurrAsmList.concat(tai_marker.create(mark_NoLineInfoEnd));
|
||||
|
||||
current_procinfo.CurrExitLabel:=oldCurrExitLabel;
|
||||
if assigned(current_procinfo.CurrBreakLabel) then
|
||||
begin
|
||||
current_procinfo.CurrContinueLabel:=oldContinueLabel;
|
||||
current_procinfo.CurrBreakLabel:=oldBreakLabel;
|
||||
end;
|
||||
flowcontrol:=oldflowcontrol+(tryflowcontrol-[fc_inflowcontrol]);
|
||||
end;
|
||||
|
||||
{ ti386tryexceptnode }
|
||||
|
||||
procedure ti386tryexceptnode.pass_generate_code;
|
||||
var
|
||||
exceptlabel,oldendexceptlabel,
|
||||
lastonlabel,
|
||||
exitexceptlabel,
|
||||
continueexceptlabel,
|
||||
breakexceptlabel,
|
||||
exittrylabel,
|
||||
continuetrylabel,
|
||||
breaktrylabel,
|
||||
oldCurrExitLabel,
|
||||
oldContinueLabel,
|
||||
oldBreakLabel : tasmlabel;
|
||||
onlabel,
|
||||
filterlabel: tasmlabel;
|
||||
oldflowcontrol,tryflowcontrol,
|
||||
exceptflowcontrol : tflowcontrol;
|
||||
hnode : tnode;
|
||||
hlist : tasmlist;
|
||||
onnodecount : tai_const;
|
||||
label
|
||||
errorexit;
|
||||
begin
|
||||
if (target_info.system<>system_i386_win32) then
|
||||
begin
|
||||
inherited pass_generate_code;
|
||||
exit;
|
||||
end;
|
||||
location_reset(location,LOC_VOID,OS_NO);
|
||||
|
||||
oldflowcontrol:=flowcontrol;
|
||||
flowcontrol:=[fc_inflowcontrol];
|
||||
{ this can be called recursivly }
|
||||
oldBreakLabel:=nil;
|
||||
oldContinueLabel:=nil;
|
||||
oldendexceptlabel:=endexceptlabel;
|
||||
|
||||
{ Win32 SEH unwinding does not preserve registers. Indicate that they are
|
||||
going to be destroyed. }
|
||||
cg.alloccpuregisters(current_asmdata.CurrAsmList,R_INTREGISTER,[RS_EAX,RS_EBX,RS_ECX,RS_EDX,RS_ESI,RS_EDI]);
|
||||
cg.dealloccpuregisters(current_asmdata.CurrAsmList,R_INTREGISTER,[RS_EAX,RS_EBX,RS_ECX,RS_EDX,RS_ESI,RS_EDI]);
|
||||
|
||||
{ save the old labels for control flow statements }
|
||||
oldCurrExitLabel:=current_procinfo.CurrExitLabel;
|
||||
if assigned(current_procinfo.CurrBreakLabel) then
|
||||
begin
|
||||
oldContinueLabel:=current_procinfo.CurrContinueLabel;
|
||||
oldBreakLabel:=current_procinfo.CurrBreakLabel;
|
||||
end;
|
||||
|
||||
{ get new labels for the control flow statements }
|
||||
current_asmdata.getjumplabel(exittrylabel);
|
||||
current_asmdata.getjumplabel(exitexceptlabel);
|
||||
if assigned(current_procinfo.CurrBreakLabel) then
|
||||
begin
|
||||
current_asmdata.getjumplabel(breaktrylabel);
|
||||
current_asmdata.getjumplabel(continuetrylabel);
|
||||
current_asmdata.getjumplabel(breakexceptlabel);
|
||||
current_asmdata.getjumplabel(continueexceptlabel);
|
||||
end;
|
||||
|
||||
current_asmdata.getjumplabel(exceptlabel);
|
||||
current_asmdata.getjumplabel(endexceptlabel);
|
||||
current_asmdata.getjumplabel(lastonlabel);
|
||||
filterlabel:=nil;
|
||||
|
||||
{ start of scope }
|
||||
if assigned(right) then
|
||||
begin
|
||||
current_asmdata.getdatalabel(filterlabel);
|
||||
emit_scope_start(
|
||||
current_asmdata.RefAsmSymbol('__FPC_on_handler'),
|
||||
filterlabel);
|
||||
end
|
||||
else
|
||||
emit_scope_start(
|
||||
current_asmdata.RefAsmSymbol('__FPC_except_handler'),
|
||||
exceptlabel);
|
||||
|
||||
{ set control flow labels for the try block }
|
||||
current_procinfo.CurrExitLabel:=exittrylabel;
|
||||
if assigned(oldBreakLabel) then
|
||||
begin
|
||||
current_procinfo.CurrContinueLabel:=continuetrylabel;
|
||||
current_procinfo.CurrBreakLabel:=breaktrylabel;
|
||||
end;
|
||||
|
||||
secondpass(left);
|
||||
tryflowcontrol:=flowcontrol;
|
||||
if codegenerror then
|
||||
goto errorexit;
|
||||
|
||||
emit_scope_end;
|
||||
{ jump over except handlers }
|
||||
cg.a_jmp_always(current_asmdata.CurrAsmList,endexceptlabel);
|
||||
|
||||
if fc_exit in tryflowcontrol then
|
||||
begin
|
||||
cg.a_label(current_asmdata.CurrAsmList,exittrylabel);
|
||||
emit_scope_end;
|
||||
cg.a_jmp_always(current_asmdata.CurrAsmList,oldCurrExitLabel);
|
||||
end;
|
||||
if fc_break in tryflowcontrol then
|
||||
begin
|
||||
cg.a_label(current_asmdata.CurrAsmList,breaktrylabel);
|
||||
emit_scope_end;
|
||||
cg.a_jmp_always(current_asmdata.CurrAsmList,oldBreakLabel);
|
||||
end;
|
||||
if fc_continue in tryflowcontrol then
|
||||
begin
|
||||
cg.a_label(current_asmdata.CurrAsmList,continuetrylabel);
|
||||
emit_scope_end;
|
||||
cg.a_jmp_always(current_asmdata.CurrAsmList,oldContinueLabel);
|
||||
end;
|
||||
|
||||
{ target for catch-all handler }
|
||||
cg.a_label(current_asmdata.CurrAsmList,exceptlabel);
|
||||
|
||||
{ set control flow labels for the except block }
|
||||
{ and the on statements }
|
||||
current_procinfo.CurrExitLabel:=exitexceptlabel;
|
||||
if assigned(oldBreakLabel) then
|
||||
begin
|
||||
current_procinfo.CurrContinueLabel:=continueexceptlabel;
|
||||
current_procinfo.CurrBreakLabel:=breakexceptlabel;
|
||||
end;
|
||||
|
||||
flowcontrol:=[fc_inflowcontrol];
|
||||
{ on statements }
|
||||
if assigned(right) then
|
||||
begin
|
||||
{ emit filter table to a temporary asmlist }
|
||||
hlist:=TAsmList.Create;
|
||||
new_section(hlist,sec_rodata,filterlabel.name,4);
|
||||
cg.a_label(hlist,filterlabel);
|
||||
onnodecount:=tai_const.create_32bit(0);
|
||||
hlist.concat(onnodecount);
|
||||
|
||||
hnode:=right;
|
||||
while assigned(hnode) do
|
||||
begin
|
||||
if hnode.nodetype<>onn then
|
||||
InternalError(2011103101);
|
||||
{ TODO: make it done without using global label }
|
||||
current_asmdata.getglobaljumplabel(onlabel);
|
||||
hlist.concat(tai_const.create_sym(current_asmdata.RefAsmSymbol(tonnode(hnode).excepttype.vmt_mangledname,AT_DATA)));
|
||||
hlist.concat(tai_const.create_sym(onlabel));
|
||||
cg.a_label(current_asmdata.CurrAsmList,onlabel);
|
||||
secondpass(hnode);
|
||||
inc(onnodecount.value);
|
||||
hnode:=tonnode(hnode).left;
|
||||
end;
|
||||
{ add 'else' node to the filter list, too }
|
||||
if assigned(t1) then
|
||||
begin
|
||||
hlist.concat(tai_const.create_32bit(-1));
|
||||
hlist.concat(tai_const.create_sym(lastonlabel));
|
||||
inc(onnodecount.value);
|
||||
end;
|
||||
{ now move filter table to permanent list all at once }
|
||||
maybe_new_object_file(current_asmdata.asmlists[al_typedconsts]);
|
||||
current_asmdata.asmlists[al_typedconsts].concatlist(hlist);
|
||||
hlist.free;
|
||||
end;
|
||||
|
||||
cg.a_label(current_asmdata.CurrAsmList,lastonlabel);
|
||||
if assigned(t1) then
|
||||
begin
|
||||
{ here we don't have to reset flowcontrol }
|
||||
{ the default and on flowcontrols are handled equal }
|
||||
secondpass(t1);
|
||||
cg.g_call(current_asmdata.CurrAsmList,'FPC_DONEEXCEPTION');
|
||||
if (flowcontrol*[fc_exit,fc_break,fc_continue]<>[]) then
|
||||
cg.a_jmp_always(current_asmdata.CurrAsmList,endexceptlabel);
|
||||
end;
|
||||
exceptflowcontrol:=flowcontrol;
|
||||
|
||||
if fc_exit in exceptflowcontrol then
|
||||
begin
|
||||
{ do some magic for exit in the try block }
|
||||
cg.a_label(current_asmdata.CurrAsmList,exitexceptlabel);
|
||||
cg.g_call(current_asmdata.CurrAsmList,'FPC_DONEEXCEPTION');
|
||||
cg.a_jmp_always(current_asmdata.CurrAsmList,oldCurrExitLabel);
|
||||
end;
|
||||
|
||||
if fc_break in exceptflowcontrol then
|
||||
begin
|
||||
cg.a_label(current_asmdata.CurrAsmList,breakexceptlabel);
|
||||
cg.g_call(current_asmdata.CurrAsmList,'FPC_DONEEXCEPTION');
|
||||
cg.a_jmp_always(current_asmdata.CurrAsmList,oldBreakLabel);
|
||||
end;
|
||||
|
||||
if fc_continue in exceptflowcontrol then
|
||||
begin
|
||||
cg.a_label(current_asmdata.CurrAsmList,continueexceptlabel);
|
||||
cg.g_call(current_asmdata.CurrAsmList,'FPC_DONEEXCEPTION');
|
||||
cg.a_jmp_always(current_asmdata.CurrAsmList,oldContinueLabel);
|
||||
end;
|
||||
|
||||
cg.a_label(current_asmdata.CurrAsmList,endexceptlabel);
|
||||
|
||||
errorexit:
|
||||
{ restore all saved labels }
|
||||
endexceptlabel:=oldendexceptlabel;
|
||||
|
||||
{ restore the control flow labels }
|
||||
current_procinfo.CurrExitLabel:=oldCurrExitLabel;
|
||||
if assigned(oldBreakLabel) then
|
||||
begin
|
||||
current_procinfo.CurrContinueLabel:=oldContinueLabel;
|
||||
current_procinfo.CurrBreakLabel:=oldBreakLabel;
|
||||
end;
|
||||
|
||||
{ return all used control flow statements }
|
||||
flowcontrol:=oldflowcontrol+(exceptflowcontrol +
|
||||
tryflowcontrol - [fc_inflowcontrol]);
|
||||
end;
|
||||
|
||||
initialization
|
||||
craisenode:=ti386raisenode;
|
||||
connode:=ti386onnode;
|
||||
ctryexceptnode:=ti386tryexceptnode;
|
||||
ctryfinallynode:=ti386tryfinallynode;
|
||||
end.
|
||||
@ -3449,6 +3449,11 @@ if (target_info.abi = abi_eabihf) then
|
||||
def_system_macro('FPC_USE_WIN64_SEH');
|
||||
{$endif DISABLE_WIN64_SEH}
|
||||
|
||||
{$ifdef TEST_WIN32_SEH}
|
||||
if target_info.system=system_i386_win32 then
|
||||
def_system_macro('FPC_USE_WIN32_SEH');
|
||||
{$endif TEST_WIN32_SEH}
|
||||
|
||||
{$ifdef ARM}
|
||||
{ define FPC_DOUBLE_HILO_SWAPPED if needed to properly handle doubles in RTL }
|
||||
if (init_settings.fputype in [fpu_fpa,fpu_fpa10,fpu_fpa11]) and
|
||||
|
||||
@ -2569,7 +2569,6 @@ unit cgx86;
|
||||
procedure tcgx86.g_proc_entry(list : TAsmList;localsize : longint;nostackframe:boolean);
|
||||
var
|
||||
stackmisalignment: longint;
|
||||
para: tparavarsym;
|
||||
regsize: longint;
|
||||
{$ifdef i8086}
|
||||
dgroup: treference;
|
||||
@ -2651,7 +2650,18 @@ unit cgx86;
|
||||
{ Return address and FP are both on stack }
|
||||
current_asmdata.asmcfi.cfa_def_cfa_offset(list,2*sizeof(pint));
|
||||
current_asmdata.asmcfi.cfa_offset(list,NR_FRAME_POINTER_REG,-(2*sizeof(pint)));
|
||||
list.concat(Taicpu.op_reg_reg(A_MOV,tcgsize2opsize[OS_ADDR],NR_STACK_POINTER_REG,NR_FRAME_POINTER_REG));
|
||||
if current_procinfo.procdef.proctypeoption<>potype_exceptfilter then
|
||||
list.concat(Taicpu.op_reg_reg(A_MOV,tcgsize2opsize[OS_ADDR],NR_STACK_POINTER_REG,NR_FRAME_POINTER_REG))
|
||||
else
|
||||
begin
|
||||
push_regs;
|
||||
gen_load_frame_for_exceptfilter(list);
|
||||
{ Need only as much stack space as necessary to do the calls.
|
||||
Exception filters don't have own local vars, and temps are 'mapped'
|
||||
to the parent procedure.
|
||||
maxpushedparasize is already aligned at least on x86_64. }
|
||||
//localsize:=current_procinfo.maxpushedparasize;
|
||||
end;
|
||||
current_asmdata.asmcfi.cfa_def_cfa_register(list,NR_FRAME_POINTER_REG);
|
||||
end;
|
||||
|
||||
@ -2672,7 +2682,8 @@ unit cgx86;
|
||||
|
||||
{$ifdef i386}
|
||||
if (not paramanager.use_fixed_stack) and
|
||||
(current_procinfo.framepointer<>NR_STACK_POINTER_REG) then
|
||||
(current_procinfo.framepointer<>NR_STACK_POINTER_REG) and
|
||||
(current_procinfo.procdef.proctypeoption<>potype_exceptfilter) then
|
||||
begin
|
||||
regsize:=0;
|
||||
push_regs;
|
||||
|
||||
@ -397,10 +397,12 @@ begin
|
||||
end;
|
||||
|
||||
|
||||
{$ifndef FPC_SYSTEM_HAS_DONEEXCEPTION}
|
||||
procedure fpc_doneexception;[public,alias:'FPC_DONEEXCEPTION'] compilerproc;
|
||||
begin
|
||||
Internal_PopObjectStack.Free;
|
||||
end;
|
||||
{$endif FPC_SYSTEM_HAS_DONEEXCEPTION}
|
||||
|
||||
procedure fpc_raise_nested;[public,alias:'FPC_RAISE_NESTED']compilerproc;
|
||||
begin
|
||||
@ -408,6 +410,7 @@ begin
|
||||
Internal_Reraise;
|
||||
end;
|
||||
|
||||
{$ifndef FPC_SYSTEM_HAS_SAFECALLHANDLER}
|
||||
function fpc_safecallhandler(obj: TObject): HResult; [public,alias:'FPC_SAFECALLHANDLER']; compilerproc;
|
||||
var
|
||||
raiselist: PExceptObject;
|
||||
@ -426,4 +429,5 @@ begin
|
||||
result:=E_UNEXPECTED;
|
||||
exc.Free;
|
||||
end;
|
||||
{$endif FPC_SYSTEM_HAS_SAFECALLHANDLER}
|
||||
|
||||
|
||||
@ -333,6 +333,10 @@
|
||||
refcount : Longint;
|
||||
Framecount : Longint;
|
||||
Frames : PCodePointer;
|
||||
{$ifdef FPC_USE_WIN32_SEH}
|
||||
SEHFrame : Pointer;
|
||||
ReraiseBuf : jmp_buf;
|
||||
{$endif FPC_USE_WIN32_SEH}
|
||||
end;
|
||||
|
||||
Const
|
||||
|
||||
@ -225,12 +225,12 @@ var
|
||||
{$ifdef DEBUG_MT}
|
||||
writeln('Jumping to thread function of thread ',Win32GetCurrentThreadId);
|
||||
{$endif DEBUG_MT}
|
||||
{$ifdef FPC_USE_WIN64_SEH}
|
||||
{$if defined(FPC_USE_WIN64_SEH) or defined(FPC_USE_WIN32_SEH)}
|
||||
{ use special 'top-level' exception handler around the thread function }
|
||||
ThreadMain:=main_wrapper(ti.p,pointer(ti.f));
|
||||
{$else FPC_USE_WIN64_SEH}
|
||||
ThreadMain:=ti.f(ti.p);
|
||||
{$endif FPC_USE_WIN64_SEH}
|
||||
{$endif FPC_USE_WIN64_SEH or FPC_USE_WIN32_SEH}
|
||||
end;
|
||||
|
||||
|
||||
|
||||
365
rtl/win32/seh32.inc
Normal file
365
rtl/win32/seh32.inc
Normal file
@ -0,0 +1,365 @@
|
||||
{
|
||||
This file is part of the Free Pascal run time library.
|
||||
Copyright (c) 2013 by Free Pascal development team
|
||||
|
||||
Support for 32-bit Windows exception handling
|
||||
|
||||
See the file COPYING.FPC, included in this distribution,
|
||||
for details about the copyright.
|
||||
|
||||
This program is distributed in the hope that it will be useful,
|
||||
but WITHOUT ANY WARRANTY; without even the implied warranty of
|
||||
MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.
|
||||
|
||||
**********************************************************************}
|
||||
|
||||
const
|
||||
EXCEPTION_UNWIND = EXCEPTION_UNWINDING or EXCEPTION_EXIT_UNWIND;
|
||||
|
||||
type
|
||||
TDispatcherContext=record
|
||||
end;
|
||||
|
||||
PSEHFrame=^TSEHFrame;
|
||||
TSEHFrame=record
|
||||
Next: PSEHFrame;
|
||||
Addr: Pointer;
|
||||
_EBP: PtrUint;
|
||||
HandlerArg: Pointer;
|
||||
end;
|
||||
|
||||
|
||||
procedure RtlUnwind(
|
||||
TargetFrame: Pointer;
|
||||
TargetIp: Pointer;
|
||||
ExceptionRecord: PExceptionRecord;
|
||||
ReturnValue: Pointer);
|
||||
stdcall; external 'kernel32.dll' name 'RtlUnwind';
|
||||
|
||||
{$ifdef FPC_USE_WIN32_SEH}
|
||||
function NullHandler(
|
||||
var rec: TExceptionRecord;
|
||||
var frame: TSEHFrame;
|
||||
var context: TContext;
|
||||
var dispatch: TDispatcherContext): EXCEPTION_DISPOSITION; cdecl;
|
||||
begin
|
||||
result:=ExceptionContinueSearch;
|
||||
end;
|
||||
|
||||
|
||||
function GetBacktrace(Context: TContext; StartingFrame: Pointer; out Frames: PPointer): Longint;
|
||||
begin
|
||||
// TODO
|
||||
Frames:=nil;
|
||||
result:=0;
|
||||
end;
|
||||
|
||||
|
||||
function fpc_RaiseException(Obj: TObject; AnAddr,AFrame: Pointer): TObject; [public,alias: 'FPC_RAISEEXCEPTION']; compilerproc;
|
||||
var
|
||||
ctx: TContext;
|
||||
args: array[0..3] of PtrUint;
|
||||
begin
|
||||
//RtlCaptureContext(ctx);
|
||||
args[0]:=PtrUint(AnAddr);
|
||||
args[1]:=PtrUint(Obj);
|
||||
args[2]:=GetBacktrace(ctx,AFrame,PPointer(args[3]));
|
||||
RaiseException(FPC_EXCEPTION_CODE,EXCEPTION_NONCONTINUABLE,4,@args[0]);
|
||||
result:=nil;
|
||||
end;
|
||||
|
||||
|
||||
procedure fpc_reraise; [public,alias:'FPC_RERAISE']; compilerproc;
|
||||
var
|
||||
hp: PExceptObject;
|
||||
begin
|
||||
hp:=ExceptObjectStack;
|
||||
ExceptObjectStack:=hp^.next;
|
||||
TSEHFrame(hp^.SEHFrame^).Addr:=@NullHandler;
|
||||
longjmp(hp^.ReraiseBuf,1);
|
||||
end;
|
||||
|
||||
|
||||
{ Parameters are dummy and used to force "ret 16" at the end;
|
||||
this removes a TSEHFrame record from the stack }
|
||||
procedure _fpc_leave(a1,a2,a3,a4:pointer); [public,alias:'_FPC_leave']; stdcall; compilerproc; assembler; nostackframe;
|
||||
asm
|
||||
movl 4(%esp),%eax
|
||||
movl %eax,%fs:(0)
|
||||
movl %ebp,%eax
|
||||
call 16(%esp)
|
||||
end;
|
||||
|
||||
|
||||
function PopObjectStack: PExceptObject;
|
||||
var
|
||||
hp: PExceptObject;
|
||||
begin
|
||||
hp:=ExceptObjectStack;
|
||||
if hp=nil then
|
||||
halt(255)
|
||||
else
|
||||
begin
|
||||
ExceptObjectStack:=hp^.next;
|
||||
if assigned(hp^.frames) then
|
||||
freemem(hp^.frames);
|
||||
end;
|
||||
result:=hp;
|
||||
end;
|
||||
|
||||
|
||||
function __FPC_finally_handler(
|
||||
var rec: TExceptionRecord;
|
||||
var frame: TSEHFrame;
|
||||
var context: TContext;
|
||||
var dispatch: TDispatcherContext): EXCEPTION_DISPOSITION; cdecl; [public,alias:'__FPC_finally_handler'];
|
||||
begin
|
||||
if (rec.ExceptionFlags and EXCEPTION_UNWIND)<>0 then
|
||||
begin
|
||||
{ prevent endless loop if things go bad in user routine }
|
||||
frame.Addr:=@NullHandler;
|
||||
TUnwindProc(frame.HandlerArg)(frame._EBP);
|
||||
end;
|
||||
result:=ExceptionContinueSearch;
|
||||
end;
|
||||
|
||||
|
||||
function __FPC_default_handler(
|
||||
var rec: TExceptionRecord;
|
||||
var frame: TSEHFrame;
|
||||
var context: TContext;
|
||||
var dispatch: TDispatcherContext): EXCEPTION_DISPOSITION; cdecl; [public,alias:'__FPC_DEFAULT_HANDLER'];
|
||||
var
|
||||
code: longint;
|
||||
Obj: TObject;
|
||||
Adr: Pointer;
|
||||
begin
|
||||
if (rec.ExceptionFlags and EXCEPTION_UNWIND)=0 then
|
||||
begin
|
||||
RtlUnwind(@frame,nil,@rec,nil);
|
||||
if rec.ExceptionCode<>FPC_EXCEPTION_CODE then
|
||||
begin
|
||||
code:=RunErrorCode(rec);
|
||||
if code<0 then
|
||||
SysResetFPU;
|
||||
Adr:=rec.ExceptionAddress;
|
||||
Obj:=nil;
|
||||
if Assigned(ExceptObjProc) then
|
||||
Obj:=TObject(TExceptObjProc(ExceptObjProc)(abs(code),rec));
|
||||
if Obj=nil then
|
||||
RunError(abs(code));
|
||||
end
|
||||
else
|
||||
begin
|
||||
Obj:=TObject(rec.ExceptionInformation[1]);
|
||||
Adr:=rec.ExceptionInformation[0];
|
||||
code:=217;
|
||||
end;
|
||||
if Assigned(ExceptProc) then
|
||||
begin
|
||||
ExceptProc(Obj,Adr,0,nil {TODO: backtrace});
|
||||
Halt(217);
|
||||
end
|
||||
else
|
||||
RunError(abs(code));
|
||||
end;
|
||||
result:=ExceptionContinueExecution;
|
||||
end;
|
||||
|
||||
|
||||
function NestedHandler(
|
||||
var rec: TExceptionRecord;
|
||||
var frame: TSEHFrame;
|
||||
var context: TContext;
|
||||
var dispatch: TDispatcherContext): EXCEPTION_DISPOSITION; cdecl;
|
||||
var
|
||||
hp: PExceptObject;
|
||||
begin
|
||||
if (rec.ExceptionFlags and EXCEPTION_UNWIND)<>0 then
|
||||
begin
|
||||
hp:=PopObjectStack;
|
||||
if hp^.refcount=0 then
|
||||
hp^.FObject.Free;
|
||||
end;
|
||||
result:=ExceptionContinueSearch;
|
||||
end;
|
||||
|
||||
function __FPC_except_safecall(
|
||||
var rec: TExceptionRecord;
|
||||
var frame: TSEHFrame;
|
||||
var context: TContext;
|
||||
var dispatch: TDispatcherContext): EXCEPTION_DISPOSITION; cdecl; forward;
|
||||
|
||||
procedure CommonHandler(
|
||||
var rec: TExceptionRecord;
|
||||
var frame: TSEHFrame;
|
||||
var context: TContext;
|
||||
TargetAddr: Pointer);
|
||||
var
|
||||
Exc: TExceptObject;
|
||||
code: Longint;
|
||||
begin
|
||||
if rec.ExceptionCode<>FPC_EXCEPTION_CODE then
|
||||
begin
|
||||
Exc.FObject:=nil;
|
||||
code:=RunErrorCode(rec);
|
||||
if Assigned(ExceptObjProc) then
|
||||
Exc.FObject:=TObject(TExceptObjProc(ExceptObjProc)(abs(code),rec));
|
||||
if (Exc.FObject=nil) and (frame.Addr<>Pointer(@__FPC_except_safecall)) then
|
||||
Exit;
|
||||
Exc.Addr:=rec.ExceptionAddress;
|
||||
Exc.FrameCount:=GetBacktrace(context,nil,Exc.Frames);
|
||||
if code<0 then
|
||||
SysResetFPU;
|
||||
end
|
||||
else
|
||||
begin
|
||||
Exc.Addr:=rec.ExceptionInformation[0];
|
||||
Exc.FObject:=TObject(rec.ExceptionInformation[1]);
|
||||
Exc.Framecount:=Longint(PtrUInt(rec.ExceptionInformation[2]));
|
||||
Exc.Frames:=rec.ExceptionInformation[3];
|
||||
end;
|
||||
|
||||
RtlUnwind(@frame,nil,@rec,nil);
|
||||
|
||||
Exc.Refcount:=0;
|
||||
Exc.SEHFrame:=@frame;
|
||||
{ link to ExceptObjectStack }
|
||||
Exc.Next:=ExceptObjectStack;
|
||||
ExceptObjectStack:=@Exc;
|
||||
|
||||
frame.Addr:=@NestedHandler;
|
||||
if setjmp(Exc.ReraiseBuf)=0 then
|
||||
asm
|
||||
movl Exc.FObject,%eax
|
||||
movl frame,%edx
|
||||
movl TargetAddr,%ecx // load ebp-based var before changing ebp
|
||||
movl TSEHFrame._EBP(%edx),%ebp
|
||||
jmpl *%ecx
|
||||
end;
|
||||
{ control comes here if exception is re-raised }
|
||||
rec.ExceptionFlags:=rec.ExceptionFlags and (not EXCEPTION_UNWINDING);
|
||||
end;
|
||||
|
||||
|
||||
function __FPC_except_handler(
|
||||
var rec: TExceptionRecord;
|
||||
var frame: TSEHFrame;
|
||||
var context: TContext;
|
||||
var dispatch: TDispatcherContext): EXCEPTION_DISPOSITION; cdecl; [public,alias:'__FPC_except_handler'];
|
||||
begin
|
||||
if (rec.ExceptionFlags and EXCEPTION_UNWIND)=0 then
|
||||
begin
|
||||
{ Athlon prefetch bug? }
|
||||
if (rec.ExceptionCode=STATUS_ACCESS_VIOLATION) and
|
||||
is_prefetch(pointer(Context.eip)) then
|
||||
begin
|
||||
result:=ExceptionContinueExecution;
|
||||
exit;
|
||||
end;
|
||||
CommonHandler(rec,frame,context,frame.HandlerArg);
|
||||
end;
|
||||
result:=ExceptionContinueSearch;
|
||||
end;
|
||||
|
||||
{ Safecall procedures are expected to handle OS exceptions even if they cannot be
|
||||
converted to language exceptions. This is indicated by distinct handler address. }
|
||||
function __FPC_except_safecall(
|
||||
var rec: TExceptionRecord;
|
||||
var frame: TSEHFrame;
|
||||
var context: TContext;
|
||||
var dispatch: TDispatcherContext): EXCEPTION_DISPOSITION; cdecl; [public,alias:'__FPC_except_safecall']; assembler; nostackframe;
|
||||
asm
|
||||
jmp __FPC_except_handler
|
||||
end;
|
||||
|
||||
|
||||
function __FPC_on_handler(
|
||||
var rec: TExceptionRecord;
|
||||
var frame: TSEHFrame;
|
||||
var context: TContext;
|
||||
var dispatch: TDispatcherContext): EXCEPTION_DISPOSITION; cdecl; [public,alias:'__FPC_on_handler'];
|
||||
var
|
||||
TargetAddr: Pointer;
|
||||
begin
|
||||
if (rec.ExceptionFlags and EXCEPTION_UNWIND)=0 then
|
||||
begin
|
||||
{ Athlon prefetch bug? }
|
||||
if (rec.ExceptionCode=STATUS_ACCESS_VIOLATION) and
|
||||
is_prefetch(pointer(Context.eip)) then
|
||||
begin
|
||||
result:=ExceptionContinueExecution;
|
||||
exit;
|
||||
end;
|
||||
{ Are we going to catch it? }
|
||||
TargetAddr:=FilterException(rec,0,PtrUInt(frame.HandlerArg));
|
||||
if assigned(TargetAddr) then
|
||||
CommonHandler(rec,frame,context,TargetAddr);
|
||||
end;
|
||||
result:=ExceptionContinueSearch;
|
||||
end;
|
||||
|
||||
|
||||
function fpc_safecallhandler(obj: TObject): HResult; [public,alias:'FPC_SAFECALLHANDLER']; compilerproc;
|
||||
var
|
||||
hp: PExceptObject;
|
||||
exc: TObject;
|
||||
begin
|
||||
hp:=PopObjectStack;
|
||||
exc:=hp^.FObject;
|
||||
if Assigned(obj) and Assigned(exc) then
|
||||
result:=obj.SafeCallException(exc,hp^.Addr)
|
||||
else
|
||||
result:=E_UNEXPECTED;
|
||||
if hp^.refcount=0 then
|
||||
exc.Free;
|
||||
asm
|
||||
movl %ebp,%edx // save current frame
|
||||
movl hp,%ecx
|
||||
movl TExceptObject.SEHFrame(%ecx),%ecx // target ESP minus sizeof(TSEHFrame)
|
||||
movl (%ecx),%eax
|
||||
movl %eax,%fs:(0) // restore SEH chain
|
||||
movl __RESULT,%eax
|
||||
movl TSEHFrame._EBP(%ecx),%ebp // restore EBP
|
||||
leal 16(%ecx),%esp // restore ESP past the SEH frame
|
||||
jmpl 4(%edx) // jump to caller
|
||||
end;
|
||||
end;
|
||||
|
||||
|
||||
procedure fpc_doneexception;[public,alias:'FPC_DONEEXCEPTION'] compilerproc;
|
||||
var
|
||||
hp: PExceptObject;
|
||||
begin
|
||||
hp:=PopObjectStack;
|
||||
if hp^.refcount=0 then
|
||||
hp^.FObject.Free;
|
||||
erroraddr:=nil;
|
||||
asm
|
||||
movl %ebp,%edx // save current frame
|
||||
movl hp,%eax
|
||||
movl TExceptObject.SEHFrame(%eax),%eax // target ESP minus sizeof(TSEHFrame)
|
||||
movl (%eax),%ecx
|
||||
movl %ecx,%fs:(0) // restore SEH chain
|
||||
movl TSEHFrame._EBP(%eax),%ebp // restore EBP
|
||||
leal 16(%eax),%esp // restore ESP, removing SEH frame
|
||||
jmpl 4(%edx) // jump to caller
|
||||
end;
|
||||
end;
|
||||
|
||||
|
||||
function main_wrapper(arg: Pointer; proc: Pointer): ptrint; assembler; nostackframe;
|
||||
asm
|
||||
xorl %ecx,%ecx
|
||||
pushl $__FPC_default_handler
|
||||
pushl %fs:(%ecx)
|
||||
movl %esp,%fs:(%ecx)
|
||||
call *%edx
|
||||
xorl %ecx,%ecx
|
||||
popl %edx
|
||||
movl %edx,%fs:(%ecx)
|
||||
popl %ecx
|
||||
end;
|
||||
|
||||
{$endif FPC_USE_WIN32_SEH}
|
||||
|
||||
@ -29,6 +29,13 @@ interface
|
||||
{$define DISABLE_NO_THREAD_MANAGER}
|
||||
{$define HAS_WIDESTRINGMANAGER}
|
||||
|
||||
{$ifdef FPC_USE_WIN32_SEH}
|
||||
{$define FPC_SYSTEM_HAS_RAISEEXCEPTION}
|
||||
{$define FPC_SYSTEM_HAS_RERAISE}
|
||||
{$define FPC_SYSTEM_HAS_DONEEXCEPTION}
|
||||
{$define FPC_SYSTEM_HAS_SAFECALLHANDLER}
|
||||
{$endif FPC_USE_WIN32_SEH}
|
||||
|
||||
{ include system-independent routine headers }
|
||||
{$I systemh.inc}
|
||||
|
||||
@ -138,6 +145,11 @@ const
|
||||
valgrind_used : false;
|
||||
);
|
||||
|
||||
{$ifdef FPC_USE_WIN32_SEH}
|
||||
function main_wrapper(arg: Pointer; proc: Pointer): ptrint; forward;
|
||||
procedure OutermostHandler; external name '__FPC_DEFAULT_HANDLER';
|
||||
{$endif FPC_USE_WIN32_SEH}
|
||||
|
||||
{ include system independent routines }
|
||||
{$I system.inc}
|
||||
|
||||
@ -177,8 +189,10 @@ begin
|
||||
{ what about Input and Output ?? PM }
|
||||
{ now handled, FPK }
|
||||
end;
|
||||
{$ifndef FPC_USE_WIN32_SEH}
|
||||
if not IsLibrary then
|
||||
remove_exception_handlers;
|
||||
{$endif FPC_USE_WIN32_SEH}
|
||||
|
||||
{ do cleanup required by the startup code }
|
||||
EntryInformation.asm_exit();
|
||||
@ -194,24 +208,30 @@ var
|
||||
|
||||
procedure Exe_entry(const info : TEntryInformation);[public,alias:'_FPC_EXE_Entry'];
|
||||
var
|
||||
ST : pointer;
|
||||
xframe: TEXCEPTION_FRAME;
|
||||
begin
|
||||
EntryInformation:=info;
|
||||
IsLibrary:=false;
|
||||
{ install the handlers for exe only ?
|
||||
or should we install them for DLL also ? (PM) }
|
||||
{$ifndef FPC_USE_WIN32_SEH}
|
||||
install_exception_handlers;
|
||||
{$endif FPC_USE_WIN32_SEH}
|
||||
{ This strange construction is needed to solve the _SS problem
|
||||
with a smartlinked syswin32 (PFV) }
|
||||
asm
|
||||
{ allocate space for an exception frame }
|
||||
pushl $0
|
||||
pushl %fs:(0)
|
||||
{ movl %esp,%fs:(0)
|
||||
but don't insert it as it doesn't
|
||||
point to anything yet
|
||||
this will be used in signals unit }
|
||||
movl %esp,%eax
|
||||
leal xframe,%eax
|
||||
{$ifndef FPC_USE_WIN32_SEH}
|
||||
movl $0,TException_Frame.handler(%eax)
|
||||
{$else}
|
||||
movl $OutermostHandler,TException_Frame.handler(%eax)
|
||||
{$endif FPC_USE_WIN32_SEH}
|
||||
movl %fs:(0),%ecx
|
||||
movl %ecx,TException_Frame.next(%eax)
|
||||
movl %eax,System_exception_frame
|
||||
pushl %ebp
|
||||
xorl %eax,%eax
|
||||
@ -348,6 +368,8 @@ type
|
||||
{ type of functions that should be used for exception handling }
|
||||
TTopLevelExceptionFilter = function (excep : PExceptionPointers) : Longint;stdcall;
|
||||
|
||||
{$i seh32.inc}
|
||||
|
||||
function SetUnhandledExceptionFilter(lpTopLevelExceptionFilter : TTopLevelExceptionFilter) : TTopLevelExceptionFilter;
|
||||
stdcall;external 'kernel32' name 'SetUnhandledExceptionFilter';
|
||||
|
||||
|
||||
Loading…
Reference in New Issue
Block a user