mirror of
https://gitlab.com/freepascal.org/fpc/source.git
synced 2025-09-30 04:19:22 +02:00
+ initial attempt (not fully working, yet) at implementing WebAssembly suspending externals
This commit is contained in:
parent
1f286cf736
commit
45ca2c6f88
@ -2405,6 +2405,7 @@ begin
|
|||||||
begin
|
begin
|
||||||
consume(_SUSPENDING);
|
consume(_SUSPENDING);
|
||||||
include(procoptions,po_wasm_suspending);
|
include(procoptions,po_wasm_suspending);
|
||||||
|
synthetickind:=tsk_wasm_suspending;
|
||||||
end;
|
end;
|
||||||
{ default is to used the realname of the procedure }
|
{ default is to used the realname of the procedure }
|
||||||
if (import_nr=0) and not assigned(import_name) then
|
if (import_nr=0) and not assigned(import_name) then
|
||||||
@ -3301,7 +3302,7 @@ const
|
|||||||
it because it can already be used somewhere (PFV) }
|
it because it can already be used somewhere (PFV) }
|
||||||
if not(po_has_mangledname in pd.procoptions) then
|
if not(po_has_mangledname in pd.procoptions) then
|
||||||
begin
|
begin
|
||||||
if (po_external in pd.procoptions) then
|
if (po_external in pd.procoptions) and not (po_wasm_suspending in pd.procoptions) then
|
||||||
begin
|
begin
|
||||||
{ External Procedures are only allowed to change the mangledname
|
{ External Procedures are only allowed to change the mangledname
|
||||||
in their first declaration }
|
in their first declaration }
|
||||||
|
@ -504,7 +504,8 @@ type
|
|||||||
tsk_field_setter, // Setter for a field (callthrough property is passed in skpara)
|
tsk_field_setter, // Setter for a field (callthrough property is passed in skpara)
|
||||||
tsk_block_invoke_procvar, // Call a procvar to invoke inside a block
|
tsk_block_invoke_procvar, // Call a procvar to invoke inside a block
|
||||||
tsk_interface_wrapper, // Call through to a method from an interface wrapper
|
tsk_interface_wrapper, // Call through to a method from an interface wrapper
|
||||||
tsk_call_no_parameters // Call skpara procedure without passing any parameters nor returning a result
|
tsk_call_no_parameters, // Call skpara procedure without passing any parameters nor returning a result
|
||||||
|
tsk_wasm_suspending
|
||||||
);
|
);
|
||||||
|
|
||||||
{ synthetic procdef supplementary information (tprocdef.skpara) }
|
{ synthetic procdef supplementary information (tprocdef.skpara) }
|
||||||
|
@ -137,6 +137,7 @@ implementation
|
|||||||
{$ifdef jvm}
|
{$ifdef jvm}
|
||||||
pjvm,jvmdef,
|
pjvm,jvmdef,
|
||||||
{$endif jvm}
|
{$endif jvm}
|
||||||
|
symcpu,
|
||||||
nbas,nld,nmem,ncon,
|
nbas,nld,nmem,ncon,
|
||||||
defcmp,
|
defcmp,
|
||||||
paramgr;
|
paramgr;
|
||||||
@ -869,6 +870,77 @@ implementation
|
|||||||
end;
|
end;
|
||||||
{$endif jvm}
|
{$endif jvm}
|
||||||
|
|
||||||
|
|
||||||
|
{$ifdef wasm}
|
||||||
|
procedure addvisibleparameterdeclarations(var str: ansistring; pd: tprocdef);
|
||||||
|
var
|
||||||
|
currpara: tparavarsym;
|
||||||
|
i: longint;
|
||||||
|
firstpara: boolean;
|
||||||
|
begin
|
||||||
|
firstpara:=true;
|
||||||
|
for i:=0 to pd.paras.count-1 do
|
||||||
|
begin
|
||||||
|
currpara:=tparavarsym(pd.paras[i]);
|
||||||
|
if not(vo_is_hidden_para in currpara.varoptions) then
|
||||||
|
begin
|
||||||
|
if not firstpara then
|
||||||
|
str:=str+';';
|
||||||
|
firstpara:=false;
|
||||||
|
case currpara.varspez of
|
||||||
|
vs_constref:
|
||||||
|
str:=str+'constref ';
|
||||||
|
vs_out:
|
||||||
|
str:=str+'out ';
|
||||||
|
vs_var:
|
||||||
|
str:=str+'var ';
|
||||||
|
vs_const:
|
||||||
|
str:=str+'const ';
|
||||||
|
vs_value:
|
||||||
|
;
|
||||||
|
end;
|
||||||
|
|
||||||
|
str:=str+currpara.realname;
|
||||||
|
if currpara.vardef.typ<>formaldef then
|
||||||
|
str:=str+':'+currpara.vardef.fulltypename;
|
||||||
|
end;
|
||||||
|
end;
|
||||||
|
end;
|
||||||
|
|
||||||
|
procedure implement_wasm_suspending(pd: tcpuprocdef);
|
||||||
|
var
|
||||||
|
str: ansistring;
|
||||||
|
wrapper_name: ansistring;
|
||||||
|
begin
|
||||||
|
wrapper_name:=pd.suspending_wrapper_name;
|
||||||
|
|
||||||
|
if is_void(pd.returndef) then
|
||||||
|
str:='procedure '
|
||||||
|
else
|
||||||
|
str:='function ';
|
||||||
|
str:=str+wrapper_name+'(__fpc_wasm_susp: WasmExternRef;';
|
||||||
|
addvisibleparameterdeclarations(str,pd);
|
||||||
|
str:=str+'): double; external '''+pd.import_dll^+ ''' name '''+pd.import_name^+''';';
|
||||||
|
str_parse_method_impl(str,nil,false);
|
||||||
|
|
||||||
|
str:='var __fpc_wasm_suspender_copy:WasmExternRef; begin __fpc_wasm_suspender_copy:=__fpc_wasm_suspender; ';
|
||||||
|
|
||||||
|
if not is_void(pd.returndef) then
|
||||||
|
str:=str+' result:=';
|
||||||
|
|
||||||
|
str:=str+wrapper_name+'(__fpc_wasm_suspender_copy,';
|
||||||
|
addvisibleparameters(str,pd);
|
||||||
|
if str[Length(str)]=',' then
|
||||||
|
delete(str,Length(str),1);
|
||||||
|
str:=str+');';
|
||||||
|
str:=str+' __fpc_wasm_suspender:=__fpc_wasm_suspender_copy;';
|
||||||
|
str:=str+' end;';
|
||||||
|
str_parse_method_impl(str,pd,false);
|
||||||
|
exclude(pd.procoptions,po_external);
|
||||||
|
end;
|
||||||
|
{$endif wasm}
|
||||||
|
|
||||||
|
|
||||||
procedure implement_field_getter(pd: tprocdef);
|
procedure implement_field_getter(pd: tprocdef);
|
||||||
var
|
var
|
||||||
i: longint;
|
i: longint;
|
||||||
@ -1109,6 +1181,13 @@ implementation
|
|||||||
tsk_jvm_virtual_clmethod:
|
tsk_jvm_virtual_clmethod:
|
||||||
internalerror(2011032801);
|
internalerror(2011032801);
|
||||||
{$endif jvm}
|
{$endif jvm}
|
||||||
|
{$ifdef wasm}
|
||||||
|
tsk_wasm_suspending:
|
||||||
|
implement_wasm_suspending(tcpuprocdef(pd));
|
||||||
|
{$else wasm}
|
||||||
|
tsk_wasm_suspending:
|
||||||
|
internalerror(2023061107);
|
||||||
|
{$endif wasm}
|
||||||
tsk_field_getter:
|
tsk_field_getter:
|
||||||
implement_field_getter(pd);
|
implement_field_getter(pd);
|
||||||
tsk_field_setter:
|
tsk_field_setter:
|
||||||
|
@ -120,6 +120,7 @@ type
|
|||||||
destructor destroy; override;
|
destructor destroy; override;
|
||||||
function create_functype: TWasmFuncType;
|
function create_functype: TWasmFuncType;
|
||||||
function is_pushleftright: boolean; override;
|
function is_pushleftright: boolean; override;
|
||||||
|
function suspending_wrapper_name: ansistring;
|
||||||
end;
|
end;
|
||||||
tcpuprocdefclass = class of tcpuprocdef;
|
tcpuprocdefclass = class of tcpuprocdef;
|
||||||
|
|
||||||
@ -372,6 +373,12 @@ implementation
|
|||||||
end;
|
end;
|
||||||
|
|
||||||
|
|
||||||
|
function tcpuprocdef.suspending_wrapper_name: ansistring;
|
||||||
|
begin
|
||||||
|
Result:='__fpc_wasm_suspending_'+procsym.realname;
|
||||||
|
end;
|
||||||
|
|
||||||
|
|
||||||
{****************************************************************************
|
{****************************************************************************
|
||||||
tcpuprocvardef
|
tcpuprocvardef
|
||||||
****************************************************************************}
|
****************************************************************************}
|
||||||
|
@ -57,6 +57,7 @@ var
|
|||||||
argc: longint;
|
argc: longint;
|
||||||
argv: PPChar;
|
argv: PPChar;
|
||||||
envp: PPChar;
|
envp: PPChar;
|
||||||
|
__fpc_wasm_suspender: WasmExternRef; section 'WebAssembly.Global';
|
||||||
|
|
||||||
implementation
|
implementation
|
||||||
|
|
||||||
|
Loading…
Reference in New Issue
Block a user