diff --git a/compiler/cfidwarf.pas b/compiler/cfidwarf.pas index 5a1bfc3b62..093a67a908 100644 --- a/compiler/cfidwarf.pas +++ b/compiler/cfidwarf.pas @@ -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; diff --git a/compiler/llvm/nllvmflw.pas b/compiler/llvm/nllvmflw.pas index 6dc79c0f1c..9c9cbc9a63 100644 --- a/compiler/llvm/nllvmflw.pas +++ b/compiler/llvm/nllvmflw.pas @@ -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 *****************************************************************************} diff --git a/compiler/ncgflw.pas b/compiler/ncgflw.pas index 8643b10ac3..533ce1f83e 100644 --- a/compiler/ncgflw.pas +++ b/compiler/ncgflw.pas @@ -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); diff --git a/compiler/psub.pas b/compiler/psub.pas index 560e5e2b1a..0eeac35986 100644 --- a/compiler/psub.pas +++ b/compiler/psub.pas @@ -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 }