[PATCH 049/188] updating binary writing

From 0a58746d18ee0f4c1405114adade9464b211132a Mon Sep 17 00:00:00 2001
From: Dmitry Boyarintsev <skalogryz.lists@gmail.com>
Date: Thu, 21 Nov 2019 23:24:04 -0500

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

utils/wasmbin/wasmbinwriter.pas

@@ -5,7 +5,7 @@ unit wasmbinwriter;
 interface
 
 uses
-  Classes, SysUtils, wasmmodule, wasmbin, lebutils;
+  Classes, SysUtils, wasmmodule, wasmbin, lebutils, wasmbincode;
 
 type
   TSectionRec = record
@@ -26,6 +26,8 @@ type
     procedure SectionBegin(secId: byte; out secRec: TSectionRec; secsize: longWord=0);
     function SectionEnd(var secRec: TSectionRec): Boolean;
 
+    procedure WriteInstList(list: TWasmInstrList);
+
     procedure WriteFuncTypeSect(m: TWasmModule);
     procedure WriteFuncSect(m: TWasmModule);
     procedure WriteExportSect(m: TWasmModule);
@@ -42,8 +44,56 @@ type
 
 function WriteModule(m: TWasmModule; dst: TStream): Boolean;
 
+type
+  TLocalsInfo = record
+    count : Integer;
+    tp    : byte;
+  end;
+  TLocalInfoArray = array of TLocalsInfo;
+
+// returns the list of local arrays
+procedure GetLocalInfo(func: TWasmFunc; out loc: TLocalInfoArray);
+
 implementation
 
+procedure GetLocalInfo(func: TWasmFunc; out loc: TLocalInfoArray);
+var
+  i   : integer;
+  cnt : integer;
+  tp  : byte;
+  nt  : byte;
+  j   : integer;
+
+  procedure Push;
+  begin
+    if j=length(loc) then begin
+      if j=0 then SetLength(loc, 1)
+      else SetLength(loc, j*2);
+    end;
+    loc[j].tp:=tp;
+    loc[j].count:=cnt;
+    inc(j);
+  end;
+
+begin
+  SetLength(Loc, 0);
+  if func.LocalsCount = 0 then Exit;
+  cnt:=1;
+  tp:=func.GetLocal(0).tp;
+  j:=0;
+  for i:=1 to func.LocalsCount-1 do begin
+    nt := func.GetLocal(i).tp;
+    if nt<>tp then begin
+      Push;
+      tp:=nt;
+      cnt:=1;
+    end else
+      inc(cnt);
+  end;
+  Push;
+  SetLength(loc, j);
+end;
+
 function WriteModule(m: TWasmModule; dst: TStream): Boolean;
 var
   bw : TBinWriter;
@@ -145,8 +195,6 @@ procedure TBinWriter.WriteFuncSect(m: TWasmModule);
 var
   sc : TSectionRec;
   i  : integer;
-  //j  : integer;
-  //tp : TWasmFuncType;
 begin
   SectionBegin(SECT_FUNCTION, sc);
 
@@ -182,18 +230,31 @@ end;
 procedure TBinWriter.WriteCodeSect(m: TWasmModule);
 var
   sc    : TSectionRec;
-  i     : integer;
+  i, j  : integer;
   sz    : int64;
   mem   : TMemoryStream;
+  la    : TLocalInfoArray;
+  f     : TWasmFunc;
 begin
   SectionBegin(SECT_CODE, sc);
 
   mem:=TMemoryStream.Create;
   try
+    WriteU32(dst, m.FuncCount);
     for i :=0 to m.FuncCount-1 do begin
+      f:=m.GetFunc(i);
+
+      GetLocalInfo(f, la);
+
+      mem.Position:=0;
       pushStream(mem);
-      // todo: locals
+
-      // todo: instructions
+      WriteU32(dst, length(la));
+      for j:=0 to length(la)-1 do begin
+        WriteU32(dst, la[i].count);
+        dst.WriteByte(la[i].tp);
+      end;
+      WriteInstList(f.instr);
       popStream;
 
       sz:=mem.Position;
@@ -208,6 +269,21 @@ begin
   SectionEnd(sc);
 end;
 
+procedure TBinWriter.WriteInstList(list: TWasmInstrList);
+var
+  i  : integer;
+  ci : TWasmInstr;
+begin
+  for i:=0 to list.Count-1 do begin
+    ci :=list[i];
+    dst.WriteByte(ci.code);
+    case INST_FLAGS[ci.code].Param of
+      ipLeb:
+        WriteRelocU32(ci.operandNum);
+    end;
+  end;
+end;
+
 procedure TBinWriter.pushStream(st: TStream);
 begin
   if st=nil then Exit;

utils/wasmbin/wasmmodule.pas

@@ -3,7 +3,7 @@ unit wasmmodule;
 interface
 
 uses
-  Classes, SysUtils, wasmbin;
+  Classes, SysUtils, wasmbin, wasmbincode;
 
 type
 
@@ -52,6 +52,7 @@ type
     operandText : string;
     insttype : TWasmFuncType; // used by call_indirect only
     function addInstType: TWasmFuncType;
