Prechádzať zdrojové kódy

* abstracted rest of the generic exception handling code through the
texceptionstatehandler class + llvm overrides
+ added FPC_DummyPotentialRaise routine that gets called at the begin and end
of try-blocks to be able to catch hardware exceptions to a limited extent
with LLVM

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

Jonas Maebe 6 rokov pred
rodič
commit
df0a126064

+ 33 - 3
compiler/llvm/llvmpi.pas

@@ -29,25 +29,30 @@ interface
       cclasses,
       aasmbase,
       procinfo,
-      cpupi;
+      cpupi,
+      aasmllvm;
 
     type
       tllvmprocinfo = class(tcpuprocinfo)
        private
         fexceptlabelstack: tfplist;
+        flandingpadstack: tfplist;
        public
         constructor create(aparent: tprocinfo); override;
         destructor destroy; override;
         procedure pushexceptlabel(lab: TAsmLabel);
-        { returns true if there no more exception labels on the stack }
+        { returns true if there no more landing pads on the stack }
         function popexceptlabel(lab: TAsmLabel): boolean;
         function CurrExceptLabel: TAsmLabel;
+        procedure pushlandingpad(pad: taillvm);
+        procedure poppad;
+        function currlandingpad: taillvm;
       end;
 
 implementation
 
     uses
-      globtype,verbose,systems,
+      globtype,globals,verbose,systems,
       symtable;
 
 
@@ -55,6 +60,7 @@ implementation
       begin
         inherited;
         fexceptlabelstack:=tfplist.create;
+        flandingpadstack:=tfplist.create;
       end;
 
     destructor tllvmprocinfo.destroy;
@@ -62,6 +68,9 @@ implementation
         if fexceptlabelstack.Count<>0 then
           Internalerror(2016121301);
         fexceptlabelstack.free;
+        if flandingpadstack.Count<>0 then
+          internalerror(2018051901);
+        flandingpadstack.free;
         inherited;
       end;
 
@@ -89,6 +98,27 @@ implementation
       end;
 
 
+    procedure tllvmprocinfo.pushlandingpad(pad: taillvm);
+      begin
+        flandingpadstack.add(pad);
+      end;
+
+    procedure tllvmprocinfo.poppad;
+      begin
+        if flandingpadstack.Count=0 then
+          internalerror(2018051902);
+        flandingpadstack.Count:=flandingpadstack.Count-1;
+      end;
+
+
+    function tllvmprocinfo.currlandingpad: taillvm;
+      begin
+        if flandingpadstack.Count=0 then
+          internalerror(2018051903);
+        result:=taillvm(flandingpadstack.last);
+      end;
+
+
 begin
   if not assigned(cprocinfo) then
     begin

+ 306 - 35
compiler/llvm/nllvmflw.pas

@@ -27,7 +27,9 @@ interface
 
     uses
       globtype,
+      symtype,symdef,
       aasmbase,aasmdata,
+      cgbase,
       node, nflw, ncgflw, ncgnstfl;
 
     type
@@ -35,10 +37,31 @@ interface
         function getasmlabel: tasmlabel; override;
       end;
 
-      tllvmexceptionstatehandler = class(tcgexceptionstatehandler)
-        class procedure new_exception(list: TAsmList; const t: texceptiontemps; out exceptstate: texceptionstate); override;
-        class procedure emit_except_label(list: TAsmList; var exceptionstate: texceptionstate); 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); 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);
+      class function use_cleanup(const exceptframekind: texceptframekind): boolean;
+    end;
+
+    tllvmtryexceptnode = class(tcgtryexceptnode)
+    end;
+
+    tllvmtryfinallynode = class(tcgtryfinallynode)
+      function pass_typecheck: tnode; override;
+    end;
 
     tllvmraisenode = class(tcgraisenode)
       function pass_1: tnode; override;
@@ -77,66 +100,312 @@ implementation
       end;
 
 
+{*****************************************************************************
+                          tllvmtryfinallynode
+*****************************************************************************}
+
+    function tllvmtryfinallynode.pass_typecheck: tnode;
+      begin
+        { make a copy of the "finally" code for the "no exception happened"
+          case }
+        if not assigned(third) then
+          third:=right.getcopy;
+        result:=inherited;
+      end;
+
+
 {*****************************************************************************
                      tllvmexceptionstatehandler
 *****************************************************************************}
 
-    class procedure tllvmexceptionstatehandler.new_exception(list: TAsmList; const t: texceptiontemps; out exceptstate: texceptionstate);
+    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
-        landingpadlabel: TAsmLabel;
+        reg: tregister;
       begin
-        inherited;
+        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. We can't use the same label as the
-          one used by the setjmp/longjmp, because only invoke operations are
-          allowed to refer to a landingpad label -> create an extra label and
-          emit:
-            landingpadlabel:
+          which refer to the exception label:
+            exceptionlabel:
               %reg = landingpad ..
-            exceptstate.exceptionlabel:
               <exception handling code>
         }
-        current_asmdata.getjumplabel(landingpadlabel);
+        current_asmdata.getjumplabel(exceptstate.exceptionlabel);
         { for consistency checking when popping }
         tllvmprocinfo(current_procinfo).pushexceptlabel(exceptstate.exceptionlabel);
-        tllvmprocinfo(current_procinfo).pushexceptlabel(landingpadlabel);
+        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);
       end;
 
 
