paweld/fpc
1
0
Fork 0
mirror of https://gitlab.com/freepascal.org/fpc/source.git synced 2025-04-19 20:39:25 +02:00
Code Issues Packages Projects Releases Wiki Activity

+ initial implementation of dwarf/eh_frame based exception handling for i386-linux, basic stuff works, open todos

Browse Source 
* nested exception handling statments in one procedure need to be fixed
  * clean up, finally factor out tcgprocinfo from psub at least
  * extensive testing

git-svn-id: branches/debug_eh@41289 -
This commit is contained in:
florian 2019-02-10 18:07:33 +00:00
parent 501b384b17
commit 65aebd22b0
4 changed files with 571 additions and 92 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

214
compiler/cfidwarf.pas
View File

@ -23,6 +23,8 @@ unit cfidwarf;
{$i fpcdefs.inc}
{ $define debug_eh}
interface
uses
@ -54,6 +56,7 @@ interface
constructor create(aop:byte);
constructor create_reg(aop:byte;enc1:tdwarfoperenc;reg:tregister);
constructor create_const(aop:byte;enc1:tdwarfoperenc;val:int64);
constructor create_sym(aop: byte; enc1: tdwarfoperenc; sym: TAsmSymbol);
constructor create_reloffset(aop:byte;enc1:tdwarfoperenc;beginlab,endlab:tasmsymbol);
constructor create_reg_const(aop:byte;enc1:tdwarfoperenc;reg:tregister;enc2:tdwarfoperenc;val:longint);
procedure generate_code(list:TAsmList);
@ -72,12 +75,18 @@ interface
data_alignment_factor : shortint;
property DwarfList:TlinkedList read FDwarfList;
public
LSDALabel : TAsmLabel;
use_eh_frame : boolean;
constructor create;override;
destructor destroy;override;
procedure generate_code(list:TAsmList);override;
function get_frame_start: TAsmLabel;
{ operations }
procedure start_frame(list:TAsmList);override;
procedure end_frame(list:TAsmList);override;
procedure outmost_frame(list: TAsmList);override;
procedure cfa_offset(list:TAsmList;reg:tregister;ofs:longint);override;
procedure cfa_restore(list:TAsmList;reg:tregister);override;
procedure cfa_def_cfa_register(list:TAsmList;reg:tregister);override;
@ -89,43 +98,9 @@ implementation
uses
systems,
verbose;
const
{ Call frame information }
DW_CFA_set_loc = $01;
DW_CFA_advance_loc1 = $02;
DW_CFA_advance_loc2 = $03;
DW_CFA_advance_loc4 = $04;
DW_CFA_offset_extended = $05;
DW_CFA_restore_extended = $06;
DW_CFA_def_cfa = $0c;
DW_CFA_def_cfa_register = $0d;
DW_CFA_def_cfa_offset = $0e;
{ Own additions }
DW_CFA_start_frame = $f0;
DW_CFA_end_frame = $f1;
DW_LNS_copy = $01;
DW_LNS_advance_pc = $02;
DW_LNS_advance_line = $03;
DW_LNS_set_file = $04;
DW_LNS_set_column = $05;
DW_LNS_negate_stmt = $06;
DW_LNS_set_basic_block = $07;
DW_LNS_const_add_pc = $08;
DW_LNS_fixed_advance_pc = $09;
DW_LNS_set_prologue_end = $0a;
DW_LNS_set_epilogue_begin = $0b;
DW_LNS_set_isa = $0c;
DW_LNE_end_sequence = $01;
DW_LNE_set_address = $02;
DW_LNE_define_file = $03;
DW_LNE_lo_user = $80;
DW_LNE_hi_user = $ff;
cutils,
verbose,
dwarfbase;
{****************************************************************************
TDWARFITEM
@ -161,6 +136,17 @@ implementation
end;
constructor tdwarfitem.create_sym(aop:byte;enc1:tdwarfoperenc;sym:TAsmSymbol);
begin
inherited create;
op:=aop;
ops:=1;
oper[0].typ:=dop_sym;
oper[0].enc:=enc1;
oper[0].sym:=sym;
end;
constructor tdwarfitem.create_reloffset(aop:byte;enc1:tdwarfoperenc;beginlab,endlab:tasmsymbol);
begin
inherited create;
@ -233,6 +219,8 @@ implementation
code_alignment_factor:=1;
data_alignment_factor:=-4;
FDwarfList:=TLinkedList.Create;
if tf_use_psabieh in target_info.flags then
use_eh_frame:=true;
end;
@ -269,21 +257,43 @@ implementation
procedure TDwarfAsmCFI.generate_code(list:TAsmList);
var
hp : tdwarfitem;
CurrentLSDALabel,
cielabel,
lenstartlabel,
lenendlabel : tasmlabel;
lenendlabel,
augendlabel,
augstartlabel,
fdeofslabel, curpos: tasmlabel;
tc : tai_const;
begin
new_section(list,sec_debug_frame,'',0);
{ CIE
DWORD length
DWORD CIE_Id = 0xffffffff
BYTE version = 1
STRING augmentation = "" = BYTE 0
ULEB128 code alignment factor = 1
ULEB128 data alignment factor = -1
BYTE return address register
<...> start sequence
CurrentLSDALabel:=nil;
if use_eh_frame then
new_section(list,sec_eh_frame,'',0)
else
new_section(list,sec_debug_frame,'',0);
{ debug_frame:
CIE
DWORD length
DWORD CIE_Id = 0xffffffff
BYTE version = 1
STRING augmentation = "" = BYTE 0
ULEB128 code alignment factor = 1
ULEB128 data alignment factor = -1
BYTE return address register
<...> augmentation
<...> start sequence
eh_frame:
CIE
DWORD length
DWORD CIE_Id = 0
BYTE version = 1
STRING augmentation = 'zPLR'#0
ULEB128 code alignment factor = 1
ULEB128 data alignment factor = -1
BYTE return address register
<...> start sequence
}
current_asmdata.getlabel(cielabel,alt_dbgframe);
list.concat(tai_label.create(cielabel));
@ -291,12 +301,47 @@ implementation
current_asmdata.getlabel(lenendlabel,alt_dbgframe);
list.concat(tai_const.create_rel_sym(aitconst_32bit,lenstartlabel,lenendlabel));
list.concat(tai_label.create(lenstartlabel));
list.concat(tai_const.create_32bit(longint($ffffffff)));
list.concat(tai_const.create_8bit(1));
list.concat(tai_const.create_8bit(0)); { empty string }
if use_eh_frame then
begin
list.concat(tai_const.create_32bit(0));
list.concat(tai_const.create_8bit(1));
list.concat(tai_const.create_8bit(ord('z')));
list.concat(tai_const.create_8bit(ord('P')));
list.concat(tai_const.create_8bit(ord('L')));
list.concat(tai_const.create_8bit(ord('R')));
list.concat(tai_const.create_8bit(0));
end
else
begin
list.concat(tai_const.create_32bit(longint($ffffffff)));
list.concat(tai_const.create_8bit(1));
list.concat(tai_const.create_8bit(0)); { empty string }
end;
list.concat(tai_const.create_uleb128bit(code_alignment_factor));
list.concat(tai_const.create_sleb128bit(data_alignment_factor));
list.concat(tai_const.create_8bit(dwarf_reg(NR_RETURN_ADDRESS_REG)));
{ augmentation data }
if use_eh_frame then
begin
current_asmdata.getlabel(augstartlabel,alt_dbgframe);
current_asmdata.getlabel(augendlabel,alt_dbgframe);
{ size of augmentation data ('z') }
list.concat(tai_const.create_rel_sym(aitconst_uleb128bit,augstartlabel,augendlabel));
list.concat(tai_label.create(augstartlabel));
{ personality function ('P') }
{ encoding }
list.concat(tai_const.create_8bit({DW_EH_PE_indirect or DW_EH_PE_pcrel or} DW_EH_PE_sdata4));
{ address of personality function }
list.concat(tai_const.Createname('_fpc_psabieh_personality_v0',AT_FUNCTION,0));
{ LSDA encoding ('L')}
list.concat(tai_const.create_8bit({DW_EH_PE_pcrel or }DW_EH_PE_sdata4));
{ FDE encoding ('R') }
list.concat(tai_const.create_8bit({DW_EH_PE_pcrel or }DW_EH_PE_sdata4));
list.concat(tai_label.create(augendlabel));
end;
{ Generate standard code
def_cfa(stackpointer,sizeof(aint))
cfa_offset_extended(returnaddres,-sizeof(aint))
@ -329,13 +374,40 @@ implementation
}
list.concat(tai_const.create_rel_sym(aitconst_32bit,lenstartlabel,lenendlabel));
list.concat(tai_label.create(lenstartlabel));
tc:=tai_const.create_sym(cielabel);
{ force label offset to secrel32 for windows systems }
if (target_info.system in systems_windows+systems_wince) then
tc.consttype:=aitconst_secrel32_symbol;
list.concat(tc);
list.concat(tai_const.create_sym(hp.oper[0].beginsym));
if use_eh_frame then
begin
{ relative offset to the CIE }
current_asmdata.getlabel(fdeofslabel,alt_dbgframe);
list.concat(tai_label.create(fdeofslabel));
list.concat(tai_const.create_rel_sym(aitconst_32bit,cielabel,fdeofslabel));
end
else
begin
tc:=tai_const.create_sym(cielabel);
{ force label offset to secrel32 for windows systems }
if (target_info.system in systems_windows+systems_wince) then
tc.consttype:=aitconst_secrel32_symbol;
list.concat(tc);
end;
current_asmdata.getlabel(curpos,alt_dbgframe);
list.concat(tai_label.create(curpos));
list.concat(tai_const.Create_sym(hp.oper[0].beginsym));
list.concat(tai_const.create_rel_sym(aitconst_ptr,hp.oper[0].beginsym,hp.oper[0].endsym));
{ we wrote a 'z' into the CIE augmentation data }
if use_eh_frame then
begin
{ size of augmentation }
list.concat(tai_const.create_8bit(4));
{$ifdef debug_eh}
list.concat(tai_comment.Create(strpnew('LSDA')));
{$endif debug_eh}
{ address of LSDA}
list.concat(tai_const.Create_sym(CurrentLSDALabel));
{ do not reuse LSDA label }
CurrentLSDALabel:=nil;
end;
end;
DW_CFA_End_Frame :
begin
@ -344,6 +416,8 @@ implementation
lenstartlabel:=nil;
lenendlabel:=nil;
end;
DW_Set_LSDALabel:
CurrentLSDALabel:=hp.oper[0].sym as TAsmLabel;
else
hp.generate_code(list);
end;
@ -359,13 +433,27 @@ implementation
procedure TDwarfAsmCFI.start_frame(list:TAsmList);
begin
if assigned(FFrameStartLabel) then
internalerror(200404129);
current_asmdata.getlabel(FFrameStartLabel,alt_dbgframe);
current_asmdata.getlabel(FFrameEndLabel,alt_dbgframe);
FLastloclabel:=FFrameStartLabel;
list.concat(tai_label.create(FFrameStartLabel));
DwarfList.concat(tdwarfitem.create_reloffset(DW_CFA_start_frame,doe_32bit,FFrameStartLabel,FFrameEndLabel));
FLastloclabel:=get_frame_start;
list.concat(tai_label.create(get_frame_start));
if assigned(LSDALabel) then
DwarfList.concat(tdwarfitem.create_sym(DW_Set_LSDALabel,doe_32bit,LSDALabel));
DwarfList.concat(tdwarfitem.create_reloffset(DW_CFA_start_frame,doe_32bit,get_frame_start,FFrameEndLabel));
end;
function TDwarfAsmCFI.get_frame_start : TAsmLabel;
begin
if not(assigned(FFrameStartLabel)) then
current_asmdata.getlabel(FFrameStartLabel,alt_dbgframe);
Result:=FFrameStartLabel;
end;
procedure TDwarfAsmCFI.outmost_frame(list: TAsmList);
begin
cfa_advance_loc(list);
DwarfList.concat(tdwarfitem.create_reg(DW_CFA_undefined,doe_uleb,NR_RETURN_ADDRESS_REG));
end;

14
compiler/llvm/nllvmflw.pas
View File

@ -53,7 +53,6 @@ interface
protected
class procedure begin_catch_internal(list: TAsmList; excepttype: tobjectdef; nextonlabel: tasmlabel; add_catch: boolean; out exceptlocdef: tdef; out exceptlocreg: tregister);
class procedure catch_all_start_internal(list: TAsmList; add_catch: boolean);
class function use_cleanup(const exceptframekind: texceptframekind): boolean;
end;
tllvmtryexceptnode = class(tcgtryexceptnode)
@ -397,19 +396,6 @@ implementation
begin_catch_internal(list,nil,nil,add_catch,exceptlocdef,exceptlocreg);
end;
class function tllvmexceptionstatehandler.use_cleanup(const exceptframekind: texceptframekind): boolean;
begin
{ in case of an exception caught by the implicit exception frame of
a safecall routine, this is not a cleanup frame but one that
catches the exception and returns a value from the function }
result:=
(exceptframekind=tek_implicitfinally) and
not((tf_safecall_exceptions in target_info.flags) and
(current_procinfo.procdef.proccalloption=pocall_safecall));
end;
{*****************************************************************************
tllvmexceptionstatehandler
*****************************************************************************}

302
compiler/ncgflw.pas
View File

@ -86,6 +86,9 @@ interface
jmpbuf,
envbuf,
reasonbuf : treference;
{ when using dwarf based eh handling, the landing pads get the unwind info passed, it is
stored in the given register so it can be passed to unwind_resum }
unwind_info : TRegister;
end;
texceptionstate = record
@ -101,12 +104,12 @@ interface
class procedure unget_exception_temps(list:TAsmList;const t:texceptiontemps); virtual;
class procedure new_exception(list:TAsmList;const t:texceptiontemps; const exceptframekind: texceptframekind; out exceptstate: texceptionstate); virtual;
{ start of "except/finally" block }
class procedure emit_except_label(list: TAsmList; exceptframekind: texceptframekind; var exceptstate: texceptionstate); virtual;
class procedure emit_except_label(list: TAsmList; exceptframekind: texceptframekind; var exceptstate: texceptionstate;var exceptiontemps:texceptiontemps); virtual;
{ end of a try-block, label comes after the end of try/except or
try/finally }
class procedure end_try_block(list: TAsmList; exceptframekind: texceptframekind; const t: texceptiontemps; var exceptionstate: texceptionstate; endlabel: TAsmLabel); virtual;
class procedure free_exception(list: TAsmList; const t: texceptiontemps; const s: texceptionstate; a: aint; endexceptlabel: tasmlabel; onlyfree:boolean); virtual;
class procedure handle_nested_exception(list:TAsmList;const t:texceptiontemps;var entrystate: texceptionstate); virtual;
class procedure handle_nested_exception(list:TAsmList;var t:texceptiontemps;var entrystate: texceptionstate); virtual;
class procedure handle_reraise(list:TAsmList;const t:texceptiontemps;const entrystate: texceptionstate; const exceptframekind: texceptframekind); virtual;
{ start of an "on" (catch) block }
class procedure begin_catch(list: TAsmList; excepttype: tobjectdef; nextonlabel: tasmlabel; out exceptlocdef: tdef; out exceptlocreg: tregister); virtual;
@ -117,9 +120,41 @@ interface
class procedure catch_all_end(list: TAsmList); virtual;
class procedure cleanupobjectstack(list: TAsmList); virtual;
class procedure popaddrstack(list: TAsmList); virtual;
class function use_cleanup(const exceptframekind: texceptframekind): boolean;
end;
tcgexceptionstatehandlerclass = class of tcgexceptionstatehandler;
{ Utility class for exception handling state management that is used
by tryexcept/tryfinally/on nodes (in a separate class so it can both
be shared and overridden)
Never instantiated. }
tpsabiehexceptionstatehandler = class(tcgexceptionstatehandler)
protected
class procedure begin_catch_internal(list: TAsmList; excepttype: tobjectdef; nextonlabel: tasmlabel; add_catch: boolean; out exceptlocdef: tdef; out
exceptlocreg: tregister);
class procedure catch_all_start_internal(list: TAsmList; add_catch: boolean);
public
class procedure get_exception_temps(list:TAsmList;var t:texceptiontemps); override;
class procedure unget_exception_temps(list:TAsmList;const t:texceptiontemps); override;
class procedure new_exception(list:TAsmList;const t:texceptiontemps; const exceptframekind: texceptframekind; out exceptstate: texceptionstate); override;
{ start of "except/finally" block }
class procedure emit_except_label(list: TAsmList; exceptframekind: texceptframekind; var exceptionstate: texceptionstate;var exceptiontemps:texceptiontemps); override;
{ end of a try-block, label comes after the end of try/except or
try/finally }
class procedure end_try_block(list: TAsmList; exceptframekind: texceptframekind; const t: texceptiontemps; var exceptionstate: texceptionstate; endlabel: TAsmLabel); override;
class procedure free_exception(list: TAsmList; const t: texceptiontemps; const s: texceptionstate; a: aint; endexceptlabel: tasmlabel; onlyfree:boolean); override;
class procedure handle_reraise(list:TAsmList;const t:texceptiontemps;const entrystate: texceptionstate; const exceptframekind: texceptframekind); override;
{ start of an "on" (catch) block }
class procedure begin_catch(list: TAsmList; excepttype: tobjectdef; nextonlabel: tasmlabel; out exceptlocdef: tdef; out exceptlocreg: tregister); override;
{ end of an "on" (catch) block }
class procedure end_catch(list: TAsmList); override;
{ called for a catch all exception }
class procedure catch_all_start(list: TAsmList); override;
class procedure catch_all_end(list: TAsmList); override;
class procedure cleanupobjectstack(list: TAsmList); override;
class procedure popaddrstack(list: TAsmList); override;
end;
tcgtryexceptnode = class(ttryexceptnode)
protected
@ -161,6 +196,239 @@ implementation
cgobj,hlcgobj,nutils
;
class procedure tpsabiehexceptionstatehandler.get_exception_temps(list: TAsmList; var t: texceptiontemps);
begin
tg.gethltemp(list,ossinttype,ossinttype.size,tt_persistent,t.reasonbuf);
end;
class procedure tpsabiehexceptionstatehandler.unget_exception_temps(list: TAsmList; const t: texceptiontemps);
begin
tg.ungettemp(list,t.reasonbuf);
current_procinfo.PopAction(current_procinfo.CurrentAction);
end;
class procedure tpsabiehexceptionstatehandler.new_exception(list: TAsmList; const t: texceptiontemps;
const exceptframekind: texceptframekind; out exceptstate: texceptionstate);
var
reg: tregister;
action: TPSABIEHAction;
begin
exceptstate.oldflowcontrol:=flowcontrol;
current_asmdata.getjumplabel(exceptstate.exceptionlabel);
if exceptframekind<>tek_except then
begin
current_asmdata.getjumplabel(exceptstate.finallycodelabel);
action:=TPSABIEHAction.Create(exceptstate.finallycodelabel);
end
else
begin
exceptstate.finallycodelabel:=nil;
action:=TPSABIEHAction.Create(exceptstate.exceptionlabel);
end;
current_procinfo.CreateNewPSABIEHCallsite;
current_procinfo.PushAction(action);
current_procinfo.PushLandingPad(action);
if exceptframekind<>tek_except then
current_procinfo.CurrentAction.AddAction(nil);
flowcontrol:=[fc_inflowcontrol,fc_catching_exceptions];
if exceptframekind<>tek_except then
begin
reg:=hlcg.getintregister(list,ossinttype);
hlcg.a_load_const_reg(list,ossinttype,1,reg);
hlcg.g_exception_reason_save(list,ossinttype,ossinttype,reg,t.reasonbuf);
end;
end;
class procedure tpsabiehexceptionstatehandler.emit_except_label(list: TAsmList; exceptframekind: texceptframekind;
var exceptionstate: texceptionstate;var exceptiontemps:texceptiontemps);
begin
hlcg.g_unreachable(list);
hlcg.a_label(list,exceptionstate.exceptionlabel);
if exceptframekind<>tek_except then
begin
if not assigned(exceptionstate.finallycodelabel) then
internalerror(2019021002);
hlcg.a_label(list,exceptionstate.finallycodelabel);
exceptionstate.finallycodelabel:=nil;
exceptiontemps.unwind_info:=cg.getaddressregister(list);
hlcg.a_load_reg_reg(list,voidpointertype,voidpointertype,NR_FUNCTION_RESULT_REG,exceptiontemps.unwind_info);
end;
end;
class procedure tpsabiehexceptionstatehandler.end_try_block(list: TAsmList; exceptframekind: texceptframekind; const t: texceptiontemps;
var exceptionstate: texceptionstate; endlabel: TAsmLabel);
var
reg: TRegister;
begin
current_procinfo.CreateNewPSABIEHCallsite;
current_procinfo.PopLandingPad(current_procinfo.CurrentLandingPad);
if exceptframekind<>tek_except then
begin
{ record that no exception happened in the reason buf, in case we are in a try block of a finally statement }
reg:=hlcg.getintregister(list,ossinttype);
hlcg.a_load_const_reg(list,ossinttype,0,reg);
hlcg.g_exception_reason_save(list,ossinttype,ossinttype,reg,t.reasonbuf);
end;
inherited;
if exceptframekind=tek_except then
hlcg.a_jmp_always(list,endlabel);
end;
class procedure tpsabiehexceptionstatehandler.free_exception(list: TAsmList; const t: texceptiontemps; const s: texceptionstate; a: aint;
endexceptlabel: tasmlabel; onlyfree: boolean);
begin
current_procinfo.CreateNewPSABIEHCallsite;
// inherited free_exception(list, t, s, a, endexceptlabel, onlyfree);
end;
class procedure tpsabiehexceptionstatehandler.handle_reraise(list: TAsmList; const t: texceptiontemps; const entrystate: texceptionstate;
const exceptframekind: texceptframekind);
var
cgpara1: tcgpara;
pd: tprocdef;
action: TPSABIEHAction;
begin
cgpara1.init;
if exceptframekind<>tek_except
{ not(fc_catching_exceptions in flowcontrol) and
use_cleanup(exceptframekind) } then
begin
pd:=search_system_proc('fpc_resume');
paramanager.getintparaloc(list,pd,1,cgpara1);
hlcg.a_load_reg_cgpara(list,voidpointertype,t.unwind_info,cgpara1);
paramanager.freecgpara(list,cgpara1);
hlcg.g_call_system_proc(current_asmdata.CurrAsmList,'fpc_resume',[@cgpara1],nil).resetiftemp
end
else
hlcg.g_call_system_proc(current_asmdata.CurrAsmList,'fpc_reraise',[],nil).resetiftemp;
cgpara1.done;
end;
class procedure tpsabiehexceptionstatehandler.begin_catch_internal(list: TAsmList; excepttype: tobjectdef; nextonlabel: tasmlabel;
add_catch: boolean; out exceptlocdef: tdef; out exceptlocreg: tregister);
var
catchstartlab : tasmlabel;
begincatchres,
typeidres,
paraloc1: tcgpara;
pd: tprocdef;
landingpadstructdef,
landingpadtypeiddef: tdef;
rttisym: TAsmSymbol;
rttidef: tdef;
rttiref: treference;
wrappedexception,
exceptiontypeidreg,
landingpadres: tregister;
exceptloc: tlocation;
indirect: boolean;
otherunit: boolean;
typeindex : aint;
begin
paraloc1.init;
rttidef:=nil;
rttisym:=nil;
if add_catch then
begin
if assigned(excepttype) then
begin
otherunit:=findunitsymtable(excepttype.owner).moduleid<>findunitsymtable(current_procinfo.procdef.owner).moduleid;
indirect:=(tf_supports_packages in target_info.flags) and
(target_info.system in systems_indirect_var_imports) and
(cs_imported_data in current_settings.localswitches) and
otherunit;
{ add "catch exceptiontype" clause to the landing pad }
rttidef:=cpointerdef.getreusable(excepttype.vmt_def);
rttisym:=current_asmdata.RefAsmSymbol(excepttype.vmt_mangledname, AT_DATA, indirect);
end;
end;
{ check if the exception is handled by this node }
if assigned(excepttype) then
begin
typeindex:=current_procinfo.CurrentAction.AddAction(excepttype);
current_asmdata.getjumplabel(catchstartlab);
hlcg.a_cmp_const_reg_label (list,osuinttype,OC_EQ,typeindex+1,NR_FUNCTION_RESULT64_HIGH_REG,catchstartlab);
hlcg.a_jmp_always(list,nextonlabel);
hlcg.a_label(list,catchstartlab);
end
else
current_procinfo.CurrentAction.AddAction(tobjectdef(-1));
wrappedexception:=hlcg.getaddressregister(list,voidpointertype);
pd:=search_system_proc('fpc_psabi_begin_catch');
paramanager.getintparaloc(list, pd, 1, paraloc1);
hlcg.a_load_reg_cgpara(list,voidpointertype,wrappedexception,paraloc1);
begincatchres:=hlcg.g_call_system_proc(list,pd,[@paraloc1],nil);
location_reset(exceptloc, LOC_REGISTER, def_cgsize(begincatchres.def));
exceptloc.register:=hlcg.getaddressregister(list, begincatchres.def);
hlcg.gen_load_cgpara_loc(list, begincatchres.def, begincatchres, exceptloc, true);
begincatchres.resetiftemp;
paraloc1.done;
exceptlocdef:=begincatchres.def;
exceptlocreg:=exceptloc.register;
end;
class procedure tpsabiehexceptionstatehandler.catch_all_start_internal(list: TAsmList; add_catch: boolean);
var
exceptlocdef: tdef;
exceptlocreg: tregister;
begin
begin_catch_internal(list,nil,nil,add_catch,exceptlocdef,exceptlocreg);
end;
class procedure tpsabiehexceptionstatehandler.begin_catch(list: TAsmList; excepttype: tobjectdef; nextonlabel: tasmlabel; out exceptlocdef: tdef; out
exceptlocreg: tregister);
begin
begin_catch_internal(list,excepttype,nextonlabel,true,exceptlocdef,exceptlocreg);
end;
class procedure tpsabiehexceptionstatehandler.end_catch(list: TAsmList);
begin
hlcg.g_call_system_proc(list,'fpc_psabi_end_catch',[],nil).resetiftemp;
inherited;
end;
class procedure tpsabiehexceptionstatehandler.catch_all_start(list: TAsmList);
begin
catch_all_start_internal(list,true);
end;
class procedure tpsabiehexceptionstatehandler.catch_all_end(list: TAsmList);
begin
hlcg.g_call_system_proc(list,'fpc_psabi_end_catch',[],nil).resetiftemp;
end;
class procedure tpsabiehexceptionstatehandler.cleanupobjectstack(list: TAsmList);
begin
// inherited cleanupobjectstack(list);
//!!! some catch all clause needed?
//!!! internalerror(2019021004)
end;
class procedure tpsabiehexceptionstatehandler.popaddrstack(list: TAsmList);
begin
{ there is no addr stack, so do nothing }
end;
{*****************************************************************************
Second_While_RepeatN
*****************************************************************************}
@ -564,6 +832,17 @@ implementation
tcgexceptionstatehandler
*****************************************************************************}
class function tcgexceptionstatehandler.use_cleanup(const exceptframekind: texceptframekind): boolean;
begin
{ in case of an exception caught by the implicit exception frame of
a safecall routine, this is not a cleanup frame but one that
catches the exception and returns a value from the function }
result:=
(exceptframekind=tek_implicitfinally) and
not((tf_safecall_exceptions in target_info.flags) and
(current_procinfo.procdef.proccalloption=pocall_safecall));
end;
{ Allocate the buffers for exception management and setjmp environment.
Return a pointer to these buffers, send them to the utility routine
so they are registered, and then call setjmp.
@ -666,7 +945,7 @@ implementation
end;
class procedure tcgexceptionstatehandler.emit_except_label(list: TAsmList; exceptframekind: texceptframekind; var exceptstate: texceptionstate);
class procedure tcgexceptionstatehandler.emit_except_label(list: TAsmList; exceptframekind: texceptframekind; var exceptstate: texceptionstate;var exceptiontemps:texceptiontemps);
begin
hlcg.a_label(list,exceptstate.exceptionlabel);
end;
@ -703,13 +982,13 @@ implementation
{ generates code to be executed when another exeception is raised while
control is inside except block }
class procedure tcgexceptionstatehandler.handle_nested_exception(list:TAsmList;const t:texceptiontemps;var entrystate: texceptionstate);
class procedure tcgexceptionstatehandler.handle_nested_exception(list:TAsmList;var t:texceptiontemps;var entrystate: texceptionstate);
var
exitlabel: tasmlabel;
begin
current_asmdata.getjumplabel(exitlabel);
end_try_block(list,tek_except,t,entrystate,exitlabel);
emit_except_label(current_asmdata.CurrAsmList,tek_normalfinally,entrystate);
emit_except_label(current_asmdata.CurrAsmList,tek_except,entrystate,t);
{ don't generate line info for internal cleanup }
list.concat(tai_marker.create(mark_NoLineInfoStart));
free_exception(list,t,entrystate,0,exitlabel,false);
@ -723,7 +1002,7 @@ implementation
class procedure tcgexceptionstatehandler.handle_reraise(list: TAsmList; const t: texceptiontemps; const entrystate: texceptionstate; const exceptframekind: texceptframekind);
begin
hlcg.g_call_system_proc(current_asmdata.CurrAsmList,'fpc_reraise',[],nil).resetiftemp;
hlcg.g_call_system_proc(current_asmdata.CurrAsmList,'fpc_reraise',[],nil).resetiftemp;
end;
@ -889,7 +1168,7 @@ implementation
cexceptionstatehandler.end_try_block(current_asmdata.CurrAsmList,tek_except,excepttemps,trystate,endexceptlabel);
cexceptionstatehandler.emit_except_label(current_asmdata.CurrAsmList,tek_except,trystate);
cexceptionstatehandler.emit_except_label(current_asmdata.CurrAsmList,tek_except,trystate,excepttemps);
cexceptionstatehandler.free_exception(current_asmdata.CurrAsmList, excepttemps, trystate, 0, endexceptlabel, false);
{ end cleanup }
@ -933,7 +1212,7 @@ implementation
part of this try/except }
flowcontrol:=trystate.oldflowcontrol*[fc_inflowcontrol,fc_catching_exceptions];
cexceptionstatehandler.get_exception_temps(current_asmdata.CurrAsmList,destroytemps);
cexceptionstatehandler.new_exception(current_asmdata.CurrAsmList,destroytemps,tek_normalfinally,doobjectdestroyandreraisestate);
cexceptionstatehandler.new_exception(current_asmdata.CurrAsmList,destroytemps,tek_except,doobjectdestroyandreraisestate);
{ the flowcontrol from the default except-block must be merged
with the flowcontrol flags potentially set by the
on-statements handled above (secondpass(right)), as they are
@ -1050,7 +1329,7 @@ implementation
we've to destroy the old one, so create a new
exception frame for the catch-handler }
cexceptionstatehandler.get_exception_temps(current_asmdata.CurrAsmList,excepttemps);
cexceptionstatehandler.new_exception(current_asmdata.CurrAsmList,excepttemps,tek_normalfinally,doobjectdestroyandreraisestate);
cexceptionstatehandler.new_exception(current_asmdata.CurrAsmList,excepttemps,tek_except,doobjectdestroyandreraisestate);
oldBreakLabel:=nil;
oldContinueLabel:=nil;
@ -1177,6 +1456,7 @@ implementation
cg.a_load_reg_reg(current_asmdata.CurrAsmList,OS_INT,OS_INT,NR_FUNCTION_RESULT_REG, NR_FUNCTION_RETURN_REG);
end;
procedure tcgtryfinallynode.pass_generate_code;
var
endfinallylabel,
@ -1267,7 +1547,7 @@ implementation
{ emit the except label already (to a temporary list) to ensure that any calls in the
finally block refer to the outer exception frame rather than to the exception frame
that emits this same finally code in case an exception does happen }
cexceptionstatehandler.emit_except_label(tmplist,exceptframekind,finallyexceptionstate);
cexceptionstatehandler.emit_except_label(tmplist,exceptframekind,finallyexceptionstate,excepttemps);
flowcontrol:=finallyexceptionstate.oldflowcontrol*[fc_inflowcontrol,fc_catching_exceptions];
current_asmdata.getjumplabel(finallyNoExceptionLabel);
@ -1287,7 +1567,7 @@ implementation
tmplist.free;
end
else
cexceptionstatehandler.emit_except_label(current_asmdata.CurrAsmList,exceptframekind,finallyexceptionstate);
cexceptionstatehandler.emit_except_label(current_asmdata.CurrAsmList,exceptframekind,finallyexceptionstate,excepttemps);
{ just free the frame information }
cexceptionstatehandler.free_exception(current_asmdata.CurrAsmList,excepttemps,finallyexceptionstate,1,finallyexceptionstate.exceptionlabel,true);

133
compiler/psub.pas
View File

@ -23,6 +23,8 @@ unit psub;
{$i fpcdefs.inc}
{ $define debug_eh}
interface
uses
@ -66,6 +68,8 @@ interface
function has_assembler_child : boolean;
procedure set_eh_info; override;
procedure setup_eh;
procedure finish_eh;
end;
@ -93,7 +97,7 @@ implementation
uses
sysutils,
{ common }
cutils, cmsgs,
cutils, cmsgs, cclasses,
{ global }
globtype,tokens,verbose,comphook,constexp,
systems,cpubase,aasmbase,aasmtai,aasmdata,
@ -116,7 +120,14 @@ implementation
pbase,pstatmnt,pdecl,pdecsub,pexports,pgenutil,pparautl,
{ codegen }
tgobj,cgbase,cgobj,hlcgobj,hlcgcpu,dbgbase,
{ dwarf }
dwarfbase,
cfidwarf,
ncgflw,
ncgutil,
optbase,
opttail,
optcse,
@ -1142,16 +1153,117 @@ implementation
end;
end;
procedure tcgprocinfo.set_eh_info;
begin
inherited;
if (tf_use_psabieh in target_info.flags) and
((pi_uses_exceptions in flags) or
((cs_implicit_exceptions in current_settings.moduleswitches) and
(pi_needs_implicit_finally in flags))) then
procdef.personality:=search_system_proc('_FPC_PSABIEH_PERSONALITY_V0');
(pi_needs_implicit_finally in flags))) or
(pi_has_except_table_data in flags) then
procdef.personality:=search_system_proc('_fpc_psabieh_personality_v0');
if (tf_use_psabieh in target_info.flags) and not(pi_has_except_table_data in flags) then
(current_asmdata.AsmCFI as TDwarfAsmCFI).LSDALabel:=nil;
end;
procedure tcgprocinfo.setup_eh;
var
gcc_except_table: tai_section;
begin
if tf_use_psabieh in target_info.flags then
begin
gcc_except_table_data:=TAsmList.Create;
callsite_table_data:=TAsmList.Create;
action_table_data:=TAsmList.Create;
actionstack:=TFPList.Create;
landingpadstack:=TFPList.Create;
typefilterlist:=TFPList.Create;
gcc_except_table:=new_section(gcc_except_table_data,sec_gcc_except_table,'',0);
gcc_except_table.secflags:=SF_A;
gcc_except_table.secprogbits:=SPB_PROGBITS;
if not(current_asmdata.AsmCFI is TDwarfAsmCFI) then
internalerror(2019021003);
{$ifdef debug_eh}
gcc_except_table_data.concat(tai_comment.Create(strpnew('gcc_except_table for '+procdef.fullprocname(true))));
{$endif debug_eh}
current_asmdata.getlabel(TDwarfAsmCFI(current_asmdata.AsmCFI).LSDALabel,alt_data);
current_asmdata.getlabel(callsitetablestart,alt_data);
current_asmdata.getlabel(callsitetableend,alt_data);
callsite_table_data.concat(tai_label.create(callsitetablestart));
cexceptionstatehandler:=tpsabiehexceptionstatehandler;
end;
end;
procedure tcgprocinfo.finish_eh;
var
i: Integer;
begin
if (tf_use_psabieh in target_info.flags) then
begin
if pi_has_except_table_data in flags then
begin
gcc_except_table_data.concat(tai_label.create(TDwarfAsmCFI(current_asmdata.AsmCFI).LSDALabel));
{ landing pad base is relative to procedure start, so write an omit }
gcc_except_table_data.concat(tai_const.create_8bit(DW_EH_PE_omit));
if typefilterlist.count>0 then
begin
gcc_except_table_data.concat(tai_const.create_8bit(DW_EH_PE_udata4));
current_asmdata.getlabel(typefilterlistlabel,alt_data);
current_asmdata.getlabel(typefilterlistlabelref,alt_data);
gcc_except_table_data.concat(tai_const.create_rel_sym(aitconst_uleb128bit,typefilterlistlabel,typefilterlistlabelref));
gcc_except_table_data.concat(tai_label.create(typefilterlistlabel));
end
else
{ default types table encoding }
gcc_except_table_data.concat(tai_const.create_8bit(DW_EH_PE_omit));
{ call-site table encoded using uleb128 }
gcc_except_table_data.concat(tai_const.create_8bit(DW_EH_PE_uleb128));
gcc_except_table_data.concat(tai_const.create_rel_sym(aitconst_uleb128bit,callsitetablestart,callsitetableend));
callsite_table_data.concat(tai_label.create(callsitetableend));
{$ifdef debug_eh}
gcc_except_table_data.concat(tai_comment.Create(strpnew('Call site table for '+procdef.fullprocname(true))));
{$endif debug_eh}
gcc_except_table_data.concatList(callsite_table_data);
{ action table must follow immediatly after callsite table }
{$ifdef debug_eh}
if not(action_table_data.Empty) then
gcc_except_table_data.concat(tai_comment.Create(strpnew('Action table for '+procdef.fullprocname(true))));
{$endif debug_eh}
gcc_except_table_data.concatlist(action_table_data);
if typefilterlist.count>0 then
begin
{$ifdef debug_eh}
gcc_except_table_data.concat(tai_comment.Create(strpnew('Type filter list for '+procdef.fullprocname(true))));
{$endif debug_eh}
for i:=typefilterlist.count-1 downto 0 do
begin
{$ifdef debug_eh}
gcc_except_table_data.concat(tai_comment.Create(strpnew('Type filter '+tostr(i))));
{$endif debug_eh}
if assigned(typefilterlist[i]) then
gcc_except_table_data.concat(tai_const.Create_sym(current_asmdata.RefAsmSymbol(tobjectdef(typefilterlist[i]).vmt_mangledname, AT_DATA)))
else
gcc_except_table_data.concat(tai_const.Create_32bit(0));
end;
{ the types are resolved by the negative offset, so the label must be written after all types }
gcc_except_table_data.concat(tai_label.create(typefilterlistlabelref));
end;
new_section(gcc_except_table_data,sec_code,'',0);
aktproccode.concatlist(gcc_except_table_data);
end;
end;
end;
procedure tcgprocinfo.generate_code_tree;
var
hpi : tcgprocinfo;
@ -1531,6 +1643,8 @@ implementation
begin
create_hlcodegen;
setup_eh;
if (procdef.proctypeoption<>potype_exceptfilter) then
setup_tempgen;
@ -1751,6 +1865,9 @@ implementation
hlcg.gen_stack_check_size_para(templist);
aktproccode.insertlistafter(stackcheck_asmnode.currenttai,templist)
end;
current_procinfo.set_eh_info;
{ Add entry code (stack allocation) after header }
current_filepos:=entrypos;
gen_proc_entry_code(templist);
@ -1776,7 +1893,13 @@ implementation
not(target_info.system in systems_garbage_collected_managed_types) then
internalerror(200405231);
current_procinfo.set_eh_info;
{ sanity check }
if not(assigned(current_procinfo.procdef.personality)) and
(tf_use_psabieh in target_info.flags) and
((pi_uses_exceptions in flags) or
((cs_implicit_exceptions in current_settings.moduleswitches) and
(pi_needs_implicit_finally in flags))) then
Internalerror(2019021005);
{ Position markers are only used to insert additional code after the secondpass
and before this point. They are of no use in optimizer. Instead of checking and
@ -1822,6 +1945,8 @@ implementation
(cs_use_lineinfo in current_settings.globalswitches) then
current_debuginfo.insertlineinfo(aktproccode);
finish_eh;
hlcg.record_generated_code_for_procdef(current_procinfo.procdef,aktproccode,aktlocaldata);
{ only now we can remove the temps }