2
0
Эх сурвалжийг харах

* refactored psabieh handling, most code is now in psabiehpi

git-svn-id: branches/debug_eh@41367 -
florian 6 жил өмнө
parent
commit
9514bd9162

+ 1 - 0
.gitattributes

@@ -654,6 +654,7 @@ compiler/ppheap.pas svneol=native#text/plain
 compiler/ppu.pas svneol=native#text/plain
 compiler/ppu.pas svneol=native#text/plain
 compiler/procdefutil.pas svneol=native#text/plain
 compiler/procdefutil.pas svneol=native#text/plain
 compiler/procinfo.pas svneol=native#text/plain
 compiler/procinfo.pas svneol=native#text/plain
+compiler/psabiehpi.pas svneol=native#text/plain
 compiler/pstatmnt.pas svneol=native#text/plain
 compiler/pstatmnt.pas svneol=native#text/plain
 compiler/psub.pas svneol=native#text/plain
 compiler/psub.pas svneol=native#text/plain
 compiler/psystem.pas svneol=native#text/plain
 compiler/psystem.pas svneol=native#text/plain

+ 2 - 2
compiler/i386/cpupi.pas

@@ -28,10 +28,10 @@ unit cpupi;
   interface
   interface
 
 
     uses
     uses
-       psub,procinfo,aasmdata;
+       psub,procinfo,psabiehpi,aasmdata;
 
 
     type
     type
-       tcpuprocinfo = class(tcgprocinfo)
+       tcpuprocinfo = class(tpsabiehprocinfo)
          constructor create(aparent:tprocinfo);override;
          constructor create(aparent:tprocinfo);override;
          procedure set_first_temp_offset;override;
          procedure set_first_temp_offset;override;
          function calc_stackframe_size:longint;override;
          function calc_stackframe_size:longint;override;

+ 22 - 284
compiler/ncgflw.pas

@@ -75,7 +75,9 @@ interface
 
 
        tcgraisenode = class(traisenode)
        tcgraisenode = class(traisenode)
          function pass_1: tnode;override;
          function pass_1: tnode;override;
+{$ifndef jvm}
          procedure pass_generate_code;override;
          procedure pass_generate_code;override;
+{$endif jvm}
        end;
        end;
 
 
        { Utility class for exception handling state management that is used
        { Utility class for exception handling state management that is used
@@ -127,38 +129,6 @@ interface
        end;
        end;
        tcgexceptionstatehandlerclass = class of tcgexceptionstatehandler;
        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)
        tcgtryexceptnode = class(ttryexceptnode)
         protected
         protected
           type
           type
@@ -197,245 +167,10 @@ implementation
       cpubase,
       cpubase,
       tgobj,paramgr,
       tgobj,paramgr,
       cgobj,hlcgobj,nutils
       cgobj,hlcgobj,nutils
+{$ifndef jvm}
+      ,psabiehpi
+{$endif jvm}
       ;
       ;
-
-    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 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);
-{$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.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
                          Second_While_RepeatN
 *****************************************************************************}
 *****************************************************************************}
@@ -1664,43 +1399,46 @@ implementation
           end;
           end;
       end;
       end;
 
 
-
+{$ifndef jvm}
+    { has to be factored out as well }
     procedure tcgraisenode.pass_generate_code;
     procedure tcgraisenode.pass_generate_code;
       var
       var
         CurrentLandingPad, CurrentAction, ReRaiseLandingPad: TPSABIEHAction;
         CurrentLandingPad, CurrentAction, ReRaiseLandingPad: TPSABIEHAction;
+        psabiehprocinfo: tpsabiehprocinfo;
       begin
       begin
         if not(tf_use_psabieh in target_info.flags) then
         if not(tf_use_psabieh in target_info.flags) then
           Internalerror(2019021701);
           Internalerror(2019021701);
 
 
         location_reset(location,LOC_VOID,OS_NO);
         location_reset(location,LOC_VOID,OS_NO);
         CurrentLandingPad:=nil;
         CurrentLandingPad:=nil;
+        psabiehprocinfo:=current_procinfo as tpsabiehprocinfo;
         { a reraise must raise the exception to the parent exception frame }
         { a reraise must raise the exception to the parent exception frame }
         if fc_catching_exceptions in flowcontrol then
         if fc_catching_exceptions in flowcontrol then
           begin
           begin
-            current_procinfo.CreateNewPSABIEHCallsite;
-            CurrentLandingPad:=current_procinfo.CurrentLandingPad;
-            if current_procinfo.PopLandingPad(CurrentLandingPad) then
+            psabiehprocinfo.CreateNewPSABIEHCallsite;
+            CurrentLandingPad:=psabiehprocinfo.CurrentLandingPad;
+            if psabiehprocinfo.PopLandingPad(CurrentLandingPad) then
               exclude(flowcontrol,fc_catching_exceptions);
               exclude(flowcontrol,fc_catching_exceptions);