-    class procedure tllvmexceptionstatehandler.emit_except_label(list: TAsmList; var exceptionstate: texceptionstate);
+    class procedure tllvmexceptionstatehandler.emit_except_label(list: TAsmList; exceptframekind: texceptframekind; var exceptionstate: texceptionstate);
       var
         reg: tregister;
-        clause: taillvm;
-        exc: treference;
+        landingpad: taillvm;
         landingpaddef: trecorddef;
       begin
-        { prevent fallthrough into the landingpad, not allowed }
-        hlcg.a_jmp_always(list,exceptionstate.exceptionlabel);
-        hlcg.a_label(list,tllvmprocinfo(current_procinfo).CurrExceptLabel);
-        { indicate that we will catch everything to LLVM's control flow
-          analysis; our personality function will (for now) indicate that it
-          doesn't actually want to handle any exceptions, so the stack unwinders
-          will ignore us anyway (our own exceptions are still handled via
-          setjmp/longjmp) }
-        clause:=taillvm.exceptclause(
-          la_catch,voidpointertype,nil,nil);
-        { dummy register (for now): we use the same code as on other platforms
-          to determine the exception type, our "personality function" won't
-          return anything useful }
-        reg:=hlcg.getintregister(list,u32inttype);
+        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);
-        list.concat(taillvm.landingpad(reg,landingpaddef,clause));
-        { remove current exception label from the stack }
-        tllvmprocinfo(current_procinfo).popexceptlabel(tllvmprocinfo(current_procinfo).CurrExceptLabel);
+        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);
+
+        { 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);
         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);
+      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);
+          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;
+
+
+    class function tllvmexceptionstatehandler.use_cleanup(const exceptframekind: texceptframekind): boolean;
+      begin
+        { in case of an exception caught by the implicit exception frame of
+          a safecall routine, this is not a cleanup frame but one that
+          catches the exception and returns a value from the function }
+        result:=
+          (exceptframekind=tek_implicitfinally) and
+          not((tf_safecall_exceptions in target_info.flags) and
+             (current_procinfo.procdef.proccalloption=pocall_safecall));
       end;
 
 
@@ -180,6 +449,8 @@ implementation
 
 begin
   clabelnode:=tllvmlabelnode;
+  ctryexceptnode:=tllvmtryexceptnode;
+  ctryfinallynode:=tllvmtryfinallynode;
   cexceptionstatehandler:=tllvmexceptionstatehandler;
   craisenode:=tllvmraisenode;
 end.

+ 287 - 140
compiler/ncgflw.pas

@@ -28,8 +28,9 @@ interface
 
     uses
       globtype,
+      symtype,symdef,
       aasmbase,aasmdata,nflw,
-      pass_2,cgutils,ncgutil;
+      pass_2,cgbase,cgutils,ncgutil;
 
     type
        tcgwhilerepeatnode = class(twhilerepeatnode)
@@ -80,26 +81,42 @@ interface
 
          Never instantiated. }
        tcgexceptionstatehandler = class
-         type
-           texceptiontemps=record
-             jmpbuf,
-             envbuf,
-             reasonbuf  : treference;
-           end;
-
-          texceptionstate = record
-            exceptionlabel: TAsmLabel;
-            oldflowcontrol,
-            newflowcontrol: tflowcontrol;
-          end;
-
-          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; out exceptstate: texceptionstate); virtual;
-          class procedure emit_except_label(list: TAsmList; var exceptstate: texceptionstate); virtual;
-          class procedure free_exception(list:TAsmList;const t:texceptiontemps;a:aint;endexceptlabel:tasmlabel;onlyfree:boolean); virtual;
-          class procedure cleanupobjectstack; virtual;
-          class procedure handle_nested_exception(list:TAsmList;const t:texceptiontemps;var entrystate: texceptionstate); virtual;
+        type
+         texceptiontemps=record
+           jmpbuf,
+           envbuf,
+           reasonbuf  : treference;
+         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); virtual;
+         { end of a try-block, label comes after the end of try/except or
+           try/finally }
+         class procedure end_try_block(list: TAsmList; exceptframekind: texceptframekind; const t: texceptiontemps; var exceptionstate: texceptionstate; endlabel: TAsmLabel); virtual;
+         class procedure free_exception(list: TAsmList; const t: texceptiontemps; const s: texceptionstate; a: aint; endexceptlabel: tasmlabel; onlyfree:boolean); virtual;
+         class procedure handle_nested_exception(list:TAsmList;const t:texceptiontemps;var entrystate: texceptionstate); virtual;
+         class procedure handle_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;
+         class procedure catch_all_end(list: TAsmList); virtual;
+         class procedure cleanupobjectstack(list: TAsmList); virtual;
+         class procedure popaddrstack(list: TAsmList); virtual;
        end;
        tcgexceptionstatehandlerclass = class of tcgexceptionstatehandler;
 
@@ -116,7 +133,8 @@ interface
 
        tcgtryfinallynode = class(ttryfinallynode)
         protected
