* cloned the WebAssembly native exceptions code generation and rtl support into

  the branchful exceptions (which will be modified later, but we're using this
  as their starting point, because we can get a snapshot built, without compiler
  internal errors)

compiler/options.pas

@@ -3638,7 +3638,8 @@ begin
 {$ifdef wasm}
   if (Ord(ts_wasm_no_exceptions in init_settings.targetswitches)+
       Ord(ts_wasm_js_exceptions in init_settings.targetswitches)+
-      Ord(ts_wasm_native_exceptions in init_settings.targetswitches))>1 then
+      Ord(ts_wasm_native_exceptions in init_settings.targetswitches)+
+      Ord(ts_wasm_bf_exceptions in init_settings.targetswitches))>1 then
     begin
       Message(option_too_many_exception_modes);
       StopOptions(1);
@@ -4817,7 +4818,7 @@ begin
 {$endif m68k}
 {$ifdef wasm}
   { if no explicit exception handling mode is set for WebAssembly, assume no exceptions }
-  if init_settings.targetswitches*[ts_wasm_no_exceptions,ts_wasm_js_exceptions,ts_wasm_native_exceptions]=[] then
+  if init_settings.targetswitches*[ts_wasm_no_exceptions,ts_wasm_js_exceptions,ts_wasm_native_exceptions,ts_wasm_bf_exceptions]=[] then
     begin
       def_system_macro(TargetSwitchStr[ts_wasm_no_exceptions].define);
       include(init_settings.targetswitches,ts_wasm_no_exceptions);

compiler/wasm32/cpupi.pas

@@ -227,6 +227,91 @@ implementation
         thlcgwasm(hlcg).decblock;
       end;
 
+{*****************************************************************************
+                     twasmexceptionstatehandler_bfexceptions
+*****************************************************************************}
+
+    type
+
+      { twasmexceptionstatehandler_bfexceptions }
+
+      twasmexceptionstatehandler_bfexceptions = class(tcgexceptionstatehandler)
+        class procedure new_exception(list:TAsmList;const t:texceptiontemps; const exceptframekind: texceptframekind; out exceptstate: texceptionstate); override;
+        class procedure free_exception(list: TAsmList; const t: texceptiontemps; const s: texceptionstate; a: aint; endexceptlabel: tasmlabel; onlyfree:boolean); override;
+        class procedure handle_nested_exception(list:TAsmList;var t:texceptiontemps;var entrystate: texceptionstate); override;
+        { start of an "on" (catch) block }
+        class procedure begin_catch(list: TAsmList; excepttype: tobjectdef; nextonlabel: tasmlabel; out exceptlocdef: tdef; out exceptlocreg: tregister); override;
+        { end of an "on" (catch) block }
+        class procedure end_catch(list: TAsmList); override;
+      end;
+
+    class procedure twasmexceptionstatehandler_bfexceptions.new_exception(list:TAsmList;const t:texceptiontemps; const exceptframekind: texceptframekind; out exceptstate: texceptionstate);
+      begin
+        exceptstate.exceptionlabel:=nil;
+        exceptstate.oldflowcontrol:=flowcontrol;
+        exceptstate.finallycodelabel:=nil;
+
+        flowcontrol:=[fc_inflowcontrol,fc_catching_exceptions];
+      end;
+
+    class procedure twasmexceptionstatehandler_bfexceptions.free_exception(list: TAsmList; const t: texceptiontemps; const s: texceptionstate; a: aint; endexceptlabel: tasmlabel; onlyfree:boolean);
+      begin
+      end;
+
+    class procedure twasmexceptionstatehandler_bfexceptions.handle_nested_exception(list:TAsmList;var t:texceptiontemps;var entrystate: texceptionstate);
+      begin
+        list.Concat(tai_comment.Create(strpnew('TODO: handle_nested_exception')));
+      end;
+
+    class procedure twasmexceptionstatehandler_bfexceptions.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.getcgtempparaloc(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? }
+        thlcgwasm(hlcg).a_cmp_const_reg_stack(list, fpc_catches_res.def, OC_NE, 0, exceptloc.register);
+
+        current_asmdata.CurrAsmList.concat(taicpu.op_none(a_if));
+        thlcgwasm(hlcg).incblock;
+        thlcgwasm(hlcg).decstack(current_asmdata.CurrAsmList,1);
+
+        paraloc1.done;
+
+        exceptlocdef:=fpc_catches_res.def;
+        exceptlocreg:=exceptloc.register;
+      end;
+
+    class procedure twasmexceptionstatehandler_bfexceptions.end_catch(list: TAsmList);
+      begin
+        current_asmdata.CurrAsmList.concat(taicpu.op_none(a_end_if));
+        thlcgwasm(hlcg).decblock;
+      end;
+
 {*****************************************************************************
                            tcpuprocinfo
 *****************************************************************************}
@@ -245,6 +330,8 @@ implementation
           cexceptionstatehandler:=twasmexceptionstatehandler_jsexceptions
         else if ts_wasm_no_exceptions in current_settings.targetswitches then
           cexceptionstatehandler:=twasmexceptionstatehandler_noexceptions
+        else if ts_wasm_bf_exceptions in current_settings.targetswitches then
+          cexceptionstatehandler:=twasmexceptionstatehandler_bfexceptions
         else
           internalerror(2021091701);
       end;

compiler/wasm32/nwasmflw.pas

@@ -55,6 +55,7 @@ interface
       private
         function pass_1_no_exceptions : tnode;
         function pass_1_native_exceptions : tnode;
+        function pass_1_bf_exceptions : tnode;
       public
         function pass_1 : tnode;override;
       end;
