+ initial implementation of WebAssembly promising exports

compiler/export.pas

@@ -37,7 +37,8 @@ type
      eo_resident,
      eo_index,
      eo_name,
-     eo_no_sym_name { don't try to use another mangled name if symbol is known }
+     eo_no_sym_name, { don't try to use another mangled name if symbol is known }
+     eo_promising
    );
    texportoptions=set of texportoption;
 

compiler/pexports.pas

@@ -176,6 +176,11 @@ implementation
                        include(options,eo_resident);
                        DefString:=srsym.realname+'='+InternalProcName;{Resident ignored!}
                      end;
+                    if try_to_consume(_PROMISING) then
+                     begin
+                       if target_info.system in systems_wasm then
+                         include(options,eo_promising);
+                     end;
                     if (DefString<>'') and UseDeffileForExports then
                      DefFile.AddExport(DefString);
                   end;

compiler/symconst.pas

@@ -505,7 +505,8 @@ type
     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_wasm_suspending
+    tsk_wasm_suspending,
+    tsk_wasm_promising
   );
 
   { synthetic procdef supplementary information (tprocdef.skpara) }

compiler/symcreat.pas

@@ -137,7 +137,7 @@ implementation
 {$ifdef jvm}
     pjvm,jvmdef,
 {$endif jvm}
-    symcpu,
+    aasmcpu,symcpu,
     nbas,nld,nmem,ncon,
     defcmp,
     paramgr;
@@ -230,7 +230,7 @@ implementation
     end;
 
 
-  function str_parse_method_impl_with_fileinfo(str: ansistring; usefwpd: tprocdef; fileno, lineno: longint; is_classdef: boolean):boolean;
+  function str_parse_method_impl_with_fileinfo(str: ansistring; usefwpd: tprocdef; fileno, lineno: longint; is_classdef: boolean; out result_procdef: tprocdef):boolean;
      var
        oldparse_only: boolean;
        tmpstr: ansistring;
@@ -261,7 +261,7 @@ implementation
       flags:=[];
       if is_classdef then
         include(flags,rpf_classmethod);
-      read_proc(flags,usefwpd);
+      result_procdef:=read_proc(flags,usefwpd);
       parse_only:=oldparse_only;
       { remove the temporary macro input file again }
       current_scanner.closeinputfile;
@@ -272,8 +272,16 @@ implementation
 
 
   function str_parse_method_impl(const str: ansistring; usefwpd: tprocdef; is_classdef: boolean):boolean;
+    var
+      tmpproc: tprocdef;
     begin
-      result:=str_parse_method_impl_with_fileinfo(str, usefwpd, current_scanner.inputfile.ref_index, current_scanner.line_no, is_classdef);
+      result:=str_parse_method_impl_with_fileinfo(str, usefwpd, current_scanner.inputfile.ref_index, current_scanner.line_no, is_classdef, tmpproc);
+    end;
+
+
+  function str_parse_method_impl(const str: ansistring; usefwpd: tprocdef; is_classdef: boolean; out result_procdef: tprocdef):boolean;
+    begin
+      result:=str_parse_method_impl_with_fileinfo(str, usefwpd, current_scanner.inputfile.ref_index, current_scanner.line_no, is_classdef, result_procdef);
     end;
 
 
@@ -942,6 +950,37 @@ implementation
       str_parse_method_impl(str,pd,false);
       exclude(pd.procoptions,po_external);
     end;
+
+  procedure implement_wasm_promising(pd: tcpuprocdef);
+    var
+      str: ansistring;
+      wrapper_name: ansistring;
+      new_wrapper_pd: tprocdef;
+    begin
+      wrapper_name:=pd.promising_wrapper_name;
+
+      if is_void(pd.returndef) then
+        str:='procedure '
+      else
+        str:='function ';
+      str:=str+wrapper_name+'(__fpc_wasm_susp: WasmExternRef;';
+      addvisibleparameterdeclarations(str,pd);
+      if str[Length(str)]=';' then
+        delete(str,Length(str),1);
+      str:=str+')';
+      if not is_void(pd.returndef) then
+        str:=str+': '+pd.returndef.fulltypename;
+      str:=str+'; begin __fpc_wasm_suspender:=__fpc_wasm_susp;';
+      if not is_void(pd.returndef) then
+        str:=str+' result:=';
+      str:=str+pd.procsym.RealName+'(';
+      addvisibleparameters(str,pd);
+      if str[Length(str)]=',' then
+        delete(str,Length(str),1);
+      str:=str+'); end;';
+      str_parse_method_impl(str,nil,false,new_wrapper_pd);
+      current_asmdata.asmlists[al_exports].Concat(tai_export_name.create(pd.promising_export_name,new_wrapper_pd.mangledname,ie_Func));
+    end;
 {$endif wasm}
 
 