-          procedure emit_jump_out_of_try_finally_frame(list: TasmList; const reason: byte; const exceptionstate: tcgexceptionstatehandler.texceptionstate; var excepttemps: tcgexceptionstatehandler.texceptiontemps; framelabel: tasmlabel);
+          procedure emit_jump_out_of_try_finally_frame(list: TasmList; const reason: byte; const finallycodelabel: tasmlabel; var excepttemps: tcgexceptionstatehandler.texceptiontemps; framelabel: tasmlabel);
+          function get_jump_out_of_try_finally_frame_label(const finallyexceptionstate: tcgexceptionstatehandler.texceptionstate): tasmlabel;
         public
           procedure handle_safecall_exception;
           procedure pass_generate_code;override;
@@ -135,8 +153,8 @@ implementation
     uses
       cutils,
       verbose,globals,systems,
-      symconst,symdef,symsym,symtable,symtype,aasmtai,aasmcpu,defutil,
-      procinfo,cgbase,parabase,
+      symconst,symsym,symtable,aasmtai,aasmcpu,defutil,
+      procinfo,parabase,
       fmodule,
       cpubase,
       tgobj,paramgr,
@@ -577,7 +595,7 @@ implementation
       end;
 
 
-    class procedure tcgexceptionstatehandler.new_exception(list:TAsmList;const t:texceptiontemps; out exceptstate: texceptionstate);
+    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;
@@ -585,6 +603,7 @@ implementation
       begin
         current_asmdata.getjumplabel(exceptstate.exceptionlabel);
         exceptstate.oldflowcontrol:=flowcontrol;
+        exceptstate.finallycodelabel:=nil;;
 
         paraloc1.init;
         paraloc2.init;
@@ -638,7 +657,7 @@ implementation
         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 0 here in the function result register, it means that we
+        { 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;
@@ -647,19 +666,24 @@ implementation
      end;
 
 
-    class procedure tcgexceptionstatehandler.emit_except_label(list: TAsmList; var exceptstate: texceptionstate);
+    class procedure tcgexceptionstatehandler.emit_except_label(list: TAsmList; exceptframekind: texceptframekind; var exceptstate: texceptionstate);
       begin
         hlcg.a_label(list,exceptstate.exceptionlabel);
-        exceptstate.newflowcontrol:=flowcontrol;
-        flowcontrol:=exceptstate.oldflowcontrol;
       end;
 
 
-    class procedure tcgexceptionstatehandler.free_exception(list:TAsmList;const t:texceptiontemps;a:aint;endexceptlabel:tasmlabel;onlyfree:boolean);
+    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
-         hlcg.g_call_system_proc(list,'fpc_popaddrstack',[],nil);
+         popaddrstack(list);
          if not onlyfree then
           begin
             reasonreg:=hlcg.getintregister(list,osuinttype);
@@ -671,30 +695,99 @@ implementation
 
     { does the necessary things to clean up the object stack }
     { in the except block                                    }
-    class procedure tcgexceptionstatehandler.cleanupobjectstack;
+    class procedure tcgexceptionstatehandler.cleanupobjectstack(list: TAsmList);
       begin
-         hlcg.g_call_system_proc(current_asmdata.CurrAsmList,'fpc_doneexception',[],nil);
+         hlcg.g_call_system_proc(list,'fpc_doneexception',[],nil);
       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;const t:texceptiontemps;var entrystate: texceptionstate);
       var
          exitlabel: tasmlabel;
       begin
+         current_asmdata.getjumplabel(exitlabel);
+         end_try_block(list,tek_except,t,entrystate,exitlabel);
+         emit_except_label(current_asmdata.CurrAsmList,tek_normalfinally,entrystate);
          { don't generate line info for internal cleanup }
          list.concat(tai_marker.create(mark_NoLineInfoStart));
-         current_asmdata.getjumplabel(exitlabel);
-         emit_except_label(current_asmdata.CurrAsmList,entrystate);
-         free_exception(list,t,0,exitlabel,false);
+         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);
          hlcg.a_label(list,exitlabel);
-         cleanupobjectstack;
+         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);
       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_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);