-            CurrentAction:=current_procinfo.CurrentAction;
-            current_procinfo.PopAction(CurrentAction);
+            CurrentAction:=psabiehprocinfo.CurrentAction;
+            psabiehprocinfo.PopAction(CurrentAction);
 
 
             ReRaiseLandingPad:=TPSABIEHAction.Create(nil);
             ReRaiseLandingPad:=TPSABIEHAction.Create(nil);
-            current_procinfo.PushAction(ReRaiseLandingPad);
-            current_procinfo.PushLandingPad(ReRaiseLandingPad);
+            psabiehprocinfo.PushAction(ReRaiseLandingPad);
+            psabiehprocinfo.PushLandingPad(ReRaiseLandingPad);
           end;
           end;
         hlcg.g_call_system_proc(current_asmdata.CurrAsmList,'fpc_reraise',[],nil).resetiftemp;
         hlcg.g_call_system_proc(current_asmdata.CurrAsmList,'fpc_reraise',[],nil).resetiftemp;
         if assigned(CurrentLandingPad) then
         if assigned(CurrentLandingPad) then
           begin
           begin
-            current_procinfo.CreateNewPSABIEHCallsite;
-            current_procinfo.PopLandingPad(current_procinfo.CurrentLandingPad);
-            current_procinfo.PopAction(ReRaiseLandingPad);
+            psabiehprocinfo.CreateNewPSABIEHCallsite;
+            psabiehprocinfo.PopLandingPad(psabiehprocinfo.CurrentLandingPad);
+            psabiehprocinfo.PopAction(ReRaiseLandingPad);
 
 
-            current_procinfo.PushAction(CurrentAction);
-            current_procinfo.PushLandingPad(CurrentLandingPad);
+            psabiehprocinfo.PushAction(CurrentAction);
+            psabiehprocinfo.PushLandingPad(CurrentLandingPad);
             include(flowcontrol,fc_catching_exceptions);
             include(flowcontrol,fc_catching_exceptions);
           end;
           end;
       end;
       end;
-
+{$endif jvm}
 
 
 
 
 begin
 begin

+ 17 - 3
compiler/procinfo.pas

@@ -51,9 +51,6 @@ unit procinfo;
        { This object gives information on the current routine being
        { This object gives information on the current routine being
          compiled.
          compiled.
        }
        }
-
-       { tprocinfo }
-
        tprocinfo = class(tlinkedlistitem)
        tprocinfo = class(tlinkedlistitem)
        private
        private
           { list to store the procinfo's of the nested procedures }
           { list to store the procinfo's of the nested procedures }
@@ -184,6 +181,9 @@ unit procinfo;
 
 
           { set exception handling info }
           { set exception handling info }
           procedure set_eh_info; virtual;
           procedure set_eh_info; virtual;
+
+          procedure setup_eh; virtual;
+          procedure finish_eh; virtual;
        end;
        end;
        tcprocinfo = class of tprocinfo;
        tcprocinfo = class of tprocinfo;
 
 
@@ -325,14 +325,28 @@ implementation
           be initialized }
           be initialized }
       end;
       end;
 
 
+
     procedure tprocinfo.postprocess_code;
     procedure tprocinfo.postprocess_code;
       begin
       begin
         { no action by default }
         { no action by default }
       end;
       end;
 
 
+
     procedure tprocinfo.set_eh_info;
     procedure tprocinfo.set_eh_info;
       begin
       begin
         { default code is in tcgprocinfo }
         { default code is in tcgprocinfo }
       end;
       end;
 
 
+
+    procedure tprocinfo.setup_eh;
+      begin
+        { no action by default }
+      end;
+
+
+    procedure tprocinfo.finish_eh;
+      begin
+        { no action by default }
+      end;
+
 end.
 end.

+ 669 - 0
compiler/psabiehpi.pas

@@ -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.

+ 0 - 104
compiler/psub.pas

@@ -68,8 +68,6 @@ interface
 
 
         function has_assembler_child : boolean;
         function has_assembler_child : boolean;
         procedure set_eh_info; override;
         procedure set_eh_info; override;
-        procedure setup_eh;
-        procedure finish_eh;
       end;
       end;
 
 
 
 
@@ -121,10 +119,6 @@ implementation
        { codegen }
        { codegen }
        tgobj,cgbase,cgobj,hlcgobj,hlcgcpu,dbgbase,
        tgobj,cgbase,cgobj,hlcgobj,hlcgcpu,dbgbase,
 
 
-       { dwarf }
-       dwarfbase,
-       cfidwarf,
-
        ncgflw,
        ncgflw,
        ncgutil,
        ncgutil,
 
 
@@ -1163,104 +1157,6 @@ implementation
               (pi_needs_implicit_finally in flags))) or
               (pi_needs_implicit_finally in flags))) or
              (pi_has_except_table_data in flags) then
              (pi_has_except_table_data in flags) then
            procdef.personality:=search_system_proc('_FPC_PSABIEH_PERSONALITY_V0');
            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;
       end;