paweld/fpc
1
0
Fork 0
mirror of https://gitlab.com/freepascal.org/fpc/source.git synced 2026-02-04 07:14:50 +01:00
Code Issues Packages Projects Releases Wiki Activity

+ implemented the 'on' node for WebAssembly in native exceptions mode

Browse Source
This commit is contained in:
Nikolay Nikolov 2021-09-28 23:55:10 +03:00
parent 0e647a073e
commit 6e7f0744ca
2 changed files with 114 additions and 4 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

64
compiler/wasm32/cpupi.pas
View File

@ -27,7 +27,7 @@ interface
uses
cutils,globtype,
procinfo,cpuinfo, symtype,aasmbase,
procinfo,cpuinfo, symtype,aasmbase,cgbase,
psub, cclasses;
type
@ -46,13 +46,17 @@ implementation
uses
systems,verbose,globals,cpubase,tgcpu,aasmdata,aasmcpu,aasmtai,cgexcept,
tgobj,paramgr,symconst,symdef,symtable,symcpu,cgutils,pass_2;
tgobj,paramgr,symconst,symdef,symtable,symcpu,cgutils,pass_2,parabase,
fmodule,hlcgobj,hlcgcpu,defutil;
{*****************************************************************************
twasmexceptionstatehandler_noexceptions
*****************************************************************************}
type
{ twasmexceptionstatehandler_noexceptions }
twasmexceptionstatehandler_noexceptions = class(tcgexceptionstatehandler)
class procedure get_exception_temps(list:TAsmList;var t:texceptiontemps); override;
class procedure unget_exception_temps(list:TAsmList;const t:texceptiontemps); override;
@ -143,10 +147,17 @@ implementation
*****************************************************************************}
type
{ twasmexceptionstatehandler_nativeexceptions }
twasmexceptionstatehandler_nativeexceptions = 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_nativeexceptions.new_exception(list:TAsmList;const t:texceptiontemps; const exceptframekind: texceptframekind; out exceptstate: texceptionstate);
@ -167,6 +178,55 @@ implementation
list.Concat(tai_comment.Create(strpnew('TODO: handle_nested_exception')));
end;
class procedure twasmexceptionstatehandler_nativeexceptions.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_EQ, 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_nativeexceptions.end_catch(list: TAsmList);
begin
current_asmdata.CurrAsmList.concat(taicpu.op_none(a_end_if));
thlcgwasm(hlcg).decblock;
end;
{*****************************************************************************
tcpuprocinfo
*****************************************************************************}

54
compiler/wasm32/nwasmflw.pas
View File

@ -96,7 +96,7 @@ implementation
uses
verbose,globals,systems,globtype,constexp,
symconst,symdef,symsym,aasmtai,aasmdata,aasmcpu,defutil,defcmp,
symconst,symdef,symsym,symtype,aasmtai,aasmdata,aasmcpu,defutil,defcmp,
procinfo,cgbase,cgexcept,pass_1,pass_2,parabase,compinnr,
cpubase,cpuinfo,
nbas,nld,ncon,ncnv,ncal,ninl,nmem,nadd,nutils,
@ -460,6 +460,7 @@ implementation
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
@ -925,9 +926,58 @@ implementation
end;
procedure twasmonnode.pass_generate_code_native_exceptions;
var
exceptvarsym : tlocalvarsym;
exceptlocdef: tdef;
exceptlocreg: tregister;
begin
location_reset(location,LOC_VOID,OS_NO);
{ todo: implement }
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;