paweld/fpc
1
0
Fork 0
mirror of https://gitlab.com/freepascal.org/fpc/source.git synced 2025-04-06 14:47:55 +02:00
Code Issues Packages Projects Releases Wiki Activity

* WebAssembly exceptions fix: fixed raise without parameters in except..end

Browse Source 
blocks in WebAssembly native and branchful exceptions mode. Fixes #39752
This commit is contained in:
Nikolay Nikolov 2022-06-21 05:43:35 +03:00
parent 48f115686d
commit bc6ab39ea2
4 changed files with 37 additions and 2 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

4
compiler/wasm32/nwasmflw.pas
View File

@ -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
rtl/inc/compproc.inc
View File

@ -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
rtl/wasm32/except_branchful.inc
View File

@ -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
rtl/wasm32/except_native.inc
View File

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