@@ -66,6 +67,7 @@ interface
         procedure pass_generate_code_no_exceptions;
         procedure pass_generate_code_js_exceptions;
         procedure pass_generate_code_native_exceptions;
+        procedure pass_generate_code_bf_exceptions;
       public
         procedure pass_generate_code;override;
       end;
@@ -77,6 +79,7 @@ interface
         procedure pass_generate_code_no_exceptions;
         procedure pass_generate_code_js_exceptions;
         procedure pass_generate_code_native_exceptions;
+        procedure pass_generate_code_bf_exceptions;
       public
         procedure pass_generate_code;override;
       end;
@@ -88,6 +91,7 @@ interface
         procedure pass_generate_code_no_exceptions;
         procedure pass_generate_code_js_exceptions;
         procedure pass_generate_code_native_exceptions;
+        procedure pass_generate_code_bf_exceptions;
       public
         procedure pass_generate_code;override;
       end;
@@ -357,12 +361,71 @@ implementation
       end;
 
 
+    function twasmraisenode.pass_1_bf_exceptions : tnode;
+      var
+        statements : tstatementnode;
+        //current_addr : tlabelnode;
+        raisenode : tcallnode;
+      begin
+        result:=internalstatements(statements);
+
+        if assigned(left) then
+          begin
+            { first para must be a class }
+            firstpass(left);
+            { insert needed typeconvs for addr,frame }
+            if assigned(right) then
+              begin
+                { addr }
+                firstpass(right);
+                { frame }
+                if assigned(third) then
+                  firstpass(third)
+                else
+                  third:=cpointerconstnode.Create(0,voidpointertype);
+              end
+            else
+              begin
+                third:=cinlinenode.create(in_get_frame,false,nil);
+                //current_addr:=clabelnode.create(cnothingnode.create,clabelsym.create('$raiseaddr'));
+                //addstatement(statements,current_addr);
+                //right:=caddrnode.create(cloadnode.create(current_addr.labsym,current_addr.labsym.owner));
+                right:=cnilnode.create;
+
+                { raise address off by one so we are for sure inside the action area for the raise }
+                if tf_use_psabieh in target_info.flags then
+                  right:=caddnode.create_internal(addn,right,cordconstnode.create(1,sizesinttype,false));
+              end;
+
+            raisenode:=ccallnode.createintern('fpc_raiseexception',
+              ccallparanode.create(third,
+              ccallparanode.create(right,
+              ccallparanode.create(left,nil)))
+              );
+            include(raisenode.callnodeflags,cnf_call_never_returns);
+            addstatement(statements,raisenode);
+          end
+        else
+          begin
+            //addstatement(statements,ccallnode.createintern('fpc_popaddrstack',nil));
+            raisenode:=ccallnode.createintern('fpc_reraise',nil);
+            include(raisenode.callnodeflags,cnf_call_never_returns);
+            addstatement(statements,raisenode);
+          end;
+        left:=nil;
+        right:=nil;
+        third:=nil;
+      end;
+
+
     function twasmraisenode.pass_1 : tnode;
       begin
         if ts_wasm_no_exceptions in current_settings.targetswitches then
           result:=pass_1_no_exceptions
         else if ts_wasm_native_exceptions in current_settings.targetswitches then
           result:=pass_1_native_exceptions
+        else if ts_wasm_bf_exceptions in current_settings.targetswitches then
+          result:=pass_1_bf_exceptions
         else
           result:=inherited;
       end;
@@ -490,6 +553,114 @@ implementation
           trystate.newflowcontrol - [fc_inflowcontrol,fc_catching_exceptions]);
       end;
 
