[PATCH 70/83] the initial support for the call_indirect

From 727fdc099a22472438475fc0e3076cbd619d9e42 Mon Sep 17 00:00:00 2001
From: Dmitry Boyarintsev <[email protected]>
Date: Tue, 22 Oct 2019 14:35:13 -0400

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

compiler/wasm/agwat.pas

@@ -242,7 +242,10 @@ implementation
       writer.AsmWrite(wasm_op2str[cpu.opcode] );
 
       if (cpu.opcode = a_if)  then
-        writer.AsmWrite(' (result i32)'); //todo: this is a hardcode, but shouldn't
+        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 ');
 
       cpu := taicpu(hp);
       if cpu.ops<>0 then
@@ -259,6 +262,10 @@ implementation
             end;
         end;
 
+      if (cpu.opcode = a_call_indirect) then
+        // special wat2wasm syntax "call_indirect (type x)"
+        writer.AsmWrite(')');
+
       writer.AsmLn;
     end;
 

compiler/wasm/hlcgcpu.pas

@@ -31,7 +31,7 @@ uses
   aasmbase,aasmdata,
   symbase,symconst,symtype,symdef,symsym,
   node,
-  cpubase, hlcgobj, cgbase, cgutils, parabase;
+  cpubase, hlcgobj, cgbase, cgutils, parabase, wasmdef;
 
   type
 
@@ -46,8 +46,10 @@ uses
       loopContBr: integer; // the value is different depending of the condition test
                            // if it's in the beggning the jump should be done to the loop (1)
                            // if the condition at the end, the jump should done to the end of block (0)
+      fntypelookup : TWasmProcTypeLookup;
 
       constructor create;
+      destructor Destroy; override;
 
       procedure incblock;
       procedure decblock;
@@ -251,7 +253,7 @@ implementation
     verbose,cutils,globals,fmodule,constexp,
     defutil,
     aasmtai,aasmcpu,
-    symtable,symcpu, wasmdef,
+    symtable,symcpu,
     procinfo,cpuinfo,cgcpu,tgobj;
 
   const
@@ -300,6 +302,13 @@ implementation
     begin
       fevalstackheight:=0;
       fmaxevalstackheight:=0;
+      fntypelookup:=TWasmProcTypeLookup.Create;
+    end;
+
+  destructor thlcgwasm.Destroy;
+    begin
+      fntypelookup.Free;
+      inherited Destroy;
     end;
 
   procedure thlcgwasm.incblock;

compiler/wasm/nwasmcal.pas

@@ -27,8 +27,8 @@ interface
 
     uses
       cgbase,
-      symtype,symdef,
-      node,ncal,ncgcal;
+      symtype,symdef,cgutils,parabase,
+      node,ncal,ncgcal,hlcgobj,aasmcpu,cpubase;
 
     type
        { twasmcallparanode }
@@ -39,6 +39,11 @@ 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;
 
@@ -46,10 +51,23 @@ interface
 implementation
 
     uses
-      globtype, aasmdata, defutil, cgutils, tgobj;
+      globtype, aasmdata, defutil, tgobj, hlcgcpu;
 
       { 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/wasmdef.pas

@@ -5,8 +5,36 @@ unit wasmdef;
 interface
 
 uses
-  symtype, symdef, symconst, constexp
-  ,defutil;
+  symtype, symsym, symdef, symconst, constexp
+  ,defutil, procdefutil, cclasses;
+
+type
+
+    { TWasmTypeEntry }
+
+    TWasmTypeEntry = class(Tobject)
+      name : string; // always empty
+      idx  : integer;
+      constructor Create(aidx: integer; aname: string);
+    end;
+
+    { TWasmProcTypeLookup }
+
+    TWasmProcTypeLookup = class(TObject)
+      list: TFPHashObjectList;
+      idx: integer;
+      constructor Create(astartIndex: integer = 0);
+      destructor Destroy; override;
+      function GetTypeIndex(const typecode: string): Integer;
+    end;
+
+
+    // encodes procedure definition to a code used for the proc type lookup
+    // it's case-sensitive!!!
+    // i = i32, I = i64, f = f32, F = f32
+    function WasmGetTypeCodeForDef(def: tdef; var ch: char): Boolean;
+
+    function WasmGetTypeCode(aprocdef: tabstractprocdef): string;
 
     { returns whether a def always resides in memory,
       rather than in wasm local variables...) }
@@ -48,4 +76,80 @@ implementation
       end;
     end;
 
+  function WasmGetTypeCodeForDef(def: tdef; var ch: char): Boolean;
+  begin
+    Result := assigned(def);
+    if not Result then Exit;
+
+    case def.typ of
+      floatdef:
+        if def.size = 4 then ch :='f'
+        else ch :='F';
+      orddef:
+        if def.size = 8 then ch :='I'
+        else ch := 'i';
+      // todo: set can be bigger
+    else
+      ch:='i'; // by address
+    end;
+  end;
+
+  function WasmGetTypeCode(aprocdef: tabstractprocdef): string;
+    var
+      ch : char;
+      i  : integer;
+    begin
+      Result := '';
+      if not Assigned(aprocdef) then exit;
+
+      for i:=0 to aprocdef.paras.Count-1 do begin
+        WasmGetTypeCodeForDef( tparavarsym(aprocdef.paras[i]).paraloc[callerside].Def, ch);
+        result:=result+ch;
+      end;
+
+      if assigned(aprocdef) then begin
+        result:=result+':';
+        WasmGetTypeCodeForDef(aprocdef.returndef, ch);
+        result:=result+ch;
+      end;
+
+    end;
+
+    { TWasmTypeEntry }
+
+     constructor TWasmTypeEntry.Create(aidx: integer; aname: string);
+      begin
+        idx := aidx;
+        name := aname;
+      end;
+
+  { TWasmProcTypeLookup }
+
+    constructor TWasmProcTypeLookup.Create(astartIndex: integer = 0);
+      begin
+        inherited Create;
+        list := TFPHashObjectList.Create(true);
+        idx := astartIndex;
+      end;
+
+    destructor TWasmProcTypeLookup.Destroy;
+      begin
+        list.Free;
+        inherited Destroy;
+      end;
+
+    function TWasmProcTypeLookup.GetTypeIndex(const typecode: string): Integer;
+      var
+        en : TWasmTypeEntry;
+      begin
+        en := TWasmTypeEntry(list.Find(typecode));
+        if not Assigned(en) then begin
+          en := TWasmTypeEntry.Create(idx, ''); // no need to copy
+          inc(idx);
+          list.Add(typecode, en);
+        end;
+        Result := en.idx;
+      end;
+
+
 end.