[PATCH 71/83] extended the support for the procedure variables

From 08d2e5a586d1cbe97ea9a2264e074d0bf4c18c19 Mon Sep 17 00:00:00 2001
From: Dmitry Boyarintsev <[email protected]>
Date: Thu, 24 Oct 2019 11:53:24 -0400

git-svn-id: branches/wasm@45948 -

compiler/wasm/aasmcpu.pas

@@ -44,6 +44,7 @@ uses
       { taicpu }
 
       taicpu = class(tai_cpu_abstract_sym)
+         typecode : string; // used for call_indirect
          constructor op_none(op : tasmop);
 
          constructor op_reg(op : tasmop;_op1 : tregister);
@@ -55,6 +56,8 @@ uses
 
          constructor op_single(op : tasmop;_op1 : single);
          constructor op_double(op : tasmop;_op1 : double);
+
+         constructor op_callindirect(const atypecode: string);
          //constructor op_string(op : tasmop;_op1len : aint;_op1 : pchar);
          //constructor op_wstring(op : tasmop;_op1 : pcompilerwidestring);
 
@@ -210,6 +213,12 @@ implementation
         loaddouble(0,_op1);
       end;
 
+    constructor taicpu.op_callindirect(const atypecode: string);
+      begin
+        typecode := atypecode;
+        op_none(a_call_indirect);
+      end;
+
     {constructor taicpu.op_string(op: tasmop; _op1len: aint; _op1: pchar);
       begin
         inherited create(op);

compiler/wasm/agwat.pas

@@ -235,17 +235,39 @@ implementation
     var
       cpu : taicpu;
       i   : integer;
+      isprm : boolean;
     begin
       //writer.AsmWriteLn('instr');
       cpu := taicpu(hp);
       writer.AsmWrite(#9);
       writer.AsmWrite(wasm_op2str[cpu.opcode] );
 
+      if (cpu.opcode = a_call_indirect) then begin
+        // special wat2wasm syntax "call_indirect (type x)"
+        writer.AsmWrite(#9);
+        isprm := true;
+        for i:=1 to length(cpu.typecode) do
+          if cpu.typecode[i]=':' then
+             isprm:=false
+          else begin
+            if isprm then writer.AsmWrite('(param ')
+            else writer.AsmWrite('(result ');
+            case cpu.typecode[i] of
+              'i': writer.AsmWrite('i32');
+              'I': writer.AsmWrite('i64');
+              'f': writer.AsmWrite('f32');
+              'F': writer.AsmWrite('f64');
+            end;
+            writer.AsmWrite(')');
+          end;
+        writer.AsmLn;
+        exit;
+      end;
+
+
       if (cpu.opcode = a_if)  then
         writer.AsmWrite(' (result i32)') //todo: this is a hardcode, but shouldn't
-      else if (cpu.opcode = a_call_indirect) then
-        // special wat2wasm syntax "call_indirect (type x)"
-        writer.AsmWrite(' (type ');
+      else
 
       cpu := taicpu(hp);
       if cpu.ops<>0 then

compiler/wasm/hlcgcpu.pas

@@ -387,8 +387,9 @@ implementation
 
   function thlcgwasm.a_call_reg(list: TAsmList; pd: tabstractprocdef; reg: tregister; const paras: array of pcgpara): tcgpara;
     begin
-      internalerror(2012042824);
-      result.init;
+      a_load_reg_stack(list, ptrsinttype, reg);
+      current_asmdata.CurrAsmList.Concat(taicpu.op_callindirect( WasmGetTypeCode(pd)) );
+      result:=hlcg.get_call_result_cgpara(pd, nil);
     end;
 
 
@@ -1576,14 +1577,6 @@ implementation
                 handled:=true;
               end;
           end;
-        procvardef:
-          begin
-            if not tprocvardef(size).is_addressonly then
-              begin
-                concatcopy_record(list,tcpuprocvardef(size).classdef,source,dest);
-                handled:=true;
-              end;
-          end;
         else
           ;
       end;
@@ -2448,8 +2441,6 @@ implementation
           else
             checkdef:=java_jubitset;
         end
-      else if checkdef.typ=procvardef then
-        checkdef:=tcpuprocvardef(checkdef).classdef
       else if is_wide_or_unicode_string(checkdef) then
         checkdef:=java_jlstring
       else if is_ansistring(checkdef) then

compiler/wasm/nwasmcal.pas

@@ -28,7 +28,7 @@ interface
     uses
       cgbase,
       symtype,symdef,cgutils,parabase,
-      node,ncal,ncgcal,hlcgobj,aasmcpu,cpubase;
+      node,ncal,ncgcal,hlcgobj,aasmcpu,cpubase, wasmdef;
 
     type
        { twasmcallparanode }
@@ -39,11 +39,6 @@ interface
        { twasmcallnode }
 
        twasmcallnode = class(tcgcallnode)
-       protected
-         function can_call_ref(var ref: treference):boolean;override;
-         //procedure extra_call_ref_code(var ref: treference);virtual;
-         function do_call_ref(ref: treference): tcgpara; override;
-
          procedure set_result_location(realresdef: tstoreddef); override;
        end;
 
@@ -55,19 +50,6 @@ implementation
 
       { twasmcallnode }
 
-    function twasmcallnode.can_call_ref(var ref: treference): boolean;
-      begin
-        result:=true;
-      end;
-
-    function twasmcallnode.do_call_ref(ref: treference): tcgpara;
-      begin
-        thlcgwasm(hlcg).a_load_ref_stack(current_asmdata.CurrAsmList, s32inttype, ref, 0);
-        // todo: determine the proper function type
-        current_asmdata.CurrAsmList.Concat( taicpu.op_const(a_call_indirect, 0));
-        result:=hlcg.get_call_result_cgpara(procdefinition,typedef)
-      end;
-
     procedure twasmcallnode.set_result_location(realresdef: tstoreddef);
       begin
         // default implementation is placing the return value on LOC_REGISTER.

compiler/wasm/symcpu.pas

@@ -89,25 +89,18 @@ type
   end;
   tcpufloatdefclass = class of tcpufloatdef;
 
+  { tcpuprocvardef }
+
   tcpuprocvardef = class(tprocvardef)
-   protected
-    procedure ppuwrite_platform(ppufile: tcompilerppufile); override;
-    procedure ppuload_platform(ppufile: tcompilerppufile); override;
-   public
-    { class representing this procvar on the Java side }
-    classdef  : tobjectdef;
-    classdefderef : tderef;
-    procedure buildderef;override;
-    procedure deref;override;
-    function getcopy: tstoreddef; override;
   end;
   tcpuprocvardefclass = class of tcpuprocvardef;
 
+  { tcpuprocdef }
+
   tcpuprocdef = class(tprocdef)
     { generated assembler code; used by WebAssembly backend so it can afterwards
       easily write out all methods grouped per class }
-    exprasmlist      : TAsmList;
-    function getfuncretsyminfo(out ressym: tsym; out resdef: tdef): boolean; override;
+    exprasmlist  : TAsmList;
     destructor destroy; override;
   end;
   tcpuprocdefclass = class of tcpuprocdef;
@@ -151,8 +144,9 @@ type
   end;
   tcpunamespacesymclass = class of tcpunamespacesym;
 
+  { tcpuprocsym }
+
   tcpuprocsym = class(tprocsym)
-    procedure check_forward; override;
   end;
   tcpuprocsymclass = class of tcpuprocsym;
 
@@ -216,8 +210,10 @@ implementation
   uses
     verbose,cutils,cclasses,globals,
     symconst,symbase,symtable,symcreat,wasmdef,
-    pdecsub,pparautl,{pjvm,}
-    paramgr;
+    pdecsub,pparautl,paramgr,
+    // high-level code generator is needed to get access to type index for ncall
+    hlcgobj,hlcgcpu
+    ;
 
 
   {****************************************************************************
@@ -629,15 +625,6 @@ implementation
                              tcpuprocdef
 ****************************************************************************}
 
-  function tcpuprocdef.getfuncretsyminfo(out ressym: tsym; out resdef: tdef): boolean;
-    begin
-      { constructors don't have a result on the JVM platform }
-      if proctypeoption<>potype_constructor then
-        result:=inherited
-      else
-        result:=false;
-    end;
-
 
   destructor tcpuprocdef.destroy;
     begin
@@ -649,75 +636,12 @@ implementation
                              tcpuprocvardef
 ****************************************************************************}
 
-  procedure tcpuprocvardef.ppuwrite_platform(ppufile: tcompilerppufile);
-    begin
-      inherited;
-      ppufile.putderef(classdefderef);
-    end;
-
-
-  procedure tcpuprocvardef.ppuload_platform(ppufile: tcompilerppufile);
-    begin
-      inherited;
-      ppufile.getderef(classdefderef);
-    end;
-
-
-  procedure tcpuprocvardef.buildderef;
-    begin
-      inherited buildderef;
-      classdefderef.build(classdef);
-    end;
-
-
-  procedure tcpuprocvardef.deref;
-    begin
-      inherited deref;
-      classdef:=tobjectdef(classdefderef.resolve);
-    end;
-
-  function tcpuprocvardef.getcopy: tstoreddef;
-    begin
-      result:=inherited;
-      tcpuprocvardef(result).classdef:=classdef;
-    end;
 
 
 {****************************************************************************
                              tcpuprocsym
 ****************************************************************************}
 
-  procedure tcpuprocsym.check_forward;
-    var
-      curri, checki: longint;
-      currpd, checkpd: tprocdef;
-    begin
-      inherited;
-      { check for conflicts based on mangled name, because several FPC
-        types/constructs map to the same JVM mangled name }
-      for curri:=0 to FProcdefList.Count-2 do
-        begin
-          currpd:=tprocdef(FProcdefList[curri]);
-          if (po_external in currpd.procoptions) or
-             (currpd.proccalloption=pocall_internproc) then
-            continue;
-          for checki:=curri+1 to FProcdefList.Count-1 do
-            begin
-              checkpd:=tprocdef(FProcdefList[checki]);
-              if po_external in checkpd.procoptions then
-                continue;
-              if currpd.mangledname=checkpd.mangledname then
-                begin
-                  MessagePos(checkpd.fileinfo,parser_e_overloaded_have_same_mangled_name);
-                  MessagePos1(currpd.fileinfo,sym_e_param_list,currpd.customprocname([pno_mangledname]));
-                  MessagePos1(checkpd.fileinfo,sym_e_param_list,checkpd.customprocname([pno_mangledname]));
-                end;
-            end;
-        end;
-      inherited;
-    end;
-
-
 {****************************************************************************
                              tcpustaticvarsym
 ****************************************************************************}