mirror of
https://gitlab.com/freepascal.org/fpc/source.git
synced 2025-09-21 00:31:42 +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
|
||||
consume(_SUSPENDING);
|
||||
include(procoptions,po_wasm_suspending);
|
||||
synthetickind:=tsk_wasm_suspending;
|
||||
end;
|
||||
{ default is to used the realname of the procedure }
|
||||
if (import_nr=0) and not assigned(import_name) then
|
||||
@ -3301,7 +3302,7 @@ const
|
||||
it because it can already be used somewhere (PFV) }
|
||||
if not(po_has_mangledname in pd.procoptions) then
|
||||
begin
|
||||
if (po_external in pd.procoptions) then
|
||||
if (po_external in pd.procoptions) and not (po_wasm_suspending in pd.procoptions) then
|
||||
begin
|
||||
{ External Procedures are only allowed to change the mangledname
|
||||
in their first declaration }
|
||||
|
@ -504,7 +504,8 @@ type
|
||||
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_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) }
|
||||
|
@ -137,6 +137,7 @@ implementation
|
||||
{$ifdef jvm}
|
||||
pjvm,jvmdef,
|
||||
{$endif jvm}
|
||||
symcpu,
|
||||
nbas,nld,nmem,ncon,
|
||||
defcmp,
|
||||
paramgr;
|
||||
@ -869,6 +870,77 @@ implementation
|
||||
end;
|
||||
{$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);
|
||||
var
|
||||
i: longint;
|
||||
@ -1109,6 +1181,13 @@ implementation
|
||||
tsk_jvm_virtual_clmethod:
|
||||
internalerror(2011032801);
|
||||
{$endif jvm}
|
||||
{$ifdef wasm}
|
||||
tsk_wasm_suspending:
|
||||
implement_wasm_suspending(tcpuprocdef(pd));
|
||||
{$else wasm}
|
||||
tsk_wasm_suspending:
|
||||
internalerror(2023061107);
|
||||
{$endif wasm}
|
||||
tsk_field_getter:
|
||||
implement_field_getter(pd);
|
||||
tsk_field_setter:
|
||||
|
@ -120,6 +120,7 @@ type
|
||||
destructor destroy; override;
|
||||
function create_functype: TWasmFuncType;
|
||||
function is_pushleftright: boolean; override;
|
||||
function suspending_wrapper_name: ansistring;
|
||||
end;
|
||||
tcpuprocdefclass = class of tcpuprocdef;
|
||||
|
||||
@ -372,6 +373,12 @@ implementation
|
||||
end;
|
||||
|
||||
|
||||
function tcpuprocdef.suspending_wrapper_name: ansistring;
|
||||
begin
|
||||
Result:='__fpc_wasm_suspending_'+procsym.realname;
|
||||
end;
|
||||
|
||||
|
||||
{****************************************************************************
|
||||
tcpuprocvardef
|
||||
****************************************************************************}
|
||||
|
@ -57,6 +57,7 @@ var
|
||||
argc: longint;
|
||||
argv: PPChar;
|
||||
envp: PPChar;
|
||||
__fpc_wasm_suspender: WasmExternRef; section 'WebAssembly.Global';
|
||||
|
||||
implementation
|
||||
|
||||
|
Loading…
Reference in New Issue
Block a user