+      end;
 
 {*****************************************************************************
                              SecondTryExcept
@@ -709,10 +802,13 @@ implementation
           hlcg.a_label(list,framelabel);
           { we must also destroy the address frame which guards
             the exception object }
-          hlcg.g_call_system_proc(list,'fpc_popaddrstack',[],nil);
+          cexceptionstatehandler.popaddrstack(list);
           hlcg.g_exception_reason_discard(list,osuinttype,excepttemps.reasonbuf);
           if frametype=ft_except then
-            cexceptionstatehandler.cleanupobjectstack;
+            begin
+              cexceptionstatehandler.cleanupobjectstack(list);
+              cexceptionstatehandler.end_catch(list);
+            end;
           hlcg.a_jmp_always(list,outerlabel);
        end;
 
@@ -734,6 +830,7 @@ implementation
          destroytemps,
          excepttemps : tcgexceptionstatehandler.texceptiontemps;
          trystate,doobjectdestroyandreraisestate: tcgexceptionstatehandler.texceptionstate;
+         afteronflowcontrol: tflowcontrol;
       label
          errorexit;
       begin
@@ -772,7 +869,7 @@ implementation
          current_asmdata.getjumplabel(lastonlabel);
 
          cexceptionstatehandler.get_exception_temps(current_asmdata.CurrAsmList,excepttemps);
-         cexceptionstatehandler.new_exception(current_asmdata.CurrAsmList,excepttemps,trystate);
+         cexceptionstatehandler.new_exception(current_asmdata.CurrAsmList,excepttemps,tek_except,trystate);
 
          { try block }
          { set control flow labels for the try block }
@@ -790,9 +887,10 @@ implementation
          { don't generate line info for internal cleanup }
          current_asmdata.CurrAsmList.concat(tai_marker.create(mark_NoLineInfoStart));
 
-         cexceptionstatehandler.emit_except_label(current_asmdata.CurrAsmList,trystate);
+         cexceptionstatehandler.end_try_block(current_asmdata.CurrAsmList,tek_except,excepttemps,trystate,endexceptlabel);
 
-         cexceptionstatehandler.free_exception(current_asmdata.CurrAsmList, excepttemps, 0, endexceptlabel, false);
+         cexceptionstatehandler.emit_except_label(current_asmdata.CurrAsmList,tek_except,trystate);
+         cexceptionstatehandler.free_exception(current_asmdata.CurrAsmList, excepttemps, trystate, 0, endexceptlabel, false);
 
          { end cleanup }
          current_asmdata.CurrAsmList.concat(tai_marker.create(mark_NoLineInfoEnd));
@@ -811,6 +909,8 @@ implementation
          if assigned(right) then
            secondpass(right);
 
+         afteronflowcontrol:=flowcontrol;
+
          { don't generate line info for internal cleanup }
          current_asmdata.CurrAsmList.concat(tai_marker.create(mark_NoLineInfoStart));
 
@@ -826,18 +926,21 @@ implementation
               { guarded by an exception frame, but it can be omitted }
               { if there's no user code in 'except' block            }
 
+              cexceptionstatehandler.catch_all_start(current_asmdata.CurrAsmList);
               if not (has_no_code(t1)) then
                begin
+                 { if there is an outer frame that catches exceptions, remember this for the "except"
+                   part of this try/except }
+                 flowcontrol:=trystate.oldflowcontrol*[fc_inflowcontrol,fc_catching_exceptions];
                  cexceptionstatehandler.get_exception_temps(current_asmdata.CurrAsmList,destroytemps);
-                 cexceptionstatehandler.new_exception(current_asmdata.CurrAsmList,destroytemps,doobjectdestroyandreraisestate);
+                 cexceptionstatehandler.new_exception(current_asmdata.CurrAsmList,destroytemps,tek_normalfinally,doobjectdestroyandreraisestate);
                  { the flowcontrol from the default except-block must be merged
                    with the flowcontrol flags potentially set by the
                    on-statements handled above (secondpass(right)), as they are
                    at the same program level }
                  flowcontrol:=
                    flowcontrol+
-                   doobjectdestroyandreraisestate.oldflowcontrol;
-
+                   afteronflowcontrol;
 
                  { except block needs line info }
                  current_asmdata.CurrAsmList.concat(tai_marker.create(mark_NoLineInfoEnd));
@@ -847,19 +950,21 @@ implementation
                  cexceptionstatehandler.handle_nested_exception(current_asmdata.CurrAsmList,destroytemps,doobjectdestroyandreraisestate);
 
                  cexceptionstatehandler.unget_exception_temps(current_asmdata.CurrAsmList,destroytemps);
+                 cexceptionstatehandler.catch_all_end(current_asmdata.CurrAsmList);
                  hlcg.a_jmp_always(current_asmdata.CurrAsmList,endexceptlabel);
                end
-               else
-                 begin
-                   doobjectdestroyandreraisestate.newflowcontrol:=flowcontrol;
-                   cexceptionstatehandler.cleanupobjectstack;
-                   hlcg.a_jmp_always(current_asmdata.CurrAsmList,endexceptlabel);
-                 end;
+             else
+               begin
+                 doobjectdestroyandreraisestate.newflowcontrol:=afteronflowcontrol;
+                 cexceptionstatehandler.cleanupobjectstack(current_asmdata.CurrAsmList);
+                 cexceptionstatehandler.catch_all_end(current_asmdata.CurrAsmList);
+                 hlcg.a_jmp_always(current_asmdata.CurrAsmList,endexceptlabel);
+               end;
            end
          else
            begin
-              hlcg.g_call_system_proc(current_asmdata.CurrAsmList,'fpc_reraise',[],nil);
-              doobjectdestroyandreraisestate.newflowcontrol:=flowcontrol;
+             cexceptionstatehandler.handle_reraise(current_asmdata.CurrAsmList,excepttemps,trystate,tek_except);
+             doobjectdestroyandreraisestate.newflowcontrol:=afteronflowcontrol;
            end;
 
          if fc_exit in doobjectdestroyandreraisestate.newflowcontrol then
@@ -915,16 +1020,10 @@ implementation
          oldBreakLabel : tasmlabel;
          doobjectdestroyandreraisestate: tcgexceptionstatehandler.texceptionstate;
          excepttemps : tcgexceptionstatehandler.texceptiontemps;
-         href2: treference;
-         paraloc1 : tcgpara;
          exceptvarsym : tlocalvarsym;
-         pd : tprocdef;
-         fpc_catches_res: TCGPara;
-         fpc_catches_resloc: tlocation;
-         otherunit,
-         indirect : boolean;
+         exceptlocdef: tdef;
+         exceptlocreg: tregister;
       begin
-         paraloc1.init;
          location_reset(location,LOC_VOID,OS_NO);
          oldCurrExitLabel:=nil;
          continueonlabel:=nil;
@@ -933,27 +1032,7 @@ implementation
 
          current_asmdata.getjumplabel(nextonlabel);
 
-         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(current_asmdata.CurrAsmList,pd,1,paraloc1);
-         hlcg.a_loadaddr_ref_cgpara(current_asmdata.CurrAsmList,excepttype.vmt_def,href2,paraloc1);
-         paramanager.freecgpara(current_asmdata.CurrAsmList,paraloc1);
-         fpc_catches_res:=hlcg.g_call_system_proc(current_asmdata.CurrAsmList,pd,[@paraloc1],nil);
-         location_reset(fpc_catches_resloc,LOC_REGISTER,def_cgsize(fpc_catches_res.def));
-         fpc_catches_resloc.register:=hlcg.getaddressregister(current_asmdata.CurrAsmList,fpc_catches_res.def);
-         hlcg.gen_load_cgpara_loc(current_asmdata.CurrAsmList,fpc_catches_res.def,fpc_catches_res,fpc_catches_resloc,true);
-
-         { is it this catch? No. go to next onlabel }
-         hlcg.a_cmp_const_reg_label(current_asmdata.CurrAsmList,fpc_catches_res.def,OC_EQ,0,fpc_catches_resloc.register,nextonlabel);
+         cexceptionstatehandler.begin_catch(current_asmdata.CurrAsmList,excepttype,nextonlabel,exceptlocdef,exceptlocreg);
 
          { Retrieve exception variable }
          if assigned(excepTSymtable) then
@@ -963,16 +1042,15 @@ implementation
 
          if assigned(exceptvarsym) then
            begin
-             location_reset_ref(exceptvarsym.localloc,LOC_REFERENCE,def_cgsize(voidpointertype),voidpointertype.alignment,[]);
-             tg.GetLocal(current_asmdata.CurrAsmList,exceptvarsym.vardef.size,exceptvarsym.vardef,exceptvarsym.localloc.reference);
-             hlcg.a_load_reg_ref(current_asmdata.CurrAsmList,fpc_catches_res.def,exceptvarsym.vardef,fpc_catches_resloc.register,exceptvarsym.localloc.reference);
+             location_reset_ref(exceptvarsym.localloc, LOC_REFERENCE, def_cgsize(voidpointertype), voidpointertype.alignment, []);
+             tg.GetLocal(current_asmdata.CurrAsmList, exceptvarsym.vardef.size, exceptvarsym.vardef, exceptvarsym.localloc.reference);
+             hlcg.a_load_reg_ref(current_asmdata.CurrAsmList, exceptlocdef, exceptvarsym.vardef, exceptlocreg, exceptvarsym.localloc.reference);
            end;
-
          { in the case that another exception is risen
-           we've to destroy the old one:
-           call setjmp, and jump to finally label on non-zero result }
+           we've to destroy the old one, so create a new
+           exception frame for the catch-handler }
          cexceptionstatehandler.get_exception_temps(current_asmdata.CurrAsmList,excepttemps);
-         cexceptionstatehandler.new_exception(current_asmdata.CurrAsmList,excepttemps,doobjectdestroyandreraisestate);
+         cexceptionstatehandler.new_exception(current_asmdata.CurrAsmList,excepttemps,tek_normalfinally,doobjectdestroyandreraisestate);
 
          oldBreakLabel:=nil;
          oldContinueLabel:=nil;
@@ -1002,6 +1080,7 @@ implementation
              tg.UngetLocal(current_asmdata.CurrAsmList,exceptvarsym.localloc.reference);
              exceptvarsym.localloc.loc:=LOC_INVALID;
            end;
+         cexceptionstatehandler.end_catch(current_asmdata.CurrAsmList);
          hlcg.a_jmp_always(current_asmdata.CurrAsmList,endexceptlabel);
 
          if assigned(right) then
@@ -1038,10 +1117,11 @@ implementation
 
          cexceptionstatehandler.unget_exception_temps(current_asmdata.CurrAsmList,excepttemps);
          hlcg.a_label(current_asmdata.CurrAsmList,nextonlabel);
-         flowcontrol:=doobjectdestroyandreraisestate.oldflowcontrol+(doobjectdestroyandreraisestate.newflowcontrol-[fc_inflowcontrol,fc_catching_exceptions]);
-         paraloc1.done;
          current_asmdata.CurrAsmList.concat(tai_marker.create(mark_NoLineInfoEnd));
 
+         { propagate exit/break/continue }
+         flowcontrol:=doobjectdestroyandreraisestate.oldflowcontrol+(doobjectdestroyandreraisestate.newflowcontrol-[fc_inflowcontrol,fc_catching_exceptions]);
+
          { next on node }
          if assigned(left) then
            secondpass(left);
@@ -1052,12 +1132,22 @@ implementation
 *****************************************************************************}
 
     { jump out of a finally block }
-    procedure tcgtryfinallynode.emit_jump_out_of_try_finally_frame(list: TasmList; const reason: byte; const exceptionstate: tcgexceptionstatehandler.texceptionstate; var excepttemps: tcgexceptionstatehandler.texceptiontemps; framelabel: tasmlabel);
+    procedure tcgtryfinallynode.emit_jump_out_of_try_finally_frame(list: TasmList; const reason: byte; const finallycodelabel: tasmlabel; var excepttemps: tcgexceptionstatehandler.texceptiontemps; framelabel: tasmlabel);
       begin
          hlcg.a_label(list,framelabel);
          hlcg.g_exception_reason_discard(list,osuinttype,excepttemps.reasonbuf);
          hlcg.g_exception_reason_save_const(list,osuinttype,reason,excepttemps.reasonbuf);
-         hlcg.a_jmp_always(list,exceptionstate.exceptionlabel);
+         hlcg.a_jmp_always(list,finallycodelabel);
+      end;
+
+
+    function tcgtryfinallynode.get_jump_out_of_try_finally_frame_label(const finallyexceptionstate: tcgexceptionstatehandler.texceptionstate): tasmlabel;
+      begin
+         if implicitframe and
+            not assigned(third) then
+           result:=finallyexceptionstate.exceptionlabel
+         else
+           current_asmdata.getjumplabel(result);
       end;
 
 
@@ -1095,10 +1185,37 @@ implementation
          breakfinallylabel,
          oldCurrExitLabel,
          oldContinueLabel,
-         oldBreakLabel : tasmlabel;
+         oldBreakLabel,
+         finallyNoExceptionLabel: tasmlabel;
          finallyexceptionstate: tcgexceptionstatehandler.texceptionstate;
          excepttemps : tcgexceptionstatehandler.texceptiontemps;
          reasonreg : tregister;
+         exceptframekind: tcgexceptionstatehandler.texceptframekind;
+         tmplist: TAsmList;
+
+        procedure handle_breakcontinueexit(const finallycode: tasmlabel; doreraise: boolean);
+          begin
+            { no exception happened, but maybe break/continue/exit }
+            hlcg.a_cmp_const_reg_label(current_asmdata.CurrAsmList,osuinttype,OC_EQ,0,reasonreg,endfinallylabel);
+            if fc_exit in finallyexceptionstate.newflowcontrol then
+              hlcg.a_cmp_const_reg_label(current_asmdata.CurrAsmList,osuinttype,OC_EQ,2,reasonreg,oldCurrExitLabel);
+            if fc_break in finallyexceptionstate.newflowcontrol then
+              hlcg.a_cmp_const_reg_label(current_asmdata.CurrAsmList,osuinttype,OC_EQ,3,reasonreg,oldBreakLabel);
+            if fc_continue in finallyexceptionstate.newflowcontrol then
+              hlcg.a_cmp_const_reg_label(current_asmdata.CurrAsmList,osuinttype,OC_EQ,4,reasonreg,oldContinueLabel);
+            if doreraise then
+              cexceptionstatehandler.handle_reraise(current_asmdata.CurrAsmList,excepttemps,finallyexceptionstate,tek_normalfinally)
+            else
+              hlcg.g_unreachable(current_asmdata.CurrAsmList);
+            { redirect break/continue/exit to the label above, with the reasonbuf set appropriately }
+            if fc_exit in finallyexceptionstate.newflowcontrol then
+              emit_jump_out_of_try_finally_frame(current_asmdata.CurrAsmList,2,finallycode,excepttemps,exitfinallylabel);
+            if fc_break in finallyexceptionstate.newflowcontrol then
+              emit_jump_out_of_try_finally_frame(current_asmdata.CurrAsmList,3,finallycode,excepttemps,breakfinallylabel);
+            if fc_continue in finallyexceptionstate.newflowcontrol then
+              emit_jump_out_of_try_finally_frame(current_asmdata.CurrAsmList,4,finallycode,excepttemps,continuefinallylabel);
+          end;
+
       begin
          location_reset(location,LOC_VOID,OS_NO);
          oldBreakLabel:=nil;
@@ -1106,34 +1223,28 @@ implementation
          continuefinallylabel:=nil;
          breakfinallylabel:=nil;
 
+         if not implicitframe then
+           exceptframekind:=tek_normalfinally
+         else
+           exceptframekind:=tek_implicitfinally;
+
          current_asmdata.getjumplabel(endfinallylabel);
 
          { call setjmp, and jump to finally label on non-zero result }
          cexceptionstatehandler.get_exception_temps(current_asmdata.CurrAsmList,excepttemps);
-         cexceptionstatehandler.new_exception(current_asmdata.CurrAsmList,excepttemps,finallyexceptionstate);
+         cexceptionstatehandler.new_exception(current_asmdata.CurrAsmList,excepttemps,exceptframekind,finallyexceptionstate);
 
          { the finally block must catch break, continue and exit }
          { statements                                            }
          oldCurrExitLabel:=current_procinfo.CurrExitLabel;
-         if implicitframe then
-           exitfinallylabel:=finallyexceptionstate.exceptionlabel
-         else
-           current_asmdata.getjumplabel(exitfinallylabel);
+         exitfinallylabel:=get_jump_out_of_try_finally_frame_label(finallyexceptionstate);
          current_procinfo.CurrExitLabel:=exitfinallylabel;
          if assigned(current_procinfo.CurrBreakLabel) then
           begin
             oldContinueLabel:=current_procinfo.CurrContinueLabel;
             oldBreakLabel:=current_procinfo.CurrBreakLabel;
-            if implicitframe then
-              begin
-                breakfinallylabel:=finallyexceptionstate.exceptionlabel;
-                continuefinallylabel:=finallyexceptionstate.exceptionlabel;
-              end
-            else
-              begin
-                current_asmdata.getjumplabel(breakfinallylabel);
-                current_asmdata.getjumplabel(continuefinallylabel);
-              end;
+            breakfinallylabel:=get_jump_out_of_try_finally_frame_label(finallyexceptionstate);
+            continuefinallylabel:=get_jump_out_of_try_finally_frame_label(finallyexceptionstate);
             current_procinfo.CurrContinueLabel:=continuefinallylabel;
             current_procinfo.CurrBreakLabel:=breakfinallylabel;
           end;
@@ -1149,9 +1260,37 @@ implementation
          { don't generate line info for internal cleanup }
          current_asmdata.CurrAsmList.concat(tai_marker.create(mark_NoLineInfoStart));
 
-         cexceptionstatehandler.emit_except_label(current_asmdata.CurrAsmList,finallyexceptionstate);
+         cexceptionstatehandler.end_try_block(current_asmdata.CurrAsmList,exceptframekind,excepttemps,finallyexceptionstate,finallyexceptionstate.finallycodelabel);
+         if assigned(third) then
+           begin
+             tmplist:=TAsmList.create;
+             { emit the except label already (to a temporary list) to ensure that any calls in the
+               finally block refer to the outer exception frame rather than to the exception frame
+               that emits this same finally code in case an exception does happen }
+             cexceptionstatehandler.emit_except_label(tmplist,exceptframekind,finallyexceptionstate);
+
+             flowcontrol:=finallyexceptionstate.oldflowcontrol*[fc_inflowcontrol,fc_catching_exceptions];
+             current_asmdata.getjumplabel(finallyNoExceptionLabel);
+             hlcg.a_label(current_asmdata.CurrAsmList,finallyNoExceptionLabel);
+             if not implicitframe then
+               current_asmdata.CurrAsmList.concat(tai_marker.create(mark_NoLineInfoEnd));
+             secondpass(third);
+             if codegenerror then
+               exit;
+             if not implicitframe then
+               current_asmdata.CurrAsmList.concat(tai_marker.create(mark_NoLineInfoStart));
+             reasonreg:=hlcg.getintregister(current_asmdata.CurrAsmList,osuinttype);
+             hlcg.g_exception_reason_load(current_asmdata.CurrAsmList,osuinttype,osuinttype,excepttemps.reasonbuf,reasonreg);
+             handle_breakcontinueexit(finallyNoExceptionLabel,false);
+
+             current_asmdata.CurrAsmList.concatList(tmplist);
+             tmplist.free;
+           end
+         else
+           cexceptionstatehandler.emit_except_label(current_asmdata.CurrAsmList,exceptframekind,finallyexceptionstate);
+
          { just free the frame information }
-         cexceptionstatehandler.free_exception(current_asmdata.CurrAsmList,excepttemps,1,finallyexceptionstate.exceptionlabel,true);
+         cexceptionstatehandler.free_exception(current_asmdata.CurrAsmList,excepttemps,finallyexceptionstate,1,finallyexceptionstate.exceptionlabel,true);
 
          { end cleanup }
          current_asmdata.CurrAsmList.concat(tai_marker.create(mark_NoLineInfoEnd));
@@ -1160,11 +1299,11 @@ implementation
            finally code is unconditionally executed; we do have to filter out
            flags regarding break/contrinue/etc. because we have to give an
            error in case one of those is used in the finally-code }
-         flowcontrol:=finallyexceptionstate.oldflowcontrol*[fc_inflowcontrol];
+         flowcontrol:=finallyexceptionstate.oldflowcontrol*[fc_inflowcontrol,fc_catching_exceptions];
          secondpass(right);
          { goto is allowed if it stays inside the finally block,
            this is checked using the exception block number }
-         if (flowcontrol-[fc_gotolabel])<>(finallyexceptionstate.oldflowcontrol*[fc_inflowcontrol]) then
+         if (flowcontrol-[fc_gotolabel])<>(finallyexceptionstate.oldflowcontrol*[fc_inflowcontrol,fc_catching_exceptions]) then
            CGMessage(cg_e_control_flow_outside_finally);
          if codegenerror then
            exit;
@@ -1172,38 +1311,46 @@ implementation
          { don't generate line info for internal cleanup }
          current_asmdata.CurrAsmList.concat(tai_marker.create(mark_NoLineInfoStart));
 
-         { the value should now be in the exception handler }
-         reasonreg:=hlcg.getintregister(current_asmdata.CurrAsmList,osuinttype);
-         hlcg.g_exception_reason_load(current_asmdata.CurrAsmList,osuinttype,osuinttype,excepttemps.reasonbuf,reasonreg);
-         if implicitframe then
+         { same level as before try, but this part is only executed if an exception occcurred
+           -> always fc_in_flowcontrol }
+         flowcontrol:=finallyexceptionstate.oldflowcontrol*[fc_catching_exceptions];
+         include(flowcontrol,fc_inflowcontrol);
+         if not assigned(third) then
            begin
-             hlcg.a_cmp_const_reg_label(current_asmdata.CurrAsmList,osuinttype,OC_EQ,0,reasonreg,endfinallylabel);
-             { finally code only needed to be executed on exception (-> in
-               if-branch -> fc_inflowcontrol) }
-             flowcontrol:=[fc_inflowcontrol];
-             if (tf_safecall_exceptions in target_info.flags) and
-                (current_procinfo.procdef.proccalloption=pocall_safecall) then
-               handle_safecall_exception
+             { the value should now be in the exception handler }
+             reasonreg:=hlcg.getintregister(current_asmdata.CurrAsmList,osuinttype);
+             hlcg.g_exception_reason_load(current_asmdata.CurrAsmList,osuinttype,osuinttype,excepttemps.reasonbuf,reasonreg);
+             if implicitframe then
+               begin
+                 hlcg.a_cmp_const_reg_label(current_asmdata.CurrAsmList,osuinttype,OC_EQ,0,reasonreg,endfinallylabel);
+                 { finally code only needed to be executed on exception (-> in
+                   if-branch -> fc_inflowcontrol) }
+                 if (tf_safecall_exceptions in target_info.flags) and
+                    (current_procinfo.procdef.proccalloption=pocall_safecall) then
+                   handle_safecall_exception
+                 else
+                   cexceptionstatehandler.handle_reraise(current_asmdata.CurrAsmList,excepttemps,finallyexceptionstate,exceptframekind);
+               end
              else
-                hlcg.g_call_system_proc(current_asmdata.CurrAsmList,'fpc_reraise',[],nil);
+               begin
+                 handle_breakcontinueexit(finallyexceptionstate.exceptionlabel,true);
+               end;
            end
          else
            begin
-             hlcg.a_cmp_const_reg_label(current_asmdata.CurrAsmList,osuinttype,OC_EQ,0,reasonreg,endfinallylabel);
-             if fc_exit in finallyexceptionstate.newflowcontrol then
-               hlcg.a_cmp_const_reg_label(current_asmdata.CurrAsmList,osuinttype,OC_EQ,2,reasonreg,oldCurrExitLabel);
-             if fc_break in finallyexceptionstate.newflowcontrol then
-               hlcg.a_cmp_const_reg_label(current_asmdata.CurrAsmList,osuinttype,OC_EQ,3,reasonreg,oldBreakLabel);
-             if fc_continue in finallyexceptionstate.newflowcontrol then
-               hlcg.a_cmp_const_reg_label(current_asmdata.CurrAsmList,osuinttype,OC_EQ,4,reasonreg,oldContinueLabel);
-             hlcg.g_call_system_proc(current_asmdata.CurrAsmList,'fpc_reraise',[],nil);
-             { do some magic for exit,break,continue in the try block }
-             if fc_exit in finallyexceptionstate.newflowcontrol then
-               emit_jump_out_of_try_finally_frame(current_asmdata.CurrAsmList,2,finallyexceptionstate,excepttemps,exitfinallylabel);
-             if fc_break in finallyexceptionstate.newflowcontrol then
-               emit_jump_out_of_try_finally_frame(current_asmdata.CurrAsmList,3,finallyexceptionstate,excepttemps,breakfinallylabel);
-             if fc_continue in finallyexceptionstate.newflowcontrol then
-               emit_jump_out_of_try_finally_frame(current_asmdata.CurrAsmList,4,finallyexceptionstate,excepttemps,continuefinallylabel);
+             if implicitframe then
+               begin
+                 if (tf_safecall_exceptions in target_info.flags) and
+                    (current_procinfo.procdef.proccalloption=pocall_safecall) then
+                   handle_safecall_exception
+                 else
+                   cexceptionstatehandler.handle_reraise(current_asmdata.CurrAsmList,excepttemps,finallyexceptionstate,exceptframekind);
+               end
+             else
+               begin
+                 cexceptionstatehandler.handle_reraise(current_asmdata.CurrAsmList,excepttemps,finallyexceptionstate,exceptframekind);
+               end;
+
            end;
          cexceptionstatehandler.unget_exception_temps(current_asmdata.CurrAsmList,excepttemps);
          hlcg.a_label(current_asmdata.CurrAsmList,endfinallylabel);

+ 2 - 0
rtl/inc/llvmintr.inc

@@ -17,3 +17,5 @@
 procedure llvm_memcpy64(dest, source: pointer; len: qword; align: cardinal; isvolatile: LLVMBool1); compilerproc; external name 'llvm.memcpy.p0i8.p0i8.i64';
 
 function llvm_frameaddress(level: longint): pointer; compilerproc; external name 'llvm.frameaddress';
+
+function llvm_eh_typeid_for(sym: pointer): longint; compilerproc; external name 'llvm.eh.typeid.for';

+ 4 - 0
rtl/inc/psabieh.inc

@@ -1039,3 +1039,7 @@ procedure fpc_raise_nested;compilerproc;
     _Unwind_RaiseException(@_ExceptObjectStack^.unwind_exception);
     halt(217);
   end;
+
+procedure FPC_DummyPotentialRaise; nostackframe; assembler;
+  asm
+  end;

+ 5 - 0
rtl/inc/psabiehh.inc

@@ -61,4 +61,9 @@ function _FPC_psabieh_personality_v0(version: longint; actions: FPC_Unwind_Actio
 function FPC_psabi_begin_catch(exc:PFPC_Unwind_Exception): pointer; cdecl; compilerproc;
 procedure FPC_psabi_end_catch; cdecl; compilerproc;
 
+{ llvm cannot create a catch/cleanup block if there is no call inside the
+  try block to a routine that can raise an exception. Hence, we will call
+  a dummy routine that llvm cannot analyse for such try blocks }
+procedure FPC_DummyPotentialRaise;
+
 {$packrecords default}