[PATCH 048/188] update writing binaries

From 8d0e9392be1cf2d2eaa226a9d8ce61baec09a384 Mon Sep 17 00:00:00 2001
From: Dmitry Boyarintsev <skalogryz.lists@gmail.com>
Date: Thu, 21 Nov 2019 13:58:27 -0500

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

.gitattributes

@@ -18981,6 +18981,7 @@ utils/wasmbin/parseutils.pas svneol=native#text/plain
 utils/wasmbin/wasmbin.pas svneol=native#text/plain
 utils/wasmbin/wasmbincode.pas svneol=native#text/plain
 utils/wasmbin/wasmbindebug.pas svneol=native#text/plain
+utils/wasmbin/wasmbinwriter.pas svneol=native#text/plain
 utils/wasmbin/wasmld.lpi svneol=native#text/plain
 utils/wasmbin/wasmld.lpr svneol=native#text/plain
 utils/wasmbin/wasmlink.pas svneol=native#text/plain

utils/wasmbin/wasmbin.pas

@@ -26,6 +26,9 @@ const
 const
   WasmId = #0'asm';
   WasmId_Int = $6D736100;
+  Wasm_Version1 = 1;
+var
+  WasmId_Buf  : array [0..3] of char = (#0, 'a','s','m');
 
 type
   TLimit = record

utils/wasmbin/wasmbinwriter.pas

@@ -0,0 +1,244 @@
+unit wasmbinwriter;
+
+{$mode objfpc}{$H+}
+
+interface
+
+uses
+  Classes, SysUtils, wasmmodule, wasmbin, lebutils;
+
+type
+  TSectionRec = record
+    secpos    : int64;
+    szpos     : int64;
+    datapos   : int64;
+    endofdata : int64;
+  end;
+
+  { TBinWriter }
+
+  TBinWriter = class
+  protected
+    dst  : TStream;
+    org  : TStream;
+    strm : TList;
+    procedure WriteRelocU32(u: longword);
+    procedure SectionBegin(secId: byte; out secRec: TSectionRec; secsize: longWord=0);
+    function SectionEnd(var secRec: TSectionRec): Boolean;
+
+    procedure WriteFuncTypeSect(m: TWasmModule);
+    procedure WriteFuncSect(m: TWasmModule);
+    procedure WriteExportSect(m: TWasmModule);
+    procedure WriteCodeSect(m: TWasmModule);
+
+    procedure pushStream(st: TStream);
+    function popStream: TStream;
+  public
+    isWriteReloc: boolean;
+    constructor Create;
+    destructor Destroy; override;
+    function Write(m: TWasmModule; adst: TStream): Boolean;
+  end;
+
+function WriteModule(m: TWasmModule; dst: TStream): Boolean;
+
+implementation
+
+function WriteModule(m: TWasmModule; dst: TStream): Boolean;
+var
+  bw : TBinWriter;
+begin
+  bw := TBinWriter.Create;
+  try
+    Normalize(m);
+    Result := bw.Write(m, dst);
+  finally
+    bw.Free;
+  end;
+end;
+
+{ TBinWriter }
+
+procedure TBinWriter.WriteRelocU32(u: longword);
+begin
+  WriteU(dst, u, sizeof(u), isWriteReloc);
+end;
+
+function TBinWriter.Write(m: TWasmModule; adst: TStream): Boolean;
+var
+  l : Longword;
+begin
+  if not Assigned(m) or not Assigned(adst) then begin
+    Result:=false;
+    Exit;
+  end;
+  dst:=adst;
+  org:=adst;
+
+  dst.Write(WasmId_Buf, length(WasmId_Buf));
+  l:=NtoLE(Wasm_Version1);
+  dst.Write(l, sizeof(l));
+
+  // 01 function type section
+  WriteFuncTypeSect(m);
+
+  // 03 function section
+  WriteFuncSect(m);
+
+  // 07 export section
+  WriteExportSect(m);
+
+  // 10 code section
+  WriteCodeSect(m);
+
+  Result:=true;
+end;
+
+procedure TBinWriter.SectionBegin(secId: byte; out secRec: TSectionRec; secsize: longWord=0);
+begin
+  secRec.secpos:=dst.Position;
+  dst.WriteByte(secId);
+  secRec.szpos:=dst.Position;
+  WriteRelocU32(secsize);
+  secRec.datapos:=dst.Position;
+  secRec.endofdata:=dst.Position+secsize;
+end;
+
+function TBinWriter.SectionEnd(var secRec: TSectionRec): Boolean;
+var
+  sz: LongWord;
+begin
+  secRec.endofdata:=dst.Position;
+  dst.Position:=secRec.szpos;
+  sz := secRec.endofdata - secRec.datapos;
+  WriteRelocU32(sz);
+  dst.Position:=secRec.endofdata;
+  Result := true;
+end;
+
+procedure TBinWriter.WriteFuncTypeSect(m: TWasmModule);
+var
+  sc : TSectionRec;
+  i  : integer;
+  j  : integer;
+  tp : TWasmFuncType;
+begin
+  SectionBegin(SECT_TYPE, sc);
+
+  WriteRelocU32(m.TypesCount);
+  for i:=0 to m.TypesCount-1 do begin
+    tp:=m.GetType(i);
+    dst.WriteByte(func_type);
+
+    WriteRelocU32(tp.ParamCount);
+    for j:=0 to tp.ParamCount-1 do
+      dst.WriteByte(tp.GetParam(i).tp);
+
+    WriteRelocU32(tp.ResultCount);
+    for j:=0 to tp.ResultCount-1 do
+      dst.WriteByte(tp.GetResult(i).tp);
+  end;
+  SectionEnd(sc);
+end;
+
+procedure TBinWriter.WriteFuncSect(m: TWasmModule);
+var
+  sc : TSectionRec;
+  i  : integer;
+  //j  : integer;
+  //tp : TWasmFuncType;
+begin
+  SectionBegin(SECT_FUNCTION, sc);
+
+  WriteRelocU32(m.FuncCount);
+  for i:=0 to m.FuncCount-1 do
+    WriteRelocU32(m.GetFunc(i).functype.typeNum);
+
+  SectionEnd(sc);
+end;
+
+procedure TBinWriter.WriteExportSect(m: TWasmModule);
+var
+  sc : TSectionRec;
+  i  : integer;
+  x  : TWasmExport;
+begin
+  SectionBegin(SECT_EXPORT, sc);
+  WriteRelocU32(m.ExportCount);
+
+  for i:=0 to m.ExportCount-1 do begin
+    x:=m.GetExport(i);
+    WriteRelocU32(length(x.name));
+    if length(x.name)>0 then
+      dst.Write(x.name[1], length(x.name));
+    dst.WriteByte(x.exportType);
+    WriteRelocU32(x.exportNum);
+  end;
+
+  SectionEnd(sc);
+end;
+
+
+procedure TBinWriter.WriteCodeSect(m: TWasmModule);
+var
+  sc    : TSectionRec;
+  i     : integer;
+  sz    : int64;
+  mem   : TMemoryStream;
+begin
+  SectionBegin(SECT_CODE, sc);
+
+  mem:=TMemoryStream.Create;
+  try
+    for i :=0 to m.FuncCount-1 do begin
+      pushStream(mem);
+      // todo: locals
+      // todo: instructions
+      popStream;
+
+      sz:=mem.Position;
+      mem.Position:=0;
+
+      WriteRelocU32(sz);
+      dst.CopyFrom(mem, sz);
+    end;
+  finally
+    mem.Free;
+  end;
+  SectionEnd(sc);
+end;
+
+procedure TBinWriter.pushStream(st: TStream);
+begin
+  if st=nil then Exit;
+  strm.Add(st);
+  dst:=st;
+end;
+
+function TBinWriter.popStream: TStream;
+begin
+  if strm.Count=0 then
+    Result:=nil
+  else begin
+    Result:=TStream(strm[strm.Count-1]);
+    strm.Delete(strm.Count-1);
+  end;
+  if strm.Count=0 then dst:=org
+  else dst:=TStream(strm[strm.Count-1]);
+end;
+
+constructor TBinWriter.Create;
+begin
+  inherited Create;
+  strm:=TList.Create;
+end;
+
+destructor TBinWriter.Destroy;
+begin
+  strm.Free;
+  inherited Destroy;
+end;
+
+
+end.
+

utils/wasmbin/wasmld.lpi

@@ -1,16 +1,16 @@
 <?xml version="1.0" encoding="UTF-8"?>
 <CONFIG>
   <ProjectOptions>
-    <Version Value="12"/>
+    <Version Value="11"/>
     <PathDelim Value="\"/>
     <General>
       <Flags>
         <MainUnitHasCreateFormStatements Value="False"/>
         <MainUnitHasTitleStatement Value="False"/>
         <MainUnitHasScaledStatement Value="False"/>
-        <CompatibilityMode Value="True"/>
       </Flags>
       <SessionStorage Value="InProjectDir"/>
+      <MainUnit Value="0"/>
       <Title Value="wasmld"/>
       <UseAppBundle Value="False"/>
       <ResourceType Value="res"/>

utils/wasmbin/wasmmodule.pas

@@ -3,12 +3,16 @@ unit wasmmodule;
 interface
 
 uses
-  Classes, SysUtils;
+  Classes, SysUtils, wasmbin;
 
 type
+
+  { TWasmParam }
+
   TWasmParam = class(TObject)
     id : string;
     tp : byte;
+    procedure CopyTo(d: TWasmParam);
   end;
 
   { TWasmType }
@@ -34,7 +38,9 @@ type
     function ResultCount: Integer;
     function ParamCount: Integer;
 
-    function isExplicitRef: Boolean;
+    function isNumOrIdx: Boolean;
+
+    procedure CopyTo(t: TWasmFuncType);
   end;
 
   { TWasmInstr }
@@ -85,6 +91,7 @@ type
     exportType : byte;
     exportNum  : integer;
     exportIdx  : string;
+    constructor Create;
   end;
 
   { TWasmModule }
@@ -103,7 +110,7 @@ type
     function FuncCount: integer;
 
     function AddType: TWasmFuncType;
-    function GetTypes(i: integer): TWasmFuncType;
+    function GetType(i: integer): TWasmFuncType;
     function TypesCount: integer;
 
     function AddExport: TWasmExport;
@@ -111,8 +118,55 @@ type
     function ExportCount: integer;
   end;
 
+// 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
 
+function WasmBasTypeToChar(b: byte): Char;
+begin
+  case b of
+    valtype_i32: Result:='i';
+    valtype_i64: Result:='I';
+    valtype_f32: Result:='f';
+    valtype_f64: Result:='F';
+  else
+    Result:='.';
+  end;
+end;
+
+function WasmFuncTypeDescr(t: TWasmFuncType): string;
+var
+  cnt   : integer;
+  i : integer;
+  j : integer;
+begin
+  cnt:=t.ParamCount;
+  if t.Resultcount>0 then inc(cnt, t.ResultCount+1);
+  SetLength(Result, cnt);
+  if cnt=0 then Exit;
+
+  j:=1;
+  for i:=0 to t.ParamCount-1 do begin
+    Result[j]:=WasmBasTypeToChar(t.GetParam(i).tp);
+    inc(j);
+  end;
+
+  if t.ResultCount=0 then Exit;
+
+  Result[j]:=':';
+  inc(j);
+  for i:=0 to t.ResultCount-1 do begin
+    Result[j]:=WasmBasTypeToChar(t.GetResult(i).tp);
+    inc(j);
+  end;
+end;
+
+
 procedure ClearList(l: TList);
 var
   i : integer;
@@ -122,6 +176,21 @@ begin
   l.Clear;
 end;
 
+{ TWasmExport }
+
+constructor TWasmExport.Create;
+begin
+  inherited Create;
+  exportNum:=-1;
+end;
+
+{ TWasmParam }
+
+procedure TWasmParam.CopyTo(d: TWasmParam);
+begin
+  d.tp:=tp;
+end;
+
 { TWasmInstr }
 
 function TWasmInstr.addInstType: TWasmFuncType;
@@ -236,11 +305,30 @@ begin
   Result:=params.Count;
 end;
 
-function TWasmFuncType.isExplicitRef: Boolean;
+function TWasmFuncType.isNumOrIdx: Boolean;
 begin
   Result:=(typeIdx<>'') or (typeNum>=0);
 end;
 
+procedure TWasmFuncType.CopyTo(t: TWasmFuncType);
+var
+  i : integer;
+  s : TWasmParam;
+  d : TWasmParam;
+begin
+  for i:=0 to ParamCount-1 do begin
+    d := t.AddParam;
+    s := GetParam(i);
+    s.CopyTo(d);
+  end;
+
+  for i:=0 to ResultCount-1 do begin
+    d := t.AddResult;
+    s := GetResult(i);
+    s.CopyTo(d);
+  end;
+end;
+
 { TWasmModule }
 
 constructor TWasmModule.Create;
@@ -287,7 +375,7 @@ begin
   Result:=funcs.Count;
 end;
 
-function TWasmModule.GetTypes(i: integer): TWasmFuncType;
+function TWasmModule.GetType(i: integer): TWasmFuncType;
 begin
   if (i>=0) and (i<types.Count) then
     Result:=TWasmFuncType(types[i])
@@ -349,4 +437,74 @@ begin
   result:=locals.Count;
 end;
 
+
+function RegisterFuncType(m: TWasmModule; funcType: TWasmFuncType): integer;
+var
+  i   : integer;
+  trg : string;
+  d   : string;
+begin
+  trg := WasmFuncTypeDescr(funcType);
+  for i:=0 to m.TypesCount-1 do begin
+    d := WasmFuncTypeDescr(m.GetType(i));
+    if trg = d then begin
+      Result:= i;
+      Exit;
+    end;
+  end;
+  Result:=m.TypesCount;
+  funcType.CopyTo(m.AddType);
+end;
+
+function FindFunc(m: TWasmModule; const funcIdx: string): integer;
+var
+  i : integer;
+begin
+  Result:=-1;
+  for i:=0 to m.FuncCount-1 do
+    if m.GetFunc(i).id = funcIdx then begin
+      Result:=i;
+      Exit;
+    end;
+end;
+
+function FindFuncType(m: TWasmModule; const typeIdx: string): integer;
+var
+  i : integer;
+begin
+  Result:=-1;
+  for i:=0 to m.TypesCount-1 do
+    if m.GetType(i).typeIdx = typeIdx then begin
+      Result:=i;
+      Exit;
+    end;
+end;
+
+procedure Normalize(m: TWasmModule);
+var
+  i : integer;
+  f : TWasmFunc;
+  x : TWasmExport;
+begin
+  for i:=0 to m.FuncCount-1 do begin
+    f:=m.GetFunc(i);
+    if f.functype.isNumOrIdx then begin
+      if f.functype.typeIdx<>'' then
+        f.functype.typeNum:=FindFuncType(m, f.functype.typeIdx);
+    end else
+      f.functype.typeNum:=RegisterFuncType(m, f.functype)
+  end;
+
+  // normalizing exports
+  for i:=0 to m.ExportCount-1 do begin
+    x:=m.GetExport(i);
+    if x.exportNum<0 then
+      case x.exportType of
+        EXPDESC_FUNC:
+          if x.exportIdx<>'' then
+            x.exportNum := FindFunc(m, x.exportIdx);
+      end;
+  end;
+end;
+
 end.

utils/wasmbin/watparser.pas

@@ -269,7 +269,7 @@ begin
   if sc.token<>weString then
     ErrorExpectButFound(sc, 'string');
 
-  dst.name := sc.resText;
+  dst.name := sc.resWasmString;
   sc.Next;
 
   ConsumeAnyOpenToken(sc);

utils/wasmbin/watscanner.pas

@@ -42,6 +42,7 @@ type
     function Next: Boolean;
 
     function resInt32(const def: integer=-1): Integer;
+    function resWasmString: string;
   end;
 
 const
@@ -249,6 +250,38 @@ begin
   if err<>0 then Result:=def;
 end;
 
+function TWatScanner.resWasmString: string;
+var
+  i : integer;
+  j : integer;
+begin
+  if token<>weString then begin
+    Result:='';
+    Exit;
+  end;
+  Result:=Copy(resText, 2, length(resText)-2);
+  if Result='' then Exit;
+
+  i:=1;
+  j:=1;
+  while i<=length(Result) do begin
+    if Result[i]='\' then begin
+      inc(i);
+      if i<=length(Result) then
+        case Result[i] of
+          'r': Result[j]:=#13;
+          'n': Result[j]:=#10;
+          '\': Result[j]:='\';
+          '"': Result[j]:='"';
+        end;
+    end else
+      if (j<i) then Result[j]:=Result[i];
+    inc(j);
+    inc(i);
+  end;
+  SetLength(Result, j-1);
+end;
+
 
 
 end.

utils/wasmbin/wattest.lpr

@@ -3,7 +3,7 @@ program wattest;
 {$mode objfpc}{$H+}
 
 uses
-  SysUtils, Classes, watparser, watscanner, wasmmodule;
+  SysUtils, Classes, watparser, watscanner, wasmmodule, wasmbinwriter;
 
 procedure Traverse(p: TWatScanner);
 begin
@@ -19,6 +19,18 @@ begin
   end;
 end;
 
+procedure WriteBin(const fndst: string; m: TWasmModule);
+var
+  f : TFileStream;
+begin
+  f := TFileStream.Create(fndst, fmCreate);
+  try
+    WriteModule(m, f);
+  finally
+    f.Free;
+  end;
+end;
+
 procedure Run(const fn: string);
 var
   st : TFileStream;
@@ -35,9 +47,14 @@ begin
     p.SetSource(s);
     //Traverse(p);
     m := TWasmModule.Create;
-    if not ParseModule(p, m, err) then
-      writeln('Error: ', err);
-
+    try
+      if not ParseModule(p, m, err) then
+        writeln('Error: ', err)
+      else
+        WriteBin( ChangeFileExt(fn,'.wasm'), m);
+    finally
+      m.Free;
+    end;
   finally
     p.Free;
     st.Free;
@@ -56,6 +73,11 @@ begin
     writeln('file doesn''t exist: ', fn);
     exit;
   end;
-  Run(fn);
+  try
+    Run(fn);
+  except
+    on e: exception do
+      writeln(e.message);
+  end;
 end.