소스 검색

* WebAssembly exceptions fix: fixed raise without parameters in except..end
blocks in WebAssembly native and branchful exceptions mode. Fixes #39752

Nikolay Nikolov 3 년 전
부모
커밋
bc6ab39ea2
4개의 변경된 파일37개의 추가작업 그리고 2개의 파일을 삭제
  1. 2 2
      compiler/wasm32/nwasmflw.pas
  2. 3 0
      rtl/inc/compproc.inc
  3. 16 0
      rtl/wasm32/except_branchful.inc
  4. 16 0
      rtl/wasm32/except_native.inc

+ 2 - 2
compiler/wasm32/nwasmflw.pas

@@ -338,7 +338,7 @@ implementation
         else
           begin
             //addstatement(statements,ccallnode.createintern('fpc_popaddrstack',nil));
-            raisenode:=ccallnode.createintern('fpc_reraise',nil);
+            raisenode:=ccallnode.createintern('fpc_reraise2',nil);
             include(raisenode.callnodeflags,cnf_call_never_returns);
             addstatement(statements,raisenode);
           end;
@@ -395,7 +395,7 @@ implementation
         else
           begin
             //addstatement(statements,ccallnode.createintern('fpc_popaddrstack',nil));
-            raisenode:=ccallnode.createintern('fpc_reraise',nil);
+            raisenode:=ccallnode.createintern('fpc_reraise2',nil);
             include(raisenode.callnodeflags,cnf_call_never_returns);
             addstatement(statements,raisenode);
           end;

+ 3 - 0
rtl/inc/compproc.inc

@@ -723,6 +723,9 @@ procedure fpc_Raiseexception (Obj : TObject; AnAddr : CodePointer; AFrame : Poin
 function fpc_PopObjectStack : TObject; compilerproc;
 function fpc_PopSecondObjectStack : TObject; compilerproc;
 Procedure fpc_ReRaise; compilerproc;
+{$if defined(FPC_WASM_NATIVE_EXCEPTIONS) or defined(FPC_WASM_BRANCHFUL_EXCEPTIONS)}
+Procedure fpc_ReRaise2; compilerproc;
+{$endif}
 Function fpc_Catches(Objtype : TClass) : TObject; compilerproc;
 function fpc_safecallhandler(obj: TObject): HResult; compilerproc;
 function fpc_safecallcheck(res : hresult) : hresult; compilerproc; {$ifdef CPU86} register; {$endif}

+ 16 - 0
rtl/wasm32/except_branchful.inc

@@ -267,6 +267,22 @@ function Internal_PopSecondObjectStack : TObject; external name 'FPC_POPSECONDOB
 function Internal_PopObjectStack: TObject; external name 'FPC_POPOBJECTSTACK';
 procedure Internal_Reraise; external name 'FPC_RERAISE';
 
+Procedure fpc_ReRaise2;[Public, Alias : 'FPC_RERAISE2']; compilerproc;
+var
+  Newobj : PExceptObject;
+  _ExceptObjectStack : PExceptObject;
+begin
+{$ifdef excdebug}
+  writeln ('In reraise2');
+{$endif}
+  _ExceptObjectStack:=ExceptObjectStack;
+  NewObj:=AllocMem(sizeof(TExceptObject));
+  NewObj^.Next:=_ExceptObjectStack^.Next;
+  _ExceptObjectStack^.Next:=NewObj;
+
+  Internal_Reraise;
+end;
+
 Function fpc_Catches(Objtype : TClass) : TObject;[Public, Alias : 'FPC_CATCHES']; compilerproc;
 var
   _ExceptObjectStack : PExceptObject;

+ 16 - 0
rtl/wasm32/except_native.inc

@@ -254,6 +254,22 @@ function Internal_PopSecondObjectStack : TObject; external name 'FPC_POPSECONDOB
 function Internal_PopObjectStack: TObject; external name 'FPC_POPOBJECTSTACK';
 procedure Internal_Reraise; external name 'FPC_RERAISE';
 
+Procedure fpc_ReRaise2;[Public, Alias : 'FPC_RERAISE2']; compilerproc;
+var
+  Newobj : PExceptObject;
+  _ExceptObjectStack : PExceptObject;
+begin
+{$ifdef excdebug}
+  writeln ('In reraise2');
+{$endif}
+  _ExceptObjectStack:=ExceptObjectStack;
+  NewObj:=AllocMem(sizeof(TExceptObject));
+  NewObj^.Next:=_ExceptObjectStack^.Next;
+  _ExceptObjectStack^.Next:=NewObj;
+
+  Internal_Reraise;
+end;
+
 Function fpc_Catches(Objtype : TClass) : TObject;[Public, Alias : 'FPC_CATCHES']; compilerproc;
 var
   _ExceptObjectStack : PExceptObject;