+    procedure twasmtryexceptnode.pass_generate_code_bf_exceptions;
+      var
+        trystate,doobjectdestroyandreraisestate: tcgexceptionstatehandler.texceptionstate;
+        destroytemps,
+        excepttemps: tcgexceptionstatehandler.texceptiontemps;
+        afteronflowcontrol: tflowcontrol;
+      label
+        errorexit;
+      begin
+        location_reset(location,LOC_VOID,OS_NO);
+        doobjectdestroyandreraisestate:=Default(tcgexceptionstatehandler.texceptionstate);
+
+        { Exception temps? We don't need no stinking exception temps! :) }
+        fillchar(excepttemps,sizeof(excepttemps),0);
+        reference_reset(excepttemps.envbuf,0,[]);
+        reference_reset(excepttemps.jmpbuf,0,[]);
+        reference_reset(excepttemps.reasonbuf,0,[]);
+
+        //exceptstate.oldflowcontrol:=flowcontrol;
+        //flowcontrol:=[fc_inflowcontrol,fc_catching_exceptions];
+        cexceptionstatehandler.new_exception(current_asmdata.CurrAsmList,excepttemps,tek_except,trystate);
+
+        current_asmdata.CurrAsmList.concat(taicpu.op_none(a_try));
+        thlcgwasm(hlcg).incblock;
+
+        { try block }
+        secondpass(left);
+        if codegenerror then
+          goto errorexit;
+
+        //exceptionstate.newflowcontrol:=flowcontrol;
+        //flowcontrol:=exceptionstate.oldflowcontrol;
+        cexceptionstatehandler.end_try_block(current_asmdata.CurrAsmList,tek_except,excepttemps,trystate,nil);
+
+        current_asmdata.CurrAsmList.concat(taicpu.op_sym(a_catch,current_asmdata.WeakRefAsmSymbol(FPC_EXCEPTION_TAG_SYM,AT_WASM_EXCEPTION_TAG)));
+
+        flowcontrol:=[fc_inflowcontrol]+trystate.oldflowcontrol*[fc_catching_exceptions];
+        { on statements }
+        if assigned(right) then
+          secondpass(right);
+
+        afteronflowcontrol:=flowcontrol;
+
+        { default handling except handling }
+        if assigned(t1) then
+          begin
+            { FPC_CATCHES with 'default handler' flag (=-1) need no longer be called,
+              it doesn't change any state and its return value is ignored (Sergei)
+            }
+
+            { the destruction of the exception object must be also }
+            { guarded by an exception frame, but it can be omitted }
+            { if there's no user code in 'except' block            }
+
+            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];
+                { Exception temps? We don't need no stinking exception temps! :) }
+                fillchar(excepttemps,sizeof(destroytemps),0);
+                reference_reset(destroytemps.envbuf,0,[]);
+                reference_reset(destroytemps.jmpbuf,0,[]);
+                reference_reset(destroytemps.reasonbuf,0,[]);
+                cexceptionstatehandler.new_exception(current_asmdata.CurrAsmList,destroytemps,tek_except,doobjectdestroyandreraisestate);
+                { the flowcontrol from the default except-block must be merged
+                  with the flowcontrol flags potentially set by the
+                  on-statements handled above (secondpass(right)), as they are
+                  at the same program level }
+                flowcontrol:=
+                  flowcontrol+
+                  afteronflowcontrol;
+
+                current_asmdata.CurrAsmList.concat(taicpu.op_none(a_try));
+                thlcgwasm(hlcg).incblock;
+
+                secondpass(t1);
+
+                hlcg.g_call_system_proc(current_asmdata.CurrAsmList,'fpc_doneexception',[],nil).resetiftemp;
+
+                current_asmdata.CurrAsmList.concat(taicpu.op_sym(a_catch,current_asmdata.WeakRefAsmSymbol(FPC_EXCEPTION_TAG_SYM,AT_WASM_EXCEPTION_TAG)));
+
+                hlcg.g_call_system_proc(current_asmdata.CurrAsmList,'fpc_raise_nested',[],nil).resetiftemp;
+
+                current_asmdata.CurrAsmList.concat(taicpu.op_none(a_end_try));
+                thlcgwasm(hlcg).decblock;
+              end
+            else
+              begin
+                doobjectdestroyandreraisestate.newflowcontrol:=afteronflowcontrol;
+                hlcg.g_call_system_proc(current_asmdata.CurrAsmList,'fpc_doneexception',[],nil).resetiftemp;
+              end;
+          end
+        else
+          begin
+            current_asmdata.CurrAsmList.concat(taicpu.op_const(a_rethrow,0));
+            doobjectdestroyandreraisestate.newflowcontrol:=afteronflowcontrol;
+          end;
+
+        current_asmdata.CurrAsmList.concat(taicpu.op_none(a_end_try));
+        thlcgwasm(hlcg).decblock;
+
+      errorexit:
+        { return all used control flow statements }
+        flowcontrol:=trystate.oldflowcontrol+(doobjectdestroyandreraisestate.newflowcontrol +
+          trystate.newflowcontrol - [fc_inflowcontrol,fc_catching_exceptions]);
+      end;
+
     procedure twasmtryexceptnode.pass_generate_code;
       begin
         if ts_wasm_no_exceptions in current_settings.targetswitches then
@@ -498,6 +669,8 @@ implementation
           pass_generate_code_js_exceptions
         else if ts_wasm_native_exceptions in current_settings.targetswitches then
           pass_generate_code_native_exceptions
+        else if ts_wasm_bf_exceptions in current_settings.targetswitches then
+          pass_generate_code_bf_exceptions
         else
           internalerror(2021091705);
       end;
@@ -904,6 +1077,217 @@ implementation
         flowcontrol:=finallyexceptionstate.oldflowcontrol+(finallyexceptionstate.newflowcontrol-[fc_inflowcontrol,fc_catching_exceptions]);
       end;
 
+    procedure twasmtryfinallynode.pass_generate_code_bf_exceptions;
+      var
+        exitfinallylabel,
+        continuefinallylabel,
+        breakfinallylabel,
+        oldCurrExitLabel,
+        oldContinueLabel,
+        oldBreakLabel: tasmlabel;
+        oldLoopContBr: integer;
+        oldLoopBreakBr: integer;
+        oldExitBr: integer;
+        finallyexceptionstate: tcgexceptionstatehandler.texceptionstate;
+        excepttemps : tcgexceptionstatehandler.texceptiontemps;
+        exceptframekind: tcgexceptionstatehandler.texceptframekind;
+        in_loop: Boolean;
+
+      procedure generate_exceptreason_check_br(reason: tcgint; br: aint);
+        var
+          reasonreg : tregister;
+        begin
+          reasonreg:=hlcg.getintregister(current_asmdata.CurrAsmList,exceptionreasontype);
+          hlcg.g_exception_reason_load(current_asmdata.CurrAsmList,exceptionreasontype,exceptionreasontype,excepttemps.reasonbuf,reasonreg);
+          thlcgwasm(hlcg).a_cmp_const_reg_stack(current_asmdata.CurrAsmList,exceptionreasontype,OC_EQ,reason,reasonreg);
+          current_asmdata.CurrAsmList.concat(taicpu.op_none(a_if));
+          thlcgwasm(hlcg).incblock;
+          thlcgwasm(hlcg).decstack(current_asmdata.CurrAsmList,1);
+          current_asmdata.CurrAsmList.concat(taicpu.op_const(a_br,br+1));
+          current_asmdata.CurrAsmList.concat(taicpu.op_none(a_end_if));
+          thlcgwasm(hlcg).decblock;
+        end;
+
+      procedure generate_exceptreason_throw(reason: tcgint);
+        var
+          reasonreg : tregister;
+        begin
+          reasonreg:=hlcg.getintregister(current_asmdata.CurrAsmList,exceptionreasontype);
+          hlcg.g_exception_reason_load(current_asmdata.CurrAsmList,exceptionreasontype,exceptionreasontype,excepttemps.reasonbuf,reasonreg);
+          thlcgwasm(hlcg).a_cmp_const_reg_stack(current_asmdata.CurrAsmList,exceptionreasontype,OC_EQ,reason,reasonreg);
+          current_asmdata.CurrAsmList.concat(taicpu.op_none(a_if));
+          thlcgwasm(hlcg).incblock;
+          thlcgwasm(hlcg).decstack(current_asmdata.CurrAsmList,1);
+          current_asmdata.CurrAsmList.Concat(taicpu.op_sym(a_throw,current_asmdata.WeakRefAsmSymbol(FPC_EXCEPTION_TAG_SYM,AT_WASM_EXCEPTION_TAG)));
+          current_asmdata.CurrAsmList.concat(taicpu.op_none(a_end_if));
+          thlcgwasm(hlcg).decblock;
+        end;
+
+      begin
+        location_reset(location,LOC_VOID,OS_NO);
+        oldBreakLabel:=nil;
+        oldContinueLabel:=nil;
+        continuefinallylabel:=nil;
+        breakfinallylabel:=nil;
+        oldLoopBreakBr:=0;
+        oldLoopContBr:=0;
+
+        in_loop:=assigned(current_procinfo.CurrBreakLabel);
+
+        if not implicitframe then
+          exceptframekind:=tek_normalfinally
+        else
+          exceptframekind:=tek_implicitfinally;
+
+        { in 'no exceptions' mode, we still want to handle properly exit,
+          continue and break (they still need to execute the 'finally'
+          statements), so for this we need excepttemps.reasonbuf, and for this
+          reason, we need to allocate excepttemps }
+        cexceptionstatehandler.get_exception_temps(current_asmdata.CurrAsmList,excepttemps);
+        cexceptionstatehandler.new_exception(current_asmdata.CurrAsmList,excepttemps,exceptframekind,finallyexceptionstate);
+
+        { the finally block must catch break, continue and exit }
+        { statements                                            }
+
+        { the outer 'try..finally' block }
+        current_asmdata.CurrAsmList.concat(taicpu.op_none(a_block));
+        thlcgwasm(hlcg).incblock;
+
+        { the 'exit' block }
+        current_asmdata.CurrAsmList.concat(taicpu.op_none(a_block));
+        thlcgwasm(hlcg).incblock;
+
+        oldCurrExitLabel:=current_procinfo.CurrExitLabel;
+        oldExitBr:=thlcgwasm(hlcg).exitBr;
+        exitfinallylabel:=get_jump_out_of_try_finally_frame_label(finallyexceptionstate);
+        current_procinfo.CurrExitLabel:=exitfinallylabel;
+        thlcgwasm(hlcg).exitBr:=thlcgwasm(hlcg).br_blocks;
+
+        { the 'break' block }
+        current_asmdata.CurrAsmList.concat(taicpu.op_none(a_block));
+        thlcgwasm(hlcg).incblock;
+
+        if in_loop then
+          begin
+            oldBreakLabel:=current_procinfo.CurrBreakLabel;
+            oldLoopBreakBr:=thlcgwasm(hlcg).loopBreakBr;
+            breakfinallylabel:=get_jump_out_of_try_finally_frame_label(finallyexceptionstate);
+            current_procinfo.CurrBreakLabel:=breakfinallylabel;
+            thlcgwasm(hlcg).loopBreakBr:=thlcgwasm(hlcg).br_blocks;
+          end;
+
+        { the 'continue' block }
+        current_asmdata.CurrAsmList.concat(taicpu.op_none(a_block));
+        thlcgwasm(hlcg).incblock;
+
+        if in_loop then
+          begin
+            oldContinueLabel:=current_procinfo.CurrContinueLabel;
+            oldLoopContBr:=thlcgwasm(hlcg).loopContBr;
+            continuefinallylabel:=get_jump_out_of_try_finally_frame_label(finallyexceptionstate);
+            current_procinfo.CurrContinueLabel:=continuefinallylabel;
+            thlcgwasm(hlcg).loopContBr:=thlcgwasm(hlcg).br_blocks;
+          end;
+
+        { the inner 'try..end_try' block }
+        current_asmdata.CurrAsmList.concat(taicpu.op_none(a_try));
+        thlcgwasm(hlcg).incblock;
+
+        { try code }
+        if assigned(left) then
+          begin
+            secondpass(left);
+            if codegenerror then
+              exit;
+          end;
+
+        { don't generate line info for internal cleanup }
+        current_asmdata.CurrAsmList.concat(tai_marker.create(mark_NoLineInfoStart));
+
+        cexceptionstatehandler.end_try_block(current_asmdata.CurrAsmList,exceptframekind,excepttemps,finallyexceptionstate,nil);
+
+        { we've reached the end of the 'try' block, with no exceptions/exit/break/continue, so set exceptionreason:=0 }
+        hlcg.g_exception_reason_save_const(current_asmdata.CurrAsmList,exceptionreasontype,0,excepttemps.reasonbuf);
+        current_asmdata.CurrAsmList.concat(taicpu.op_const(a_br,4)); // jump to the 'finally' section
+
+        current_asmdata.CurrAsmList.concat(taicpu.op_sym(a_catch,current_asmdata.WeakRefAsmSymbol(FPC_EXCEPTION_TAG_SYM,AT_WASM_EXCEPTION_TAG)));
+        { exceptionreason:=1 (exception) }
+        hlcg.g_exception_reason_save_const(current_asmdata.CurrAsmList,exceptionreasontype,1,excepttemps.reasonbuf);
+        current_asmdata.CurrAsmList.concat(taicpu.op_const(a_br,4)); // jump to the 'finally' section
+
+        { exit the inner 'try..end_try' block }
+        current_asmdata.CurrAsmList.concat(taicpu.op_none(a_end_try));
+        thlcgwasm(hlcg).decblock;
+
+        { exit the 'continue' block }
+        current_asmdata.CurrAsmList.concat(taicpu.op_none(a_end_block));
+        thlcgwasm(hlcg).decblock;
+        { exceptionreason:=4 (continue) }
+        hlcg.g_exception_reason_save_const(current_asmdata.CurrAsmList,exceptionreasontype,4,excepttemps.reasonbuf);
+        current_asmdata.CurrAsmList.concat(taicpu.op_const(a_br,2)); // jump to the 'finally' section
+
+        { exit the 'break' block }
+        current_asmdata.CurrAsmList.concat(taicpu.op_none(a_end_block));
+        thlcgwasm(hlcg).decblock;
+        { exceptionreason:=3 (break) }
+        hlcg.g_exception_reason_save_const(current_asmdata.CurrAsmList,exceptionreasontype,3,excepttemps.reasonbuf);
+        current_asmdata.CurrAsmList.concat(taicpu.op_const(a_br,1)); // jump to the 'finally' section
+
+        { exit the 'exit' block }
+        current_asmdata.CurrAsmList.concat(taicpu.op_none(a_end_block));
+        thlcgwasm(hlcg).decblock;
+        { exceptionreason:=2 (exit) }
+        hlcg.g_exception_reason_save_const(current_asmdata.CurrAsmList,exceptionreasontype,2,excepttemps.reasonbuf);
+        { proceed to the 'finally' section, which follow immediately, no need for jumps }
+
+        { exit the outer 'try..finally' block }
+        current_asmdata.CurrAsmList.concat(taicpu.op_none(a_end_block));
+        thlcgwasm(hlcg).decblock;
+
+        { end cleanup }
+        current_asmdata.CurrAsmList.concat(tai_marker.create(mark_NoLineInfoEnd));
+
+        { finally code (don't unconditionally set fc_inflowcontrol, since the
+          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,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,fc_catching_exceptions]) then
+          CGMessage(cg_e_control_flow_outside_finally);
+        if codegenerror then
+          exit;
+
+        { don't generate line info for internal cleanup }
+        current_asmdata.CurrAsmList.concat(tai_marker.create(mark_NoLineInfoStart));
+
+        if fc_exit in finallyexceptionstate.newflowcontrol then
+          generate_exceptreason_check_br(2,thlcgwasm(hlcg).br_blocks-oldExitBr);
+        if fc_break in finallyexceptionstate.newflowcontrol then
+          generate_exceptreason_check_br(3,thlcgwasm(hlcg).br_blocks-oldLoopBreakBr);
+        if fc_continue in finallyexceptionstate.newflowcontrol then
+          generate_exceptreason_check_br(4,thlcgwasm(hlcg).br_blocks-oldLoopContBr);
+        generate_exceptreason_throw(1);
+
+        cexceptionstatehandler.unget_exception_temps(current_asmdata.CurrAsmList,excepttemps);
+
+        { end cleanup }
+        current_asmdata.CurrAsmList.concat(tai_marker.create(mark_NoLineInfoEnd));
+
+        current_procinfo.CurrExitLabel:=oldCurrExitLabel;
+        thlcgwasm(hlcg).exitBr:=oldExitBr;
+        if assigned(current_procinfo.CurrBreakLabel) then
+         begin
+           current_procinfo.CurrContinueLabel:=oldContinueLabel;
+           thlcgwasm(hlcg).loopContBr:=oldLoopContBr;
+           current_procinfo.CurrBreakLabel:=oldBreakLabel;
+           thlcgwasm(hlcg).loopBreakBr:=oldLoopBreakBr;
+         end;
+        flowcontrol:=finallyexceptionstate.oldflowcontrol+(finallyexceptionstate.newflowcontrol-[fc_inflowcontrol,fc_catching_exceptions]);
+      end;
+
     procedure twasmtryfinallynode.pass_generate_code;
       begin
         if ts_wasm_no_exceptions in current_settings.targetswitches then
@@ -912,6 +1296,8 @@ implementation
           pass_generate_code_js_exceptions
         else if ts_wasm_native_exceptions in current_settings.targetswitches then
           pass_generate_code_native_exceptions
+        else if ts_wasm_bf_exceptions in current_settings.targetswitches then
+          pass_generate_code_bf_exceptions
         else
           internalerror(2021091704);
       end;
@@ -987,6 +1373,61 @@ implementation
           secondpass(left);
       end;
 
+    procedure twasmonnode.pass_generate_code_bf_exceptions;
+      var
+        exceptvarsym : tlocalvarsym;
+        exceptlocdef: tdef;
+        exceptlocreg: tregister;
+      begin
+        location_reset(location,LOC_VOID,OS_NO);
+
+        cexceptionstatehandler.begin_catch(current_asmdata.CurrAsmList,excepttype,nil,exceptlocdef,exceptlocreg);
+
+        { Retrieve exception variable }
+        if assigned(excepTSymtable) then
+          exceptvarsym:=tlocalvarsym(excepTSymtable.SymList[0])
+        else
+          internalerror(2011020401);
+
+        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, exceptlocdef, exceptvarsym.vardef, exceptlocreg, exceptvarsym.localloc.reference);
+          end;
+
+        { in the case that another exception is risen
+          we've to destroy the old one, so create a new
+          exception frame for the catch-handler }
+        current_asmdata.CurrAsmList.concat(taicpu.op_none(a_try));
+        thlcgwasm(hlcg).incblock;
+
+        if assigned(right) then
+          secondpass(right);
+
+        hlcg.g_call_system_proc(current_asmdata.CurrAsmList,'fpc_doneexception',[],nil).resetiftemp;
+        current_asmdata.CurrAsmList.concat(taicpu.op_const(a_br,2));
+
+        current_asmdata.CurrAsmList.concat(taicpu.op_sym(a_catch,current_asmdata.WeakRefAsmSymbol(FPC_EXCEPTION_TAG_SYM,AT_WASM_EXCEPTION_TAG)));
+
+        hlcg.g_call_system_proc(current_asmdata.CurrAsmList,'fpc_raise_nested',[],nil).resetiftemp;
+
+        current_asmdata.CurrAsmList.concat(taicpu.op_none(a_end_try));
+        thlcgwasm(hlcg).decblock;
+
+        { clear some stuff }
+        if assigned(exceptvarsym) then
+          begin
+            tg.UngetLocal(current_asmdata.CurrAsmList,exceptvarsym.localloc.reference);
+            exceptvarsym.localloc.loc:=LOC_INVALID;
+          end;
+        cexceptionstatehandler.end_catch(current_asmdata.CurrAsmList);
+
+        { next on node }
+        if assigned(left) then
+          secondpass(left);
+      end;
+
     procedure twasmonnode.pass_generate_code;
       begin
         if ts_wasm_no_exceptions in current_settings.targetswitches then
@@ -995,6 +1436,8 @@ implementation
           pass_generate_code_js_exceptions
         else if ts_wasm_native_exceptions in current_settings.targetswitches then
           pass_generate_code_native_exceptions
+        else if ts_wasm_bf_exceptions in current_settings.targetswitches then
+          pass_generate_code_bf_exceptions
         else
           internalerror(2021092802);
       end;

compiler/wasm32/nwasmutil.pas

@@ -71,7 +71,8 @@ implementation
 
       list.Concat(tai_globaltype.create(STACK_POINTER_SYM,wbt_i32,false));
 
-      if ts_wasm_native_exceptions in current_settings.targetswitches then
+      if (ts_wasm_native_exceptions in current_settings.targetswitches) or
+         (ts_wasm_bf_exceptions in current_settings.targetswitches) then
         begin
           list.Concat(tai_tagtype.create(FPC_EXCEPTION_TAG_SYM, []));
           list.Concat(tai_symbol.Create_Weak(current_asmdata.WeakRefAsmSymbol(FPC_EXCEPTION_TAG_SYM,AT_WASM_EXCEPTION_TAG),0));

rtl/inc/compproc.inc

@@ -711,10 +711,10 @@ procedure fpc_dispatch_by_id(Result: Pointer; const Dispatch: pointer;DispDesc:
 
 
 {$ifdef FPC_HAS_FEATURE_EXCEPTIONS}
-{$ifndef FPC_WASM_NATIVE_EXCEPTIONS)}
+{$if not defined(FPC_WASM_NATIVE_EXCEPTIONS) and not defined(FPC_WASM_BRANCHFUL_EXCEPTIONS)}
 Function fpc_PushExceptAddr (Ft: {$ifdef CPU16}SmallInt{$else}Longint{$endif};_buf,_newaddr : pointer): PJmp_buf ; compilerproc;
 Procedure fpc_PopAddrStack; compilerproc;
-{$endif FPC_WASM_NATIVE_EXCEPTIONS)}
+{$endif}
 procedure fpc_Raiseexception (Obj : TObject; AnAddr : CodePointer; AFrame : Pointer); compilerproc;
 function fpc_PopObjectStack : TObject; compilerproc;
 function fpc_PopSecondObjectStack : TObject; compilerproc;

rtl/inc/objpas.inc

@@ -1205,6 +1205,8 @@
 {$ifdef FPC_HAS_FEATURE_EXCEPTIONS}
   {$if defined(FPC_WASM_NATIVE_EXCEPTIONS)}
     {$I except_native.inc}
+  {$elseif defined(FPC_WASM_BRANCHFUL_EXCEPTIONS)}
+    {$I except_branchful.inc}
   {$else}
     {$i except.inc}
   {$endif}

rtl/wasm32/except_branchful.inc

@@ -0,0 +1,328 @@
+{
+    This file is part of the Free Pascal run time library.
+    Copyright (c) 1999-2000 by Michael Van Canneyt
+    member of the Free Pascal development team
+
+    See the file COPYING.FPC, included in this distribution,
+    for details about the copyright.
+
+    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.
+
+ **********************************************************************}
+
+{****************************************************************************
+                                Exception support
+****************************************************************************}
+
+
+{$ifdef FPC_HAS_FEATURE_THREADING}
+ThreadVar
+{$else FPC_HAS_FEATURE_THREADING}
+Var
+{$endif FPC_HAS_FEATURE_THREADING}
+  ExceptObjectStack : PExceptObject;
+  ExceptTryLevel    : ObjpasInt;
+
+{$ifdef FPC_USE_PSABIEH}
+{$i psabieh.inc}
+{$endif}
+
+Function RaiseList : PExceptObject;
+begin
+  RaiseList:=ExceptObjectStack;
+end;
+
+
+function AcquireExceptionObject: Pointer;
+var
+  _ExceptObjectStack : PExceptObject;
+begin
+  _ExceptObjectStack:=ExceptObjectStack;
+  If _ExceptObjectStack<>nil then
+    begin
+      Inc(_ExceptObjectStack^.refcount);
+      AcquireExceptionObject := _ExceptObjectStack^.FObject;
+    end
+  else
+    RunError(231);
+end;
+
+
+procedure ReleaseExceptionObject;
+var
+  _ExceptObjectStack : PExceptObject;
+begin
+  _ExceptObjectStack:=ExceptObjectStack;
+  If _ExceptObjectStack <> nil then
+    begin
+      if _ExceptObjectStack^.refcount > 0 then
+        Dec(_ExceptObjectStack^.refcount);
+    end
+  else
+    RunError(231);
+end;
+
+
+{ This routine is called only from fpc_raiseexception, which uses ExceptTryLevel
+  flag to guard against repeated exceptions which can occur due to corrupted stack
+  or heap. }
+function PushExceptObject(Obj : TObject; AnAddr : CodePointer; AFrame : Pointer): PExceptObject;
+var
+  Newobj : PExceptObject;
+  _ExceptObjectStack : ^PExceptObject;
+  framebufsize,
+  framecount  : PtrInt;
+  frames      : PCodePointer;
+  prev_frame,
+  curr_frame  : Pointer;
+  curr_addr   : CodePointer;
+begin
+{$ifdef excdebug}
+  writeln ('In PushExceptObject');
+{$endif}
+  _ExceptObjectStack:=@ExceptObjectStack;
+  NewObj:=AllocMem(sizeof(TExceptObject));
+  NewObj^.Next:=_ExceptObjectStack^;
+  _ExceptObjectStack^:=NewObj;
+
+  NewObj^.FObject:=Obj;
+  NewObj^.Addr:=AnAddr;
+  if assigned(get_frame) then
+    begin
+      NewObj^.refcount:=0;
+
+      { Backtrace }
+      curr_frame:=AFrame;
+      curr_addr:=AnAddr;
+      frames:=nil;
+      framecount:=0;
+      framebufsize:=0;
+      { The frame pointer of this procedure is used as initial stack bottom value. }
+      prev_frame:=get_frame;
+      while (framecount<RaiseMaxFrameCount) and (curr_frame > prev_frame) and
+            (curr_frame<StackTop) do
+        Begin
+          prev_frame:=curr_frame;
+          get_caller_stackinfo(curr_frame,curr_addr);
+          if (curr_addr=nil) or
+             (curr_frame=nil) then
+            break;
+          if (framecount>=framebufsize) then
+            begin
+              inc(framebufsize,16);
+              reallocmem(frames,framebufsize*sizeof(codepointer));
+            end;
+          frames[framecount]:=curr_addr;
+          inc(framecount);
+        End;
+      NewObj^.framecount:=framecount;
+      NewObj^.frames:=frames;
+    end;
+  Result:=NewObj;
+end;
+
+Procedure DoUnHandledException;
+var
+  _ExceptObjectStack : PExceptObject;
+begin
+  _ExceptObjectStack:=ExceptObjectStack;
+  If (ExceptProc<>Nil) and (_ExceptObjectStack<>Nil) then
+    with _ExceptObjectStack^ do
+      begin
+        TExceptProc(ExceptProc)(FObject,Addr,FrameCount,Frames);
+        halt(217)
+      end;
+  if erroraddr = nil then
+    RunError(217)
+  else
+    Halt(errorcode);
+end;
+
+{$ifndef FPC_SYSTEM_HAS_RAISEEXCEPTION}
+procedure fpc_RaiseException (Obj : TObject; AnAddr : CodePointer; AFrame : Pointer);[Public, Alias : 'FPC_RAISEEXCEPTION']; compilerproc;
+var
+  _ExceptObjectStack : PExceptObject;
+  _ExceptAddrstack : PExceptAddr;
+begin
+{$ifdef excdebug}
+  writeln ('In RaiseException');
+{$endif}
+  if ExceptTryLevel<>0 then
+    Halt(217);
+  ExceptTryLevel:=1;
+  PushExceptObject(Obj,AnAddr,AFrame);
+  { if PushExceptObject causes another exception, the following won't be executed,
+    causing halt upon entering this routine recursively. }
+  ExceptTryLevel:=0;
+//  _ExceptAddrstack:=ExceptAddrStack;
+//  If _ExceptAddrStack=Nil then
+//    DoUnhandledException;
+  _ExceptObjectStack:=ExceptObjectStack;
+  if (RaiseProc <> nil) and (_ExceptObjectStack <> nil) then
+    with _ExceptObjectStack^ do
+      RaiseProc(FObject,Addr,FrameCount,Frames);
+  //longjmp(_ExceptAddrStack^.Buf^,FPC_Exception);
+  fpc_wasm32_throw_fpcexception;
+end;
+{$endif FPC_SYSTEM_HAS_RAISEEXCEPTION}
+
+
+function fpc_PopObjectStack : TObject;[Public, Alias : 'FPC_POPOBJECTSTACK']; compilerproc;
+var
+  hp : PExceptObject;
+begin
+{$ifdef excdebug}
+  writeln ('In PopObjectstack');
+{$endif}
+  hp:=ExceptObjectStack;
+  if hp=nil then
+    begin
+{$ifdef excdebug}
+      writeln ('At end of ExceptionObjectStack');
+{$endif}
+      halt (1);
+    end
+  else
+    begin
+       { we need to return the exception object to dispose it }
+       if hp^.refcount = 0 then
+         fpc_PopObjectStack:=hp^.FObject
+       else
+         fpc_PopObjectStack:=nil;
+       ExceptObjectStack:=hp^.next;
+       if assigned(hp^.frames) then
+         freemem(hp^.frames);
+       dispose(hp);
+       erroraddr:=nil;
+    end;
+end;
+
+
+{ this is for popping exception objects when a second exception is risen }
+{ in an except/on                                                        }
+function fpc_PopSecondObjectStack : TObject;[Public, Alias : 'FPC_POPSECONDOBJECTSTACK']; compilerproc;
+var
+  hp,_ExceptObjectStack : PExceptObject;
+begin
+{$ifdef excdebug}
+  writeln ('In PopObjectstack');
+{$endif}
+  _ExceptObjectStack:=ExceptObjectStack;
+  If not(assigned(_ExceptObjectStack)) or
+     not(assigned(_ExceptObjectStack^.next)) then
+    begin
+{$ifdef excdebug}
+      writeln ('At end of ExceptionObjectStack');
+{$endif}
+      halt (1);
+    end
+  else
+    begin
+      if _ExceptObjectStack^.next^.refcount=0 then
+        { we need to return the exception object to dispose it if refcount=0 }
+        fpc_PopSecondObjectStack:=_ExceptObjectStack^.next^.FObject
+      else
+        fpc_PopSecondObjectStack:=nil;
+      hp:=_ExceptObjectStack^.next;
+      _ExceptObjectStack^.next:=hp^.next;
+      if assigned(hp^.frames) then
+        freemem(hp^.frames);
+      dispose(hp);
+    end;
+end;
+
+{$ifndef FPC_SYSTEM_HAS_RERAISE}
+Procedure fpc_ReRaise;[Public, Alias : 'FPC_RERAISE']; compilerproc;
+var
+  _ExceptAddrStack : PExceptAddr;
+begin
+{$ifdef excdebug}
+  writeln ('In reraise');
+{$endif}
+//  _ExceptAddrStack:=ExceptAddrStack;
+//  If _ExceptAddrStack=Nil then
+//    DoUnHandledException;
+  ExceptObjectStack^.refcount := 0;
+//  longjmp(_ExceptAddrStack^.Buf^,FPC_Exception);
+  fpc_wasm32_throw_fpcexception;
+end;
+{$endif FPC_SYSTEM_HAS_RERAISE}
+
+function Internal_PopSecondObjectStack : TObject; external name 'FPC_POPSECONDOBJECTSTACK';
+function Internal_PopObjectStack: TObject; external name 'FPC_POPOBJECTSTACK';
+procedure Internal_Reraise; external name 'FPC_RERAISE';
+
+Function fpc_Catches(Objtype : TClass) : TObject;[Public, Alias : 'FPC_CATCHES']; compilerproc;
+var
+  _ExceptObjectStack : PExceptObject;
+begin
+  _ExceptObjectStack:=ExceptObjectStack;
+  If _ExceptObjectStack=Nil then
+   begin
+{$ifdef excdebug}
+     Writeln ('Internal error.');
+{$endif}
+     halt (255);
+   end;
+  if Not ((Objtype = TClass(CatchAllExceptions)) or
+         (_ExceptObjectStack^.FObject is ObjType)) then
+    fpc_Catches:=Nil
+  else
+    begin
+      // catch !
+      fpc_Catches:=_ExceptObjectStack^.FObject;
+      { this can't be done, because there could be a reraise (PFV)
+       PopObjectStack;
+
+       Also the PopAddrStack shouldn't be done, we do it now
+       immediatly in the exception handler (FK)
+      PopAddrStack; }
+    end;
+end;
+
+Procedure SysInitExceptions;
+{
+  Initialize exceptionsupport
+}
+begin
+  ExceptObjectstack:=Nil;
+end;
+
+
+{$ifndef FPC_SYSTEM_HAS_DONEEXCEPTION}
+procedure fpc_doneexception;[public,alias:'FPC_DONEEXCEPTION'] compilerproc;
+begin
+  Internal_PopObjectStack.Free;
+end;
+{$endif FPC_SYSTEM_HAS_DONEEXCEPTION}
+
+{$ifndef FPC_SYSTEM_HAS_RAISENESTED}
+procedure fpc_raise_nested;[public,alias:'FPC_RAISE_NESTED']compilerproc;
+begin
+  Internal_PopSecondObjectStack.Free;
+  Internal_Reraise;
+end;
+{$endif FPC_SYSTEM_HAS_RAISENESTED}
+
+{$ifndef FPC_SYSTEM_HAS_SAFECALLHANDLER}
+function fpc_safecallhandler(obj: TObject): HResult; [public,alias:'FPC_SAFECALLHANDLER']; compilerproc;
+var
+  raiselist: PExceptObject;
+  adr: CodePointer;
+  exc: TObject;
+begin
+  raiselist:=ExceptObjectStack;
+  if Assigned(raiseList) then
+    adr:=raiseList^.Addr
+  else
+    adr:=nil;
+  exc:=Internal_PopObjectStack;
+  if Assigned(obj) and Assigned(exc) then
+    result:=obj.SafeCallException(exc,adr)
+  else
+    result:=E_UNEXPECTED;
+  exc.Free;
+end;
+{$endif FPC_SYSTEM_HAS_SAFECALLHANDLER}