@@ -1050,7 +1089,7 @@ implementation
   procedure implement_interface_wrapper(pd: tprocdef);
     var
       wrapperinfo: pskpara_interface_wrapper;
-      callthroughpd: tprocdef;
+      callthroughpd, tmpproc: tprocdef;
       str: ansistring;
       fileinfo: tfileposinfo;
     begin
@@ -1078,7 +1117,7 @@ implementation
           fileinfo.line:=1;
           fileinfo.column:=1;
         end;
-      str_parse_method_impl_with_fileinfo(str,pd,fileinfo.fileindex,fileinfo.line,false);
+      str_parse_method_impl_with_fileinfo(str,pd,fileinfo.fileindex,fileinfo.line,false,tmpproc);
       dispose(wrapperinfo);
       pd.skpara:=nil;
     end;
@@ -1188,8 +1227,11 @@ implementation
 {$ifdef wasm}
             tsk_wasm_suspending:
               implement_wasm_suspending(tcpuprocdef(pd));
+            tsk_wasm_promising:
+              implement_wasm_promising(tcpuprocdef(pd));
 {$else wasm}
-            tsk_wasm_suspending:
+            tsk_wasm_suspending,
+            tsk_wasm_promising:
               internalerror(2023061107);
 {$endif wasm}
             tsk_field_getter:

compiler/systems/t_wasi.pas

@@ -37,7 +37,7 @@ uses
   import, export, aasmdata, aasmcpu,
   fmodule, ogbase,
 
-  symsym, symdef,
+  symconst, symsym, symdef, symcpu,
 
   link,
 
@@ -247,9 +247,19 @@ end;
 procedure texportlibwasi.exportprocedure(hp: texported_item);
 var
   nm : TSymStr;
+  pd: tcpuprocdef;
 begin
-  nm := tprocdef(tprocsym(hp.sym).ProcdefList[0]).mangledname;
-  current_asmdata.asmlists[al_exports].Concat(tai_export_name.create(hp.name^, nm, ie_Func));
+  pd:=tcpuprocdef(tprocsym(hp.sym).ProcdefList[0]);
+  if eo_promising in hp.options then
+    begin
+      pd.synthetickind:=tsk_wasm_promising;
+      pd.promising_export_name:=hp.name^;
+    end
+  else
+    begin
+      nm := pd.mangledname;
+      current_asmdata.asmlists[al_exports].Concat(tai_export_name.create(hp.name^, nm, ie_Func));
+    end;
 end;
 
 procedure texportlibwasi.exportvar(hp: texported_item);

compiler/tokens.pas

@@ -270,6 +270,7 @@ type
     _OBJCCLASS,
     _OTHERWISE,
     _PROCEDURE,
+    _PROMISING,
     _PROTECTED,
     _PUBLISHED,
     _REFERENCE,
@@ -614,6 +615,7 @@ const
       (str:'OBJCCLASS'     ;special:false;keyword:[m_objectivec1];op:NOTOKEN),
       (str:'OTHERWISE'     ;special:false;keyword:alllanguagemodes-[m_iso];op:NOTOKEN),
       (str:'PROCEDURE'     ;special:false;keyword:alllanguagemodes;op:NOTOKEN),
+      (str:'PROMISING'     ;special:false;keyword:[m_none];op:NOTOKEN),
       (str:'PROTECTED'     ;special:false;keyword:[m_none];op:NOTOKEN),
       (str:'PUBLISHED'     ;special:false;keyword:[m_none];op:NOTOKEN),
       (str:'REFERENCE'     ;special:false;keyword:[m_none];op:NOTOKEN),

compiler/wasm32/symcpu.pas

@@ -117,10 +117,12 @@ type
     { generated assembler code; used by WebAssembly backend so it can afterwards
       easily write out all methods grouped per class }
     exprasmlist  : TAsmList;
+    promising_export_name: string;
     destructor destroy; override;
     function create_functype: TWasmFuncType;
     function is_pushleftright: boolean; override;
     function suspending_wrapper_name: ansistring;
+    function promising_wrapper_name: ansistring;
   end;
   tcpuprocdefclass = class of tcpuprocdef;
 
@@ -379,6 +381,12 @@ implementation
     end;
 
 
+  function tcpuprocdef.promising_wrapper_name: ansistring;
+    begin
+      Result:='__fpc_wasm_promising_'+procsym.realname;
+    end;
+
+
 {****************************************************************************
                              tcpuprocvardef
 ****************************************************************************}