+    constructor Create;
     destructor Destroy; override;
   end;
 
@@ -81,6 +82,7 @@ type
     constructor Create;
     destructor Destroy; override;
     function AddLocal: TWasmParam;
+    function GetLocal(i: integer): TWasmParam;
     function LocalsCount: integer;
   end;
 
@@ -121,12 +123,16 @@ type
 // making binary friendly. finding proper "nums" for each symbol "index"
 // used or implicit type declartions
 procedure Normalize(m: TWasmModule);
-//function RegisterFuncType(m: TWasmModule; funcType: TFuncType): integer;
 function WasmBasTypeToChar(b: byte): Char;
 function WasmFuncTypeDescr(t: TWasmFuncType): string;
 
 implementation
 
+// returing a basic wasm basic type to a character
+// i32 = i
+// i64 = I
+// f32 = f
+// f64 = F
 function WasmBasTypeToChar(b: byte): Char;
 begin
   case b of
@@ -139,6 +145,11 @@ begin
   end;
 end;
 
+// converting function type to the type string
+// result and params are separated by ":"
+// iI:i  (param i32)(param i32) (result i32)
+// :f    (result f32)
+// FF    (param f64)(param(64)
 function WasmFuncTypeDescr(t: TWasmFuncType): string;
 var
   cnt   : integer;
@@ -166,7 +177,7 @@ begin
   end;
 end;
 
-
+// deleting objects from the list and clearing the list
 procedure ClearList(l: TList);
 var
   i : integer;
@@ -199,6 +210,11 @@ begin
   result:=insttype;
 end;
 
+constructor TWasmInstr.Create;
+begin
+  operandNum:=-1;
+end;
+
 destructor TWasmInstr.Destroy;
 begin
   insttype.Free;
@@ -432,12 +448,21 @@ begin
   locals.AdD(Result);
 end;
 
+function TWasmFunc.GetLocal(i: integer): TWasmParam;
+begin
+  if (i>=0) and (i<locals.Count) then
+    Result:=TWasmParam(locals[i])
+  else
+    Result:=nil;
+end;
+
 function TWasmFunc.LocalsCount: integer;
 begin
   result:=locals.Count;
 end;
 
-
+// registering new or finding the existing type for a function type
+// it's assumed the function type is explicitly types
 function RegisterFuncType(m: TWasmModule; funcType: TWasmFuncType): integer;
 var
   i   : integer;
@@ -456,6 +481,24 @@ begin
   funcType.CopyTo(m.AddType);
 end;
 
+// searching through TWasmParam list for the specified index-by-name
+function FindParam(l: TList; const idx: string): Integer;
+var
+  i : integer;
+begin
+  if not Assigned(l) then begin
+    Result:=-1;
+    Exit;
+  end;
+  for i:=0 to l.Count-1 do
+    if TWasmParam(l[i]).id=idx then begin
+      Result:=i;
+      Exit;
+    end;
+  Result:=i;
+end;
+
+// finding functions by funcIdx
 function FindFunc(m: TWasmModule; const funcIdx: string): integer;
 var
   i : integer;
@@ -468,6 +511,7 @@ begin
     end;
 end;
 
+// only looking up for the by the type index name
 function FindFuncType(m: TWasmModule; const typeIdx: string): integer;
 var
   i : integer;
@@ -480,6 +524,38 @@ begin
     end;
 end;
 
+// Normalizing instruction list, popuplating index reference ($index)
+// with the actual numbers. (params, locals, globals, memory, functions index)
+procedure NormalizeInst(m: TWasmModule; f: TWasmFunc; l: TWasmInstrList; checkEnd: boolean = true);
+var
+  i   : integer;
+  j   : integer;
+  ci  : TWasmInstr;
+begin
+  for i:=0 to l.Count-1 do begin
+    ci:=l[i];
+    if ci.operandNum>=0 then Continue;
+    case ci.code of
+      INST_local_get, INST_local_set, INST_local_tee:
+      begin
+        if ci.operandIdx<>'' then begin
+          j:=FindParam(f.functype.params, ci.operandIdx);
+          if j<0 then begin
+            j:=FindParam(f.locals, ci.operandIdx);
+            if j>=0 then inc(j, f.functype.ParamCount);
+          end;
+          ci.operandNum:=j;
+        end;
+      end;
+    end;
+  end;
+
+  // adding end instruction
+  if checkEnd and (l.Count>0) and (l[l.Count-1].code<>INST_END) then
+    l.AddInstr(INST_END);
+end;
+
+// normalizing reference
 procedure Normalize(m: TWasmModule);
 var
   i : integer;
@@ -492,7 +568,11 @@ begin
       if f.functype.typeIdx<>'' then
         f.functype.typeNum:=FindFuncType(m, f.functype.typeIdx);
     end else
-      f.functype.typeNum:=RegisterFuncType(m, f.functype)
+      f.functype.typeNum:=RegisterFuncType(m, f.functype);
+
+    // finding the reference in functions
+    // populating "nums" where string "index" is used
+    NormalizeInst(m, f, f.instr);
   end;
 
   // normalizing exports