* moved tcgexceptionstatehandler to a new cgexcept unit

  * fixed llvm cycle by overriding additional eh-related tcgprocinfo methods

git-svn-id: branches/debug_eh@41519 -

.gitattributes

@@ -149,6 +149,7 @@ compiler/cfidwarf.pas svneol=native#text/plain
 compiler/cfileutl.pas svneol=native#text/plain
 compiler/cg64f32.pas svneol=native#text/plain
 compiler/cgbase.pas svneol=native#text/plain
+compiler/cgexcept.pas svneol=native#text/plain
 compiler/cghlcpu.pas svneol=native#text/plain
 compiler/cgobj.pas svneol=native#text/plain
 compiler/cgutils.pas svneol=native#text/plain

compiler/cgexcept.pas

@@ -0,0 +1,353 @@
+{
+    Copyright (c) 2017-2019 by Jonas Maebe, member of the
+    Free Pascal Compiler development team
+
+    Base class for exception handling support (setjump/longjump-based)
+
+    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 cgexcept;
+
+{$i fpcdefs.inc}
+
+  interface
+
+    uses
+      globtype,
+      aasmbase, aasmdata,
+      symtype,symdef,
+      cgbase,cgutils,pass_2;
+
+    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. }
+      tcgexceptionstatehandler = class
+       type
+        texceptiontemps=record
+          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_resume }
+          unwind_info : TRegister;
+        end;
+
+        texceptionstate = record
+          exceptionlabel: TAsmLabel;
+          oldflowcontrol,
+          newflowcontrol: tflowcontrol;
+          finallycodelabel  : TAsmLabel;
+        end;
+
+        texceptframekind = (tek_except, tek_implicitfinally, tek_normalfinally);
+
+        class procedure get_exception_temps(list:TAsmList;var t:texceptiontemps); virtual;
+        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;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;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;
+        { end of an "on" (catch) block }
+        class procedure end_catch(list: TAsmList); virtual;
+        { called for a catch all exception }
+        class procedure catch_all_start(list: TAsmList); virtual;
+        { called after the catch all exception has been started with new_exception }
+        class procedure catch_all_add(list: TAsmList); virtual;
+        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;
+
+    var
+      cexceptionstatehandler: tcgexceptionstatehandlerclass = tcgexceptionstatehandler;
+
+  implementation
+
+    uses
+      globals,
+      systems,
+      fmodule,
+      aasmtai,
+      symconst,symtable,defutil,
+      parabase,paramgr,
+      procinfo,
+      tgobj,
+      hlcgobj;
+
+{*****************************************************************************
+                     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.
+
+       Then compare the result of setjmp with 0, and if not equal
+       to zero, then jump to exceptlabel.
+
+       Also store the result of setjmp to a temporary space by calling g_save_exception_reason
+
+       It is to note that this routine may be called *after* the stackframe of a
+       routine has been called, therefore on machines where the stack cannot
+       be modified, all temps should be allocated on the heap instead of the
+       stack. }
+
+
+    class procedure tcgexceptionstatehandler.get_exception_temps(list:TAsmList;var t:texceptiontemps);
+     begin
+        tg.gethltemp(list,rec_exceptaddr,rec_exceptaddr.size,tt_persistent,t.envbuf);
+        tg.gethltemp(list,rec_jmp_buf,rec_jmp_buf.size,tt_persistent,t.jmpbuf);
+        tg.gethltemp(list,ossinttype,ossinttype.size,tt_persistent,t.reasonbuf);
+      end;
+
+
+    class procedure tcgexceptionstatehandler.unget_exception_temps(list:TAsmList;const t:texceptiontemps);
+      begin
+        tg.Ungettemp(list,t.jmpbuf);
+        tg.ungettemp(list,t.envbuf);
+        tg.ungettemp(list,t.reasonbuf);
+      end;
+
+
+    class procedure tcgexceptionstatehandler.new_exception(list:TAsmList;const t:texceptiontemps; const exceptframekind: texceptframekind; out exceptstate: texceptionstate);
+      var
+        paraloc1, paraloc2, paraloc3, pushexceptres, setjmpres: tcgpara;
+        pd: tprocdef;
+        tmpresloc: tlocation;
+      begin
+        current_asmdata.getjumplabel(exceptstate.exceptionlabel);
+        exceptstate.oldflowcontrol:=flowcontrol;
+        exceptstate.finallycodelabel:=nil;;
+
+        paraloc1.init;
+        paraloc2.init;
+        paraloc3.init;
+
+        { fpc_pushexceptaddr(exceptionframetype, setjmp_buffer, exception_address_chain_entry) }
+        pd:=search_system_proc('fpc_pushexceptaddr');
+        paramanager.getintparaloc(current_asmdata.CurrAsmList,pd,1,paraloc1);
+        paramanager.getintparaloc(current_asmdata.CurrAsmList,pd,2,paraloc2);
+        paramanager.getintparaloc(current_asmdata.CurrAsmList,pd,3,paraloc3);
+        if pd.is_pushleftright then
+          begin
+            { type of exceptionframe }
+            hlcg.a_load_const_cgpara(list,paraloc1.def,1,paraloc1);
+            { setjmp buffer }
+            hlcg.a_loadaddr_ref_cgpara(list,rec_jmp_buf,t.jmpbuf,paraloc2);
+            { exception address chain entry }
+            hlcg.a_loadaddr_ref_cgpara(list,rec_exceptaddr,t.envbuf,paraloc3);
+          end
+        else
+          begin
+            hlcg.a_loadaddr_ref_cgpara(list,rec_exceptaddr,t.envbuf,paraloc3);
+            hlcg.a_loadaddr_ref_cgpara(list,rec_jmp_buf,t.jmpbuf,paraloc2);
+            hlcg.a_load_const_cgpara(list,paraloc1.def,1,paraloc1);
+          end;
+        paramanager.freecgpara(list,paraloc3);
+        paramanager.freecgpara(list,paraloc2);
+        paramanager.freecgpara(list,paraloc1);
+        { perform the fpc_pushexceptaddr call }
+        pushexceptres:=hlcg.g_call_system_proc(list,pd,[@paraloc1,@paraloc2,@paraloc3],nil);
+        paraloc1.done;
+        paraloc2.done;
+        paraloc3.done;
+
+        { get the result }
+        location_reset(tmpresloc,LOC_REGISTER,def_cgsize(pushexceptres.def));
+        tmpresloc.register:=hlcg.getaddressregister(list,pushexceptres.def);
+        hlcg.gen_load_cgpara_loc(list,pushexceptres.def,pushexceptres,tmpresloc,true);
+        pushexceptres.resetiftemp;
+
+        { fpc_setjmp(result_of_pushexceptaddr_call) }
+        pd:=search_system_proc('fpc_setjmp');
+        paramanager.getintparaloc(current_asmdata.CurrAsmList,pd,1,paraloc1);
+
+        hlcg.a_load_reg_cgpara(list,pushexceptres.def,tmpresloc.register,paraloc1);
+        paramanager.freecgpara(list,paraloc1);
+        { perform the fpc_setjmp call }
+        setjmpres:=hlcg.g_call_system_proc(list,pd,[@paraloc1],nil);
+        paraloc1.done;
+        location_reset(tmpresloc,LOC_REGISTER,def_cgsize(setjmpres.def));
+        tmpresloc.register:=hlcg.getintregister(list,setjmpres.def);
+        hlcg.gen_load_cgpara_loc(list,setjmpres.def,setjmpres,tmpresloc,true);
+        hlcg.g_exception_reason_save(list,setjmpres.def,ossinttype,tmpresloc.register,t.reasonbuf);
+        { if we get 1 here in the function result register, it means that we
+          longjmp'd back here }
+        hlcg.a_cmp_const_reg_label(list,setjmpres.def,OC_NE,0,tmpresloc.register,exceptstate.exceptionlabel);
+        setjmpres.resetiftemp;
+
+        flowcontrol:=[fc_inflowcontrol,fc_catching_exceptions];
+     end;
+
+
+    class procedure tcgexceptionstatehandler.emit_except_label(list: TAsmList; exceptframekind: texceptframekind; var exceptstate: texceptionstate;var exceptiontemps:texceptiontemps);
+      begin
+        hlcg.a_label(list,exceptstate.exceptionlabel);
+      end;
+
+
+    class procedure tcgexceptionstatehandler.end_try_block(list: TAsmList; exceptframekind: texceptframekind; const t: texceptiontemps; var exceptionstate: texceptionstate; endlabel: TAsmLabel);
+      begin
+         exceptionstate.newflowcontrol:=flowcontrol;
+         flowcontrol:=exceptionstate.oldflowcontrol;
+      end;
+
+
+    class procedure tcgexceptionstatehandler.free_exception(list: TAsmList; const t: texceptiontemps; const s: texceptionstate; a: aint; endexceptlabel: tasmlabel; onlyfree: boolean);
+      var
+        reasonreg: tregister;
+      begin
+         popaddrstack(list);
+         if not onlyfree then
+          begin
+            reasonreg:=hlcg.getintregister(list,osuinttype);
+            hlcg.g_exception_reason_load(list,osuinttype,osuinttype,t.reasonbuf,reasonreg);
+            hlcg.a_cmp_const_reg_label(list,osuinttype,OC_EQ,a,reasonreg,endexceptlabel);
+          end;
+      end;
+
+
+    { does the necessary things to clean up the object stack }
+    { in the except block                                    }
+    class procedure tcgexceptionstatehandler.cleanupobjectstack(list: TAsmList);
+      begin
+         hlcg.g_call_system_proc(list,'fpc_doneexception',[],nil).resetiftemp;
+      end;
+
+
+    { generates code to be executed when another exeception is raised while
+      control is inside except block }
+    class procedure tcgexceptionstatehandler.handle_nested_exception(list:TAsmList;var t:texceptiontemps;var entrystate: texceptionstate);
+      var
+         exitlabel: tasmlabel;
+      begin
+         current_asmdata.getjumplabel(exitlabel);
+         { add an catch all action clause, at least psabieh needs this }
+         catch_all_add(list);
+         end_try_block(list,tek_except,t,entrystate,exitlabel);
+         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);
+         { we don't need to save/restore registers here because reraise never }
+         { returns                                                            }
+         hlcg.g_call_system_proc(list,'fpc_raise_nested',[],nil).resetiftemp;
+         hlcg.a_label(list,exitlabel);
+         cleanupobjectstack(list);
+      end;
+
+
+    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;
+      end;
+
+
+    class procedure tcgexceptionstatehandler.begin_catch(list: TAsmList; excepttype: tobjectdef; nextonlabel: tasmlabel; out exceptlocdef: tdef; out exceptlocreg: tregister);
+      var
+        pd: tprocdef;
+        href2: treference;
+        fpc_catches_res,
+        paraloc1: tcgpara;
+        exceptloc: tlocation;
+        indirect: boolean;
+        otherunit: boolean;
+      begin
+        paraloc1.init;
+        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;
+
+        { send the vmt parameter }
+        pd:=search_system_proc('fpc_catches');
+        reference_reset_symbol(href2, current_asmdata.RefAsmSymbol(excepttype.vmt_mangledname, AT_DATA, indirect), 0, sizeof(pint), []);
+        if otherunit then
+          current_module.add_extern_asmsym(excepttype.vmt_mangledname, AB_EXTERNAL, AT_DATA);
+        paramanager.getintparaloc(list, pd, 1, paraloc1);
+        hlcg.a_loadaddr_ref_cgpara(list, excepttype.vmt_def, href2, paraloc1);
+        paramanager.freecgpara(list, paraloc1);
+        fpc_catches_res:=hlcg.g_call_system_proc(list, pd, [@paraloc1], nil);
+        location_reset(exceptloc, LOC_REGISTER, def_cgsize(fpc_catches_res.def));
+        exceptloc.register:=hlcg.getaddressregister(list, fpc_catches_res.def);
+        hlcg.gen_load_cgpara_loc(list, fpc_catches_res.def, fpc_catches_res, exceptloc, true);
+
+        { is it this catch? No. go to next onlabel }
+        hlcg.a_cmp_const_reg_label(list, fpc_catches_res.def, OC_EQ, 0, exceptloc.register, nextonlabel);
+
+        paraloc1.done;
+
+        exceptlocdef:=fpc_catches_res.def;
+        exceptlocreg:=exceptloc.register;
+      end;
+
+
+    class procedure tcgexceptionstatehandler.end_catch(list: TAsmList);
+      begin
+        { nothing to do by default }
+      end;
+
+
+    class procedure tcgexceptionstatehandler.catch_all_start(list: TAsmList);
+      begin
+        { nothing to do by default }
+      end;
+
+
+    class procedure tcgexceptionstatehandler.catch_all_add(list: TAsmList);
+      begin
+        { nothing to do by default }
+      end;
+
+
+    class procedure tcgexceptionstatehandler.catch_all_end(list: TAsmList);
+      begin
+        { nothing to do by default }
+      end;
+
+    class procedure tcgexceptionstatehandler.popaddrstack(list: TAsmList);
+      begin
+        hlcg.g_call_system_proc(list,'fpc_popaddrstack',[],nil).resetiftemp;
+      end;
+
+
+end.
+

compiler/llvm/llvmpi.pas

@@ -30,7 +30,7 @@ interface
       aasmbase,
       procinfo,
       cpupi,
-      aasmllvm;
+      aasmdata,aasmllvm;
 
     type
       tllvmprocinfo = class(tcpuprocinfo)
@@ -49,14 +49,327 @@ interface
         function currlandingpad: taillvm;
         procedure setup_eh; override;
         procedure finish_eh; override;
+        procedure start_eh(list: TAsmList); override;
+        procedure end_eh(list: TAsmList); override;
       end;
 
 implementation
 
     uses
       globtype,globals,verbose,systems,
-      symconst,symtable;
+      symconst,symtype,symdef,symsym,symtable,defutil,llvmdef,
+      pass_2,
+      parabase,paramgr,
+      cgbase,cgutils,cgexcept,tgobj,hlcgobj,llvmbase;
 
+    {*****************************************************************************
+                         tllvmexceptionstatehandler
+    *****************************************************************************}
+
+    type
+      tllvmexceptionstatehandler = class(tcgexceptionstatehandler)
+        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;
+        class procedure emit_except_label(list: TAsmList; exceptframekind: texceptframekind; var exceptionstate: texceptionstate;var exceptiontemps:texceptiontemps); override;
+        class procedure end_try_block(list: TAsmList; exceptframekind: texceptframekind; const t: texceptiontemps; var exceptionstate: texceptionstate; endlabel: TAsmLabel); override;
+        class procedure cleanupobjectstack(list: TAsmList); override;
+        class procedure popaddrstack(list: TAsmList); override;
+        class procedure handle_reraise(list: TAsmList; const t: texceptiontemps; const entrystate: texceptionstate; const exceptframekind: texceptframekind); override;
+        class procedure begin_catch(list: TAsmList; excepttype: tobjectdef; nextonlabel: tasmlabel; out exceptlocdef: tdef; out exceptlocreg: tregister); override;
+        class procedure end_catch(list: TAsmList); override;
+        class procedure catch_all_start(list: TAsmList); override;
+        class procedure catch_all_end(list: TAsmList); override;
+       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);
+      end;
+
+
+      class procedure tllvmexceptionstatehandler.get_exception_temps(list: TAsmList; var t: texceptiontemps);
+        begin
+          tg.gethltemp(list,ossinttype,ossinttype.size,tt_persistent,t.reasonbuf);
+        end;
+
+
+      class procedure tllvmexceptionstatehandler.unget_exception_temps(list: TAsmList; const t: texceptiontemps);
+        begin
+          tg.ungettemp(list,t.reasonbuf);
+          tllvmprocinfo(current_procinfo).poppad;
+        end;
+
+
+      class procedure tllvmexceptionstatehandler.new_exception(list: TAsmList; const t: texceptiontemps; const exceptframekind: texceptframekind; out exceptstate: texceptionstate);
+        var
+          reg: tregister;
+        begin
+          exceptstate.oldflowcontrol:=flowcontrol;
+          if exceptframekind<>tek_except then
+            current_asmdata.getjumplabel(exceptstate.finallycodelabel)
+          else
+            exceptstate.finallycodelabel:=nil;
+          { all calls inside the exception block have to be invokes instead,
+            which refer to the exception label:
+              exceptionlabel:
+                %reg = landingpad ..
+                <exception handling code>
+          }
+          current_asmdata.getjumplabel(exceptstate.exceptionlabel);
+          { for consistency checking when popping }
+          tllvmprocinfo(current_procinfo).pushexceptlabel(exceptstate.exceptionlabel);
+          flowcontrol:=[fc_inflowcontrol,fc_catching_exceptions];
+          { the reasonbuf is set to 1 by the generic code if we got in
+            the exception block by catching an exception -> do the same here, so
+            we can share that generic code; llvm will optimise it away. The
+            reasonbuf is later also used for break/continue/... }
+          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);
+          { There can only be a landingpad if there were any invokes in the try-block,
+            as otherwise we get an error; we can also generate exceptions from
+            invalid memory accesses and the like, but LLVM cannot model that
+            --
+            We cheat for now by adding an invoke to a dummy routine at the start and at
+            the end of the try-block. That will not magically fix the state
+            of all variables when the exception gets caught though. }
+          hlcg.g_call_system_proc(list,'FPC_DUMMYPOTENTIALRAISE',[],nil).resetiftemp;
+        end;
+
+
+      class procedure tllvmexceptionstatehandler.emit_except_label(list: TAsmList; exceptframekind: texceptframekind; var exceptionstate: texceptionstate;var exceptiontemps:texceptiontemps);
+        var
+          reg: tregister;
+          landingpad: taillvm;
+          landingpaddef: trecorddef;
+        begin
+          hlcg.g_unreachable(list);
+          hlcg.a_label(list,exceptionstate.exceptionlabel);
+          { use packrecords 1 because we don't want padding (LLVM 4.0+ requires
+            exactly two fields in this struct) }
+          landingpaddef:=llvmgettemprecorddef([voidpointertype,u32inttype],
+            1,
+            targetinfos[target_info.system]^.alignment.recordalignmin,
+            targetinfos[target_info.system]^.alignment.maxCrecordalign);
+          reg:=hlcg.getregisterfordef(list,landingpaddef);
+          landingpad:=taillvm.landingpad(reg,landingpaddef,{clause}nil);
+          list.concat(landingpad);
+          if exceptframekind<>tek_except then
+            begin
+              if not assigned(exceptionstate.finallycodelabel) then
+                internalerror(2018111102);
+              if use_cleanup(exceptframekind) then
+                landingpad.landingpad_add_clause(la_cleanup, nil, nil)
+              else
+                landingpad.landingpad_add_clause(la_catch, voidpointertype, nil);
+              hlcg.a_label(list,exceptionstate.finallycodelabel);
+              exceptionstate.finallycodelabel:=nil;
+            end;
+          { consistency check }
+          tllvmprocinfo(current_procinfo).popexceptlabel(exceptionstate.exceptionlabel);
+          tllvmprocinfo(current_procinfo).pushlandingpad(landingpad);
+        end;
+
+
+      class procedure tllvmexceptionstatehandler.end_try_block(list: TAsmList; exceptframekind: texceptframekind; const t: texceptiontemps; var exceptionstate: texceptionstate; endlabel: TAsmLabel);
+        var
+          reg: tregister;
+        begin
+          { llvm does not allow creating a landing pad if there are no invokes in
+            the try block -> create a call to a dummy routine that cannot be
+            analysed by llvm and that supposedly may raise an exception. Has to
+            be combined with marking stores inside try blocks as volatile and the
+            loads afterwards as well in order to guarantee correct optimizations
+            in case an exception gets triggered inside a try-block though }
+          hlcg.g_call_system_proc(list,'FPC_DUMMYPOTENTIALRAISE',[],nil).resetiftemp;
+
+          { record that no exception happened in the reason buf }
+          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);
+          inherited;
+          if exceptframekind=tek_except then
+            hlcg.a_jmp_always(list,endlabel);
+        end;
+
+      class procedure tllvmexceptionstatehandler.cleanupobjectstack(list: TAsmList);
+        var
+          landingpad: taillvm;
+        begin
+          { if not a single catch block added -> catch all }
+          landingpad:=tllvmprocinfo(current_procinfo).currlandingpad;
+          if assigned(landingpad) and
+             not assigned(landingpad.oper[2]^.ai) then
+            begin
+              landingpad.landingpad_add_clause(la_catch,voidpointertype,nil);
+            end;
+        end;
+
+      class procedure tllvmexceptionstatehandler.popaddrstack(list: TAsmList);
+        begin
+          // nothing
+        end;
+
+
+      class procedure tllvmexceptionstatehandler.handle_reraise(list: TAsmList; const t: texceptiontemps; const entrystate: texceptionstate; const exceptframekind: texceptframekind);
+        var
+          landingpad: taillvm;
+          landingpadres: tregister;
+          landingpadresdef: tdef;
+        begin
+          { We use resume to propagate the exception to an outer function frame, and call
+            reraise in case we are nested in another exception frame in the current function
+            (because then we will emit an invoke which will tie this re-raise to that other
+             exception frame; that is impossible to do with a resume instruction).
+
+            Furthermore, the resume opcode only works for landingpads with a cleanup clause,
+            which we only generate for outer implicitfinally frames }
+          if not(fc_catching_exceptions in flowcontrol) and
+             use_cleanup(exceptframekind) then
+            begin
+              { resume <result from catchpad> }
+              landingpad:=tllvmprocinfo(current_procinfo).currlandingpad;
+              landingpadres:=landingpad.oper[0]^.reg;
+              landingpadresdef:=landingpad.oper[1]^.def;
+              list.concat(taillvm.op_size_reg(la_resume,landingpadresdef,landingpadres));
+            end
+          else
+            begin
+              { Need a begin_catch so that the reraise will know what exception to throw.
+                Don't need to add a "catch all" to the landing pad, as it contains one.
+                We want to rethrow whatever exception was caught rather than guarantee
+                that all possible kinds of exceptions get caught. }
+              catch_all_start_internal(list,false);
+              hlcg.g_call_system_proc(list,'fpc_reraise',[],nil).resetiftemp;
+            end;
+        end;
+
+
+      class procedure tllvmexceptionstatehandler.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 tllvmexceptionstatehandler.end_catch(list: TAsmList);
+        begin
+          hlcg.g_call_system_proc(list,'fpc_psabi_end_catch',[],nil).resetiftemp;
+          inherited;
+        end;
+
+
+      class procedure tllvmexceptionstatehandler.catch_all_start(list: TAsmList);
+        begin
+          catch_all_start_internal(list,true);
+        end;
+
+
+      class procedure tllvmexceptionstatehandler.catch_all_end(list: TAsmList);
+        begin
+          hlcg.g_call_system_proc(list,'fpc_psabi_end_catch',[],nil).resetiftemp;
+        end;
+
+
+      class procedure tllvmexceptionstatehandler.begin_catch_internal(list: TAsmList; excepttype: tobjectdef; nextonlabel: tasmlabel; add_catch: boolean; out exceptlocdef: tdef; out exceptlocreg: tregister);
+        var
+          catchstartlab: tasmlabel;
+          landingpad: taillvm;
+          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;
+        begin
+          paraloc1.init;
+          landingpad:=tllvmprocinfo(current_procinfo).currlandingpad;
+          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);
+                  landingpad.landingpad_add_clause(la_catch,rttidef,rttisym);
+                end
+              else
+                begin
+                  landingpad.landingpad_add_clause(la_catch,voidpointertype,nil);
+                end;
+            end;
+          { pascal_exception := FPC_psabi_begin_catch(wrappedExceptionObject) where
+            wrappedExceptionObject is the exception returned by the landingpad }
+          landingpadres:=landingpad.oper[0]^.reg;
+          landingpadstructdef:=landingpad.oper[1]^.def;
+          { check if the exception is handled by this node }
+          if assigned(excepttype) then
+            begin
+              landingpadtypeiddef:=tfieldvarsym(trecorddef(landingpadstructdef).symtable.symlist[1]).vardef;
+              exceptiontypeidreg:=hlcg.getaddressregister(list,landingpadtypeiddef);
+              pd:=search_system_proc('llvm_eh_typeid_for');
+              paramanager.getintparaloc(list,pd,1,paraloc1);
+              reference_reset_symbol(rttiref,rttisym,0,rttidef.alignment,[]);
+              rttiref.refaddr:=addr_full;
+              hlcg.a_load_ref_cgpara(list,cpointerdef.getreusable(rttidef),rttiref,paraloc1);
+              typeidres:=hlcg.g_call_system_proc(list,pd,[@paraloc1],nil);
+              location_reset(exceptloc, LOC_REGISTER, def_cgsize(landingpadtypeiddef));
+              exceptloc.register:=hlcg.getintregister(list,landingpadtypeiddef);
+              hlcg.gen_load_cgpara_loc(list, landingpadtypeiddef, typeidres, exceptloc, true);
+              list.concat(taillvm.extract(la_extractvalue,exceptiontypeidreg,landingpadstructdef,landingpadres,1));
+              current_asmdata.getjumplabel(catchstartlab);
+              hlcg.a_cmp_reg_loc_label(list,typeidres.Def,OC_EQ,exceptiontypeidreg,exceptloc,catchstartlab);
+              hlcg.a_jmp_always(list,nextonlabel);
+              hlcg.a_label(list,catchstartlab);
+              typeidres.resetiftemp;
+            end;
+
+          wrappedexception:=hlcg.getaddressregister(list,voidpointertype);
+          list.concat(taillvm.extract(la_extractvalue,wrappedexception,landingpadstructdef,landingpadres,0));
+
+          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 tllvmexceptionstatehandler.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;
+
+
+
+{*****************************************************************************
+                     tllvmprocinfo
+*****************************************************************************}
 
     constructor tllvmprocinfo.create(aparent: tprocinfo);
       begin
@@ -124,7 +437,11 @@ implementation
     procedure tllvmprocinfo.setup_eh;
       begin
         if po_assembler in procdef.procoptions then
-          inherited;
+          inherited
+        else
+          begin
+            cexceptionstatehandler:=tllvmexceptionstatehandler;
+          end;
       end;
 
 
@@ -135,6 +452,20 @@ implementation
       end;
 
 
+    procedure tllvmprocinfo.start_eh(list: TAsmList);
+      begin
+        if po_assembler in procdef.procoptions then
+          inherited;
+      end;
+
+
+    procedure tllvmprocinfo.end_eh(list: TAsmList);
+      begin
+        if po_assembler in procdef.procoptions then
+          inherited;
+      end;
+
+
 begin
   if not assigned(cprocinfo) then
     begin

compiler/llvm/nllvmflw.pas

@@ -37,24 +37,6 @@ interface
         function getasmlabel: tasmlabel; override;
       end;
 
-    tllvmexceptionstatehandler = class(tcgexceptionstatehandler)
-      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;
-      class procedure emit_except_label(list: TAsmList; exceptframekind: texceptframekind; var exceptionstate: texceptionstate;var exceptiontemps:texceptiontemps); override;
-      class procedure end_try_block(list: TAsmList; exceptframekind: texceptframekind; const t: texceptiontemps; var exceptionstate: texceptionstate; endlabel: TAsmLabel); override;
-      class procedure cleanupobjectstack(list: TAsmList); override;
-      class procedure popaddrstack(list: TAsmList); override;
-      class procedure handle_reraise(list: TAsmList; const t: texceptiontemps; const entrystate: texceptionstate; const exceptframekind: texceptframekind); override;
-      class procedure begin_catch(list: TAsmList; excepttype: tobjectdef; nextonlabel: tasmlabel; out exceptlocdef: tdef; out exceptlocreg: tregister); override;
-      class procedure end_catch(list: TAsmList); override;
-      class procedure catch_all_start(list: TAsmList); override;
-      class procedure catch_all_end(list: TAsmList); override;
-     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);
-    end;
-
     tllvmtryexceptnode = class(tcgtryexceptnode)
     end;
 
@@ -114,290 +96,7 @@ implementation
 
 
 {*****************************************************************************
-                     tllvmexceptionstatehandler
-*****************************************************************************}
-
-    class procedure tllvmexceptionstatehandler.get_exception_temps(list: TAsmList; var t: texceptiontemps);
-      begin
-        tg.gethltemp(list,ossinttype,ossinttype.size,tt_persistent,t.reasonbuf);
-      end;
-
-
-    class procedure tllvmexceptionstatehandler.unget_exception_temps(list: TAsmList; const t: texceptiontemps);
-      begin
-        tg.ungettemp(list,t.reasonbuf);
-        tllvmprocinfo(current_procinfo).poppad;
-      end;
-
-
-    class procedure tllvmexceptionstatehandler.new_exception(list: TAsmList; const t: texceptiontemps; const exceptframekind: texceptframekind; out exceptstate: texceptionstate);
-      var
-        reg: tregister;
-      begin
-        exceptstate.oldflowcontrol:=flowcontrol;
-        if exceptframekind<>tek_except then
-          current_asmdata.getjumplabel(exceptstate.finallycodelabel)
-        else
-          exceptstate.finallycodelabel:=nil;
-        { all calls inside the exception block have to be invokes instead,
-          which refer to the exception label:
-            exceptionlabel:
-              %reg = landingpad ..
-              <exception handling code>
-        }
-        current_asmdata.getjumplabel(exceptstate.exceptionlabel);
-        { for consistency checking when popping }
-        tllvmprocinfo(current_procinfo).pushexceptlabel(exceptstate.exceptionlabel);
-        flowcontrol:=[fc_inflowcontrol,fc_catching_exceptions];
-        { the reasonbuf is set to 1 by the generic code if we got in
-          the exception block by catching an exception -> do the same here, so
-          we can share that generic code; llvm will optimise it away. The
-          reasonbuf is later also used for break/continue/... }
-        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);
-        { There can only be a landingpad if there were any invokes in the try-block,
-          as otherwise we get an error; we can also generate exceptions from
-          invalid memory accesses and the like, but LLVM cannot model that
-          --
-          We cheat for now by adding an invoke to a dummy routine at the start and at
-          the end of the try-block. That will not magically fix the state
-          of all variables when the exception gets caught though. }
-        hlcg.g_call_system_proc(list,'FPC_DUMMYPOTENTIALRAISE',[],nil).resetiftemp;
-      end;
-
-
-    class procedure tllvmexceptionstatehandler.emit_except_label(list: TAsmList; exceptframekind: texceptframekind; var exceptionstate: texceptionstate;var exceptiontemps:texceptiontemps);
-      var
-        reg: tregister;
-        landingpad: taillvm;
-        landingpaddef: trecorddef;
-      begin
-        hlcg.g_unreachable(list);
-        hlcg.a_label(list,exceptionstate.exceptionlabel);
-        { use packrecords 1 because we don't want padding (LLVM 4.0+ requires
-          exactly two fields in this struct) }
-        landingpaddef:=llvmgettemprecorddef([voidpointertype,u32inttype],
-          1,
-          targetinfos[target_info.system]^.alignment.recordalignmin,
-          targetinfos[target_info.system]^.alignment.maxCrecordalign);
-        reg:=hlcg.getregisterfordef(list,landingpaddef);
-        landingpad:=taillvm.landingpad(reg,landingpaddef,{clause}nil);
-        list.concat(landingpad);
-        if exceptframekind<>tek_except then
-          begin
-            if not assigned(exceptionstate.finallycodelabel) then
-              internalerror(2018111102);
-            if use_cleanup(exceptframekind) then
-              landingpad.landingpad_add_clause(la_cleanup, nil, nil)
-            else
-              landingpad.landingpad_add_clause(la_catch, voidpointertype, nil);
-            hlcg.a_label(list,exceptionstate.finallycodelabel);
-            exceptionstate.finallycodelabel:=nil;
-          end;
-        { consistency check }
-        tllvmprocinfo(current_procinfo).popexceptlabel(exceptionstate.exceptionlabel);
-        tllvmprocinfo(current_procinfo).pushlandingpad(landingpad);
-      end;
-
-
-    class procedure tllvmexceptionstatehandler.end_try_block(list: TAsmList; exceptframekind: texceptframekind; const t: texceptiontemps; var exceptionstate: texceptionstate; endlabel: TAsmLabel);
-      var
-        reg: tregister;
-      begin
-        { llvm does not allow creating a landing pad if there are no invokes in
-          the try block -> create a call to a dummy routine that cannot be
-          analysed by llvm and that supposedly may raise an exception. Has to
-          be combined with marking stores inside try blocks as volatile and the
-          loads afterwards as well in order to guarantee correct optimizations
-          in case an exception gets triggered inside a try-block though }
-        hlcg.g_call_system_proc(list,'FPC_DUMMYPOTENTIALRAISE',[],nil).resetiftemp;
-
-        { record that no exception happened in the reason buf }
-        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);
-        inherited;
-        if exceptframekind=tek_except then
-          hlcg.a_jmp_always(list,endlabel);
-      end;
-
-    class procedure tllvmexceptionstatehandler.cleanupobjectstack(list: TAsmList);
-      var
-        landingpad: taillvm;
-      begin
-        { if not a single catch block added -> catch all }
-        landingpad:=tllvmprocinfo(current_procinfo).currlandingpad;
-        if assigned(landingpad) and
-           not assigned(landingpad.oper[2]^.ai) then
-          begin
-            landingpad.landingpad_add_clause(la_catch,voidpointertype,nil);
-          end;
-      end;
-
-    class procedure tllvmexceptionstatehandler.popaddrstack(list: TAsmList);
-      begin
-        // nothing
-      end;
-
-
-    class procedure tllvmexceptionstatehandler.handle_reraise(list: TAsmList; const t: texceptiontemps; const entrystate: texceptionstate; const exceptframekind: texceptframekind);
-      var
-        landingpad: taillvm;
-        landingpadres: tregister;
-        landingpadresdef: tdef;
-      begin
-        { We use resume to propagate the exception to an outer function frame, and call
-          reraise in case we are nested in another exception frame in the current function
-          (because then we will emit an invoke which will tie this re-raise to that other
-           exception frame; that is impossible to do with a resume instruction).
-
-          Furthermore, the resume opcode only works for landingpads with a cleanup clause,
-          which we only generate for outer implicitfinally frames }
-        if not(fc_catching_exceptions in flowcontrol) and
-           use_cleanup(exceptframekind) then
-          begin
-            { resume <result from catchpad> }
-            landingpad:=tllvmprocinfo(current_procinfo).currlandingpad;
-            landingpadres:=landingpad.oper[0]^.reg;
-            landingpadresdef:=landingpad.oper[1]^.def;
-            list.concat(taillvm.op_size_reg(la_resume,landingpadresdef,landingpadres));
-          end
-        else
-          begin
-            { Need a begin_catch so that the reraise will know what exception to throw.
-              Don't need to add a "catch all" to the landing pad, as it contains one.
-              We want to rethrow whatever exception was caught rather than guarantee
-              that all possible kinds of exceptions get caught. }
-            catch_all_start_internal(list,false);
-            hlcg.g_call_system_proc(list,'fpc_reraise',[],nil).resetiftemp;
-          end;
-      end;
-
-
-    class procedure tllvmexceptionstatehandler.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 tllvmexceptionstatehandler.end_catch(list: TAsmList);
-      begin
-        hlcg.g_call_system_proc(list,'fpc_psabi_end_catch',[],nil).resetiftemp;
-        inherited;
-      end;
-
-
-    class procedure tllvmexceptionstatehandler.catch_all_start(list: TAsmList);
-      begin
-        catch_all_start_internal(list,true);
-      end;
-
-
-    class procedure tllvmexceptionstatehandler.catch_all_end(list: TAsmList);
-      begin
-        hlcg.g_call_system_proc(list,'fpc_psabi_end_catch',[],nil).resetiftemp;
-      end;
-
-
-    class procedure tllvmexceptionstatehandler.begin_catch_internal(list: TAsmList; excepttype: tobjectdef; nextonlabel: tasmlabel; add_catch: boolean; out exceptlocdef: tdef; out exceptlocreg: tregister);
-      var
-        catchstartlab: tasmlabel;
-        landingpad: taillvm;
-        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;
-      begin
-        paraloc1.init;
-        landingpad:=tllvmprocinfo(current_procinfo).currlandingpad;
-        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);
-                landingpad.landingpad_add_clause(la_catch,rttidef,rttisym);
-              end
-            else
-              begin
-                landingpad.landingpad_add_clause(la_catch,voidpointertype,nil);
-              end;
-          end;
-        { pascal_exception := FPC_psabi_begin_catch(wrappedExceptionObject) where
-          wrappedExceptionObject is the exception returned by the landingpad }
-        landingpadres:=landingpad.oper[0]^.reg;
-        landingpadstructdef:=landingpad.oper[1]^.def;
-        { check if the exception is handled by this node }
-        if assigned(excepttype) then
-          begin
-            landingpadtypeiddef:=tfieldvarsym(trecorddef(landingpadstructdef).symtable.symlist[1]).vardef;
-            exceptiontypeidreg:=hlcg.getaddressregister(list,landingpadtypeiddef);
-            pd:=search_system_proc('llvm_eh_typeid_for');
-            paramanager.getintparaloc(list,pd,1,paraloc1);
-            reference_reset_symbol(rttiref,rttisym,0,rttidef.alignment,[]);
-            rttiref.refaddr:=addr_full;
-            hlcg.a_load_ref_cgpara(list,cpointerdef.getreusable(rttidef),rttiref,paraloc1);
-            typeidres:=hlcg.g_call_system_proc(list,pd,[@paraloc1],nil);
-            location_reset(exceptloc, LOC_REGISTER, def_cgsize(landingpadtypeiddef));
-            exceptloc.register:=hlcg.getintregister(list,landingpadtypeiddef);
-            hlcg.gen_load_cgpara_loc(list, landingpadtypeiddef, typeidres, exceptloc, true);
-            list.concat(taillvm.extract(la_extractvalue,exceptiontypeidreg,landingpadstructdef,landingpadres,1));
-            current_asmdata.getjumplabel(catchstartlab);
-            hlcg.a_cmp_reg_loc_label(list,typeidres.Def,OC_EQ,exceptiontypeidreg,exceptloc,catchstartlab);
-            hlcg.a_jmp_always(list,nextonlabel);
-            hlcg.a_label(list,catchstartlab);
-            typeidres.resetiftemp;
-          end;
-
-        wrappedexception:=hlcg.getaddressregister(list,voidpointertype);
-        list.concat(taillvm.extract(la_extractvalue,wrappedexception,landingpadstructdef,landingpadres,0));
-
-        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 tllvmexceptionstatehandler.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;
-
-{*****************************************************************************
-                     tllvmexceptionstatehandler
+                             tllvmraisenode
 *****************************************************************************}
 
     function tllvmraisenode.pass_1: tnode;
@@ -438,7 +137,6 @@ begin
   clabelnode:=tllvmlabelnode;
   ctryexceptnode:=tllvmtryexceptnode;
   ctryfinallynode:=tllvmtryfinallynode;
-  cexceptionstatehandler:=tllvmexceptionstatehandler;
   craisenode:=tllvmraisenode;
 end.
 

compiler/ncgflw.pas

@@ -31,7 +31,7 @@ interface
       symtype,symdef,
       aasmbase,aasmdata,
       node,nflw,
-      pass_2,cgbase,cgutils,ncgutil;
+      pass_2,cgbase,cgutils,ncgutil,cgexcept;
 
     type
        tcgwhilerepeatnode = class(twhilerepeatnode)
@@ -80,57 +80,6 @@ interface
 {$endif jvm}
        end;
 
-       { 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. }
-       tcgexceptionstatehandler = class
-        type
-         texceptiontemps=record
-           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_resume }
-           unwind_info : TRegister;
-         end;
-
-         texceptionstate = record
-           exceptionlabel: TAsmLabel;
-           oldflowcontrol,
-           newflowcontrol: tflowcontrol;
-           finallycodelabel  : TAsmLabel;
-         end;
-
-         texceptframekind = (tek_except, tek_implicitfinally, tek_normalfinally);
-
-         class procedure get_exception_temps(list:TAsmList;var t:texceptiontemps); virtual;
-         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;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;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;
-         { end of an "on" (catch) block }
-         class procedure end_catch(list: TAsmList); virtual;
-         { called for a catch all exception }
-         class procedure catch_all_start(list: TAsmList); virtual;
-         { called after the catch all exception has been started with new_exception }
-         class procedure catch_all_add(list: TAsmList); virtual;
-         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;
-
        tcgtryexceptnode = class(ttryexceptnode)
         protected
           type
@@ -155,9 +104,6 @@ interface
        end;
 
 
-     var
-       cexceptionstatehandler: tcgexceptionstatehandlerclass;
-
 implementation
 
     uses
@@ -572,254 +518,6 @@ implementation
       end;
 
 
-{*****************************************************************************
-                     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.
-
-       Then compare the result of setjmp with 0, and if not equal
-       to zero, then jump to exceptlabel.
-
-       Also store the result of setjmp to a temporary space by calling g_save_exception_reason
-
-       It is to note that this routine may be called *after* the stackframe of a
-       routine has been called, therefore on machines where the stack cannot
-       be modified, all temps should be allocated on the heap instead of the
-       stack. }
-
-
-    class procedure tcgexceptionstatehandler.get_exception_temps(list:TAsmList;var t:texceptiontemps);
-     begin
-        tg.gethltemp(list,rec_exceptaddr,rec_exceptaddr.size,tt_persistent,t.envbuf);
-        tg.gethltemp(list,rec_jmp_buf,rec_jmp_buf.size,tt_persistent,t.jmpbuf);
-        tg.gethltemp(list,ossinttype,ossinttype.size,tt_persistent,t.reasonbuf);
-      end;
-
-
-    class procedure tcgexceptionstatehandler.unget_exception_temps(list:TAsmList;const t:texceptiontemps);
-      begin
-        tg.Ungettemp(list,t.jmpbuf);
-        tg.ungettemp(list,t.envbuf);
-        tg.ungettemp(list,t.reasonbuf);
-      end;
-
-
-    class procedure tcgexceptionstatehandler.new_exception(list:TAsmList;const t:texceptiontemps; const exceptframekind: texceptframekind; out exceptstate: texceptionstate);
-      var
-        paraloc1, paraloc2, paraloc3, pushexceptres, setjmpres: tcgpara;
-        pd: tprocdef;
-        tmpresloc: tlocation;
-      begin
-        current_asmdata.getjumplabel(exceptstate.exceptionlabel);
-        exceptstate.oldflowcontrol:=flowcontrol;
-        exceptstate.finallycodelabel:=nil;;
-
-        paraloc1.init;
-        paraloc2.init;
-        paraloc3.init;
-
-        { fpc_pushexceptaddr(exceptionframetype, setjmp_buffer, exception_address_chain_entry) }
-        pd:=search_system_proc('fpc_pushexceptaddr');
-        paramanager.getintparaloc(current_asmdata.CurrAsmList,pd,1,paraloc1);
-        paramanager.getintparaloc(current_asmdata.CurrAsmList,pd,2,paraloc2);
-        paramanager.getintparaloc(current_asmdata.CurrAsmList,pd,3,paraloc3);
-        if pd.is_pushleftright then
-          begin
-            { type of exceptionframe }
-            hlcg.a_load_const_cgpara(list,paraloc1.def,1,paraloc1);
-            { setjmp buffer }
-            hlcg.a_loadaddr_ref_cgpara(list,rec_jmp_buf,t.jmpbuf,paraloc2);
-            { exception address chain entry }
-            hlcg.a_loadaddr_ref_cgpara(list,rec_exceptaddr,t.envbuf,paraloc3);
-          end
-        else
-          begin
-            hlcg.a_loadaddr_ref_cgpara(list,rec_exceptaddr,t.envbuf,paraloc3);
-            hlcg.a_loadaddr_ref_cgpara(list,rec_jmp_buf,t.jmpbuf,paraloc2);
-            hlcg.a_load_const_cgpara(list,paraloc1.def,1,paraloc1);
-          end;
-        paramanager.freecgpara(list,paraloc3);
-        paramanager.freecgpara(list,paraloc2);
-        paramanager.freecgpara(list,paraloc1);
-        { perform the fpc_pushexceptaddr call }
-        pushexceptres:=hlcg.g_call_system_proc(list,pd,[@paraloc1,@paraloc2,@paraloc3],nil);
-        paraloc1.done;
-        paraloc2.done;
-        paraloc3.done;
-
-        { get the result }
-        location_reset(tmpresloc,LOC_REGISTER,def_cgsize(pushexceptres.def));
-        tmpresloc.register:=hlcg.getaddressregister(list,pushexceptres.def);
-        hlcg.gen_load_cgpara_loc(list,pushexceptres.def,pushexceptres,tmpresloc,true);
-        pushexceptres.resetiftemp;
-
-        { fpc_setjmp(result_of_pushexceptaddr_call) }
-        pd:=search_system_proc('fpc_setjmp');
-        paramanager.getintparaloc(current_asmdata.CurrAsmList,pd,1,paraloc1);
-
-        hlcg.a_load_reg_cgpara(list,pushexceptres.def,tmpresloc.register,paraloc1);
-        paramanager.freecgpara(list,paraloc1);
-        { perform the fpc_setjmp call }
-        setjmpres:=hlcg.g_call_system_proc(list,pd,[@paraloc1],nil);
-        paraloc1.done;
-        location_reset(tmpresloc,LOC_REGISTER,def_cgsize(setjmpres.def));
-        tmpresloc.register:=hlcg.getintregister(list,setjmpres.def);
-        hlcg.gen_load_cgpara_loc(list,setjmpres.def,setjmpres,tmpresloc,true);
-        hlcg.g_exception_reason_save(list,setjmpres.def,ossinttype,tmpresloc.register,t.reasonbuf);
-        { if we get 1 here in the function result register, it means that we
-          longjmp'd back here }
-        hlcg.a_cmp_const_reg_label(list,setjmpres.def,OC_NE,0,tmpresloc.register,exceptstate.exceptionlabel);
-        setjmpres.resetiftemp;
-
-        flowcontrol:=[fc_inflowcontrol,fc_catching_exceptions];
-     end;
-
-
-    class procedure tcgexceptionstatehandler.emit_except_label(list: TAsmList; exceptframekind: texceptframekind; var exceptstate: texceptionstate;var exceptiontemps:texceptiontemps);
-      begin
-        hlcg.a_label(list,exceptstate.exceptionlabel);
-      end;
-
-
-    class procedure tcgexceptionstatehandler.end_try_block(list: TAsmList; exceptframekind: texceptframekind; const t: texceptiontemps; var exceptionstate: texceptionstate; endlabel: TAsmLabel);
-      begin
-         exceptionstate.newflowcontrol:=flowcontrol;
-         flowcontrol:=exceptionstate.oldflowcontrol;
-      end;
-
-
-    class procedure tcgexceptionstatehandler.free_exception(list: TAsmList; const t: texceptiontemps; const s: texceptionstate; a: aint; endexceptlabel: tasmlabel; onlyfree: boolean);
-      var
-        reasonreg: tregister;
-      begin
-         popaddrstack(list);
-         if not onlyfree then
-          begin
-            reasonreg:=hlcg.getintregister(list,osuinttype);
-            hlcg.g_exception_reason_load(list,osuinttype,osuinttype,t.reasonbuf,reasonreg);
-            hlcg.a_cmp_const_reg_label(list,osuinttype,OC_EQ,a,reasonreg,endexceptlabel);
-          end;
-      end;
-
-
-    { does the necessary things to clean up the object stack }
-    { in the except block                                    }
-    class procedure tcgexceptionstatehandler.cleanupobjectstack(list: TAsmList);
-      begin
-         hlcg.g_call_system_proc(list,'fpc_doneexception',[],nil).resetiftemp;
-      end;
-
-
-    { generates code to be executed when another exeception is raised while
-      control is inside except block }
-    class procedure tcgexceptionstatehandler.handle_nested_exception(list:TAsmList;var t:texceptiontemps;var entrystate: texceptionstate);
-      var
-         exitlabel: tasmlabel;
-      begin
-         current_asmdata.getjumplabel(exitlabel);
-         { add an catch all action clause, at least psabieh needs this }
-         catch_all_add(list);
-         end_try_block(list,tek_except,t,entrystate,exitlabel);
-         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);
-         { we don't need to save/restore registers here because reraise never }
-         { returns                                                            }
-         hlcg.g_call_system_proc(list,'fpc_raise_nested',[],nil).resetiftemp;
-         hlcg.a_label(list,exitlabel);
-         cleanupobjectstack(list);
-      end;
-
-
-    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;
-      end;
-
-
-    class procedure tcgexceptionstatehandler.begin_catch(list: TAsmList; excepttype: tobjectdef; nextonlabel: tasmlabel; out exceptlocdef: tdef; out exceptlocreg: tregister);
-      var
-        pd: tprocdef;
-        href2: treference;
-        fpc_catches_res,
-        paraloc1: tcgpara;
-        exceptloc: tlocation;
-        indirect: boolean;
-        otherunit: boolean;
-      begin
-        paraloc1.init;
-        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;
-
-        { send the vmt parameter }
-        pd:=search_system_proc('fpc_catches');
-        reference_reset_symbol(href2, current_asmdata.RefAsmSymbol(excepttype.vmt_mangledname, AT_DATA, indirect), 0, sizeof(pint), []);
-        if otherunit then
-          current_module.add_extern_asmsym(excepttype.vmt_mangledname, AB_EXTERNAL, AT_DATA);
-        paramanager.getintparaloc(list, pd, 1, paraloc1);
-        hlcg.a_loadaddr_ref_cgpara(list, excepttype.vmt_def, href2, paraloc1);
-        paramanager.freecgpara(list, paraloc1);
-        fpc_catches_res:=hlcg.g_call_system_proc(list, pd, [@paraloc1], nil);
-        location_reset(exceptloc, LOC_REGISTER, def_cgsize(fpc_catches_res.def));
-        exceptloc.register:=hlcg.getaddressregister(list, fpc_catches_res.def);
-        hlcg.gen_load_cgpara_loc(list, fpc_catches_res.def, fpc_catches_res, exceptloc, true);
-
-        { is it this catch? No. go to next onlabel }
-        hlcg.a_cmp_const_reg_label(list, fpc_catches_res.def, OC_EQ, 0, exceptloc.register, nextonlabel);
-
-        paraloc1.done;
-
-        exceptlocdef:=fpc_catches_res.def;
-        exceptlocreg:=exceptloc.register;
-      end;
-
-
-    class procedure tcgexceptionstatehandler.end_catch(list: TAsmList);
-      begin
-        { nothing to do by default }
-      end;
-
-
-    class procedure tcgexceptionstatehandler.catch_all_start(list: TAsmList);
-      begin
-        { nothing to do by default }
-      end;
-
-
-    class procedure tcgexceptionstatehandler.catch_all_add(list: TAsmList);
-      begin
-        { nothing to do by default }
-      end;
-
-
-    class procedure tcgexceptionstatehandler.catch_all_end(list: TAsmList);
-      begin
-        { nothing to do by default }
-      end;
-
-    class procedure tcgexceptionstatehandler.popaddrstack(list: TAsmList);
-      begin
-        hlcg.g_call_system_proc(list,'fpc_popaddrstack',[],nil).resetiftemp;
-      end;
-
 {*****************************************************************************
                              SecondTryExcept
 *****************************************************************************}

compiler/psabiehpi.pas

@@ -121,11 +121,10 @@ implementation
       symtable,
       defutil,
       tgobj,
-      cgobj,
+      cgobj,cgexcept,
       parabase,paramgr,
       hlcgobj,
-      pass_2,
-      ncgflw
+      pass_2
 {$ifdef i386}
       ,aasmcpu
 {$endif i386}