|
@@ -0,0 +1,669 @@
|
|
|
|
+{
|
|
|
|
+ Copyright (c) 1998-2002 by Florian Klaempfl
|
|
|
|
+
|
|
|
|
+ Information about the current procedure that is being compiled
|
|
|
|
+
|
|
|
|
+ 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 psabiehpi;
|
|
|
|
+
|
|
|
|
+{ $define debug_eh}
|
|
|
|
+
|
|
|
|
+{$i fpcdefs.inc}
|
|
|
|
+
|
|
|
|
+ interface
|
|
|
|
+
|
|
|
|
+ uses
|
|
|
|
+ { common }
|
|
|
|
+ cclasses,
|
|
|
|
+ { global }
|
|
|
|
+ globtype,
|
|
|
|
+ { symtable }
|
|
|
|
+ symconst,symtype,symdef,symsym,
|
|
|
|
+ node,
|
|
|
|
+ { aasm }
|
|
|
|
+ cpubase,cgbase,cgutils,
|
|
|
|
+ aasmbase,aasmdata,aasmtai,
|
|
|
|
+ psub;
|
|
|
|
+
|
|
|
|
+ type
|
|
|
|
+ TPSABIEHAction = class
|
|
|
|
+ landingpad : TAsmLabel;
|
|
|
|
+ actiontablelabel : TAsmLabel;
|
|
|
|
+ actionlist : TAsmList;
|
|
|
|
+ first : boolean;
|
|
|
|
+ constructor Create(pad : TAsmLabel);
|
|
|
|
+ destructor Destroy; override;
|
|
|
|
+ function AddAction(p: tobjectdef): LongInt;
|
|
|
|
+ end;
|
|
|
|
+
|
|
|
|
+ { This object gives information on the current routine being
|
|
|
|
+ compiled.
|
|
|
|
+ }
|
|
|
|
+ tpsabiehprocinfo = class(tcgprocinfo)
|
|
|
|
+ { psabieh stuff, might be subject to be moved elsewhere }
|
|
|
|
+ { gcc exception table list that belongs to this routine }
|
|
|
|
+ callsite_table_data,
|
|
|
|
+ action_table_data,
|
|
|
|
+ gcc_except_table_data : TAsmList;
|
|
|
|
+ typefilterlistlabel,typefilterlistlabelref,
|
|
|
|
+ callsitetablestart,callsitetableend : TAsmLabel;
|
|
|
|
+ callsitelaststart : TAsmLabel;
|
|
|
|
+ typefilterlist,
|
|
|
|
+ landingpadstack,
|
|
|
|
+ actionstack : tfplist;
|
|
|
|
+ CurrentCallSiteNumber : Longint;
|
|
|
|
+
|
|
|
|
+ destructor destroy; override;
|
|
|
|
+
|
|
|
|
+ { PSABIEH stuff }
|
|
|
|
+ procedure PushAction(action: TPSABIEHAction);
|
|
|
|
+ function CurrentAction: TPSABIEHAction;inline;
|
|
|
|
+ function PopAction(action: TPSABIEHAction): boolean;
|
|
|
|
+ { a landing pad is also an action, however, when the landing pad is popped from the stack
|
|
|
|
+ the area covered by this landing pad ends, i.e. it is popped at the beginning of the finally/except clause,
|
|
|
|
+ the action above is popped at the end of the finally/except clause, so if on clauses add new types, they
|
|
|
|
+ are added to CurrentAction }
|
|
|
|
+ procedure PushLandingPad(action: TPSABIEHAction);
|
|
|
|
+ function CurrentLandingPad: TPSABIEHAction;inline;
|
|
|
|
+ function PopLandingPad(action: TPSABIEHAction): boolean;
|
|
|
|
+ procedure CreateNewPSABIEHCallsite;
|
|
|
|
+ { adds a new type to the type filter list and returns its index
|
|
|
|
+ be aware, that this method can also handle catch all filters so it
|
|
|
|
+ is valid to pass nil }
|
|
|
|
+ function AddTypeFilter(p: tobjectdef): Longint;
|
|
|
|
+ procedure set_eh_info; override;
|
|
|
|
+ procedure setup_eh; override;
|
|
|
|
+ procedure finish_eh; override;
|
|
|
|
+ end;
|
|
|
|
+
|
|
|
|
+implementation
|
|
|
|
+
|
|
|
|
+ uses
|
|
|
|
+ cutils,
|
|
|
|
+ verbose,
|
|
|
|
+ systems,
|
|
|
|
+ dwarfbase,
|
|
|
|
+ cfidwarf,
|
|
|
|
+ globals,
|
|
|
|
+ procinfo,
|
|
|
|
+ symtable,
|
|
|
|
+ defutil,
|
|
|
|
+ tgobj,
|
|
|
|
+ cgobj,
|
|
|
|
+ parabase,paramgr,
|
|
|
|
+ hlcgobj,
|
|
|
|
+ pass_2,
|
|
|
|
+ ncgflw;
|
|
|
|
+
|
|
|
|
+
|
|
|
|
+ type
|
|
|
|
+ { 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;
|
|
|
|
+
|
|
|
|
+
|
|
|
|
+ constructor TPSABIEHAction.Create(pad: TAsmLabel);
|
|
|
|
+ begin
|
|
|
|
+ landingpad:=pad;
|
|
|
|
+ actionlist:=TAsmList.create;
|
|
|
|
+ current_asmdata.getlabel(actiontablelabel,alt_data);
|
|
|
|
+ actionlist.concat(tai_label.create(actiontablelabel));
|
|
|
|
+ first:=true;
|
|
|
|
+ end;
|
|
|
|
+
|
|
|
|
+
|
|
|
|
+ destructor TPSABIEHAction.Destroy;
|
|
|
|
+ begin
|
|
|
|
+ if not(actionlist.Empty) then
|
|
|
|
+ Internalerror(2019020501);
|
|
|
|
+ actionlist.Free;
|
|
|
|
+ inherited Destroy;
|
|
|
|
+ end;
|
|
|
|
+
|
|
|
|
+
|
|
|
|
+ function TPSABIEHAction.AddAction(p: tobjectdef) : LongInt;
|
|
|
|
+ var
|
|
|
|
+ index: LongInt;
|
|
|
|
+ begin
|
|
|
|
+ { if not first entry, signal that another action follows }
|
|
|
|
+ if not(first) then
|
|
|
|
+ actionlist.concat(tai_const.Create_uleb128bit(1));
|
|
|
|
+ first:=false;
|
|
|
|
+
|
|
|
|
+ { catch all? }
|
|
|
|
+ if p=tobjectdef(-1) then
|
|
|
|
+ index:=(current_procinfo as tpsabiehprocinfo).AddTypeFilter(nil)
|
|
|
|
+ else if assigned(p) then
|
|
|
|
+ index:=(current_procinfo as tpsabiehprocinfo).AddTypeFilter(p)
|
|
|
|
+ else
|
|
|
|
+ index:=-1;
|
|
|
|
+{$ifdef debug_eh}
|
|
|
|
+ if p=tobjectdef(-1) then
|
|
|
|
+ actionlist.concat(tai_comment.Create(strpnew('Catch all')))
|
|
|
|
+ else if assigned(p) then
|
|
|
|
+ actionlist.concat(tai_comment.Create(strpnew('Action for '+p.GetTypeName)))
|
|
|
|
+ else
|
|
|
|
+ actionlist.concat(tai_comment.Create(strpnew('Cleanup')));
|
|
|
|
+{$endif debug_eh}
|
|
|
|
+ if assigned(p) then
|
|
|
|
+ actionlist.concat(tai_const.Create_uleb128bit(index+1))
|
|
|
|
+ else
|
|
|
|
+ actionlist.concat(tai_const.Create_uleb128bit(0));
|
|
|
|
+ Result:=index;
|
|
|
|
+ end;
|
|
|
|
+
|
|
|
|
+{****************************************************************************
|
|
|
|
+ tpsabiehprocinfo
|
|
|
|
+****************************************************************************}
|
|
|
|
+
|
|
|
|
+
|
|
|
|
+ destructor tpsabiehprocinfo.destroy;
|
|
|
|
+ begin
|
|
|
|
+ gcc_except_table_data.free;
|
|
|
|
+ actionstack.free;
|
|
|
|
+ landingpadstack.free;
|
|
|
|
+ typefilterlist.free;
|
|
|
|
+ callsite_table_data.Free;
|
|
|
|
+ action_table_data.Free;
|
|
|
|
+ inherited;
|
|
|
|
+ end;
|
|
|
|
+
|
|
|
|
+
|
|
|
|
+ procedure tpsabiehprocinfo.PushAction(action: TPSABIEHAction);
|
|
|
|
+ begin
|
|
|
|
+ actionstack.add(action);
|
|
|
|
+ end;
|
|
|
|
+
|
|
|
|
+
|
|
|
|
+ function tpsabiehprocinfo.PopAction(action: TPSABIEHAction): boolean;
|
|
|
|
+ var
|
|
|
|
+ curpos: tasmlabel;
|
|
|
|
+ begin
|
|
|
|
+ include(flags,pi_has_except_table_data);
|
|
|
|
+ if CurrentAction<>action then
|
|
|
|
+ internalerror(2019021006);
|
|
|
|
+ { no further actions follow, finalize table }
|
|
|
|
+ if landingpadstack.count>0 then
|
|
|
|
+ begin
|
|
|
|
+ current_asmdata.getlabel(curpos,alt_data);
|
|
|
|
+ action.actionlist.concat(tai_label.create(curpos));
|
|
|
|
+ action.actionlist.concat(tai_const.Create_rel_sym(aitconst_sleb128bit,curpos,TPSABIEHAction(landingpadstack[landingpadstack.count-1]).actiontablelabel));
|
|
|
|
+ end
|
|
|
|
+ else
|
|
|
|
+ action.actionlist.concat(tai_const.Create_uleb128bit(0));
|
|
|
|
+ action_table_data.concatList(action.actionlist);
|
|
|
|
+ actionstack.count:=actionstack.count-1;
|
|
|
|
+ result:=actionstack.count=0;
|
|
|
|
+ end;
|
|
|
|
+
|
|
|
|
+
|
|
|
|
+ procedure tpsabiehprocinfo.PushLandingPad(action: TPSABIEHAction);
|
|
|
|
+ begin
|
|
|
|
+ landingpadstack.add(action);
|
|
|
|
+ end;
|
|
|
|
+
|
|
|
|
+
|
|
|
|
+ function tpsabiehprocinfo.CurrentLandingPad: TPSABIEHAction;
|
|
|
|
+ begin
|
|
|
|
+ result:=TPSABIEHAction(landingpadstack.last);
|
|
|
|
+ end;
|
|
|
|
+
|
|
|
|
+
|
|
|
|
+ function tpsabiehprocinfo.PopLandingPad(action: TPSABIEHAction): boolean;
|
|
|
|
+ begin
|
|
|
|
+ if CurrentLandingPad<>action then
|
|
|
|
+ internalerror(2019021007);
|
|
|
|
+ landingpadstack.count:=landingpadstack.count-1;
|
|
|
|
+ result:=landingpadstack.count=0;
|
|
|
|
+ end;
|
|
|
|
+
|
|
|
|
+
|
|
|
|
+ procedure tpsabiehprocinfo.CreateNewPSABIEHCallsite;
|
|
|
|
+ var
|
|
|
|
+ callsiteend : TAsmLabel;
|
|
|
|
+ begin
|
|
|
|
+ include(flags,pi_has_except_table_data);
|
|
|
|
+ { first, finish last entry }
|
|
|
|
+ if assigned(callsitelaststart) and assigned(CurrentLandingPad) then
|
|
|
|
+ begin
|
|
|
|
+{$ifdef debug_eh}
|
|
|
|
+ if assigned(CurrentLandingPad.actiontablelabel) then
|
|
|
|
+ callsite_table_data.concat(tai_comment.Create(strpnew('Call site '+tostr(CurrentCallSiteNumber)+', action table index = '+tostr(landingpadstack.count-1))))
|
|
|
|
+ else
|
|
|
|
+ callsite_table_data.concat(tai_comment.Create(strpnew('Call site '+tostr(CurrentCallSiteNumber)+', no action')));
|
|
|
|
+{$endif debug_eh}
|
|
|
|
+ callsite_table_data.concat(tai_const.create_rel_sym(aitconst_uleb128bit,TDwarfAsmCFI(current_asmdata.AsmCFI).get_frame_start,callsitelaststart));
|
|
|
|
+ current_asmdata.getlabel(callsiteend,alt_eh_end);
|
|
|
|
+ current_asmdata.CurrAsmList.concat(tai_label.create(callsiteend));
|
|
|
|
+ callsite_table_data.concat(tai_const.create_rel_sym(aitconst_uleb128bit,callsitelaststart,callsiteend));
|
|
|
|
+ { landing pad? }
|
|
|
|
+ if assigned(CurrentLandingPad.landingpad) then
|
|
|
|
+ callsite_table_data.concat(tai_const.create_rel_sym(aitconst_uleb128bit,TDwarfAsmCFI(current_asmdata.AsmCFI).get_frame_start,CurrentLandingPad.landingpad))
|
|
|
|
+ else
|
|
|
|
+ callsite_table_data.concat(tai_const.Create_uleb128bit(0));
|
|
|
|
+ { action number set? if yes, concat }
|
|
|
|
+ if assigned(CurrentLandingPad.actiontablelabel) then
|
|
|
|
+ begin
|
|
|
|
+ callsite_table_data.concat(tai_const.Create_rel_sym_offset(aitconst_uleb128bit,callsitetableend,CurrentLandingPad.actiontablelabel,1));
|
|
|
|
+{$ifdef debug_eh}
|
|
|
|
+ current_asmdata.CurrAsmList.concat(tai_comment.Create(strpnew('New call site '+tostr(CurrentCallSiteNumber)+', action table index = '+tostr(landingpadstack.count-1))));
|
|
|
|
+{$endif debug_eh}
|
|
|
|
+ end
|
|
|
|
+ else
|
|
|
|
+ begin
|
|
|
|
+ callsite_table_data.concat(tai_const.Create_uleb128bit(0));
|
|
|
|
+{$ifdef debug_eh}
|
|
|
|
+ current_asmdata.CurrAsmList.concat(tai_comment.Create(strpnew('New call site '+tostr(CurrentCallSiteNumber)+', no action')));
|
|
|
|
+{$endif debug_eh}
|
|
|
|
+ end
|
|
|
|
+ end;
|
|
|
|
+ current_asmdata.getlabel(callsitelaststart,alt_eh_begin);
|
|
|
|
+ current_asmdata.CurrAsmList.concat(tai_label.create(callsitelaststart));
|
|
|
|
+ Inc(CurrentCallSiteNumber);
|
|
|
|
+ end;
|
|
|
|
+
|
|
|
|
+
|
|
|
|
+ function tpsabiehprocinfo.AddTypeFilter(p: tobjectdef) : Longint;
|
|
|
|
+ var
|
|
|
|
+ i: Integer;
|
|
|
|
+ begin
|
|
|
|
+ for i:=0 to typefilterlist.count-1 do
|
|
|
|
+ begin
|
|
|
|
+ if tobjectdef(typefilterlist[i])=p then
|
|
|
|
+ begin
|
|
|
|
+ result:=i;
|
|
|
|
+ exit;
|
|
|
|
+ end;
|
|
|
|
+ end;
|
|
|
|
+ result:=typefilterlist.add(p);
|
|
|
|
+ end;
|
|
|
|
+
|
|
|
|
+
|
|
|
|
+ procedure tpsabiehprocinfo.set_eh_info;
|
|
|
|
+ begin
|
|
|
|
+ inherited set_eh_info;
|
|
|
|
+ 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;
|
|
|
|
+
|
|
|
|
+
|
|
|
|
+ function tpsabiehprocinfo.CurrentAction: TPSABIEHAction; inline;
|
|
|
|
+ begin
|
|
|
|
+ result:=TPSABIEHAction(actionstack.last);
|
|
|
|
+ end;
|
|
|
|
+
|
|
|
|
+
|
|
|
|
+ procedure tpsabiehprocinfo.setup_eh;
|
|
|
|
+ var
|
|
|
|
+ gcc_except_table: tai_section;
|
|
|
|
+ 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;
|
|
|
|
+
|
|
|
|
+
|
|
|
|
+ procedure tpsabiehprocinfo.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;
|
|
|
|
+
|
|
|
|
+
|
|
|
|
+ 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 as tpsabiehprocinfo).PopAction((current_procinfo as tpsabiehprocinfo).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 as tpsabiehprocinfo).CreateNewPSABIEHCallsite;
|
|
|
|
+ (current_procinfo as tpsabiehprocinfo).PushAction(action);
|
|
|
|
+ (current_procinfo as tpsabiehprocinfo).PushLandingPad(action);
|
|
|
|
+ if exceptframekind<>tek_except then
|
|
|
|
+ (current_procinfo as tpsabiehprocinfo).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 as tpsabiehprocinfo).CreateNewPSABIEHCallsite;
|
|
|
|
+ (current_procinfo as tpsabiehprocinfo).PopLandingPad((current_procinfo as tpsabiehprocinfo).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 as tpsabiehprocinfo).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 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 as tpsabiehprocinfo).CurrentAction.AddAction(excepttype);
|
|
|
|
+ current_asmdata.getjumplabel(catchstartlab);
|
|
|
|
+{$ifdef i386}
|
|
|
|
+ hlcg.a_cmp_const_reg_label (list,osuinttype,OC_EQ,typeindex+1,NR_FUNCTION_RESULT64_HIGH_REG,catchstartlab);
|
|
|
|
+{$else i386}
|
|
|
|
+ { we need to find a way to fix this in a generic way }
|
|
|
|
+ Internalerror(2019021008);
|
|
|
|
+{$endif i386}
|
|
|
|
+ hlcg.a_jmp_always(list,nextonlabel);
|
|
|
|
+ hlcg.a_label(list,catchstartlab);
|
|
|
|
+ end
|
|
|
|
+ else
|
|
|
|
+ (current_procinfo as tpsabiehprocinfo).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;
|
|
|
|
+
|
|
|
|
+end.
|