diff --git a/.gitattributes b/.gitattributes index 6eaae9e90f..b20c1c39a7 100644 --- a/.gitattributes +++ b/.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 diff --git a/utils/wasmbin/wasmbin.pas b/utils/wasmbin/wasmbin.pas index b002afda98..dcf0093fb7 100644 --- a/utils/wasmbin/wasmbin.pas +++ b/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 diff --git a/utils/wasmbin/wasmbinwriter.pas b/utils/wasmbin/wasmbinwriter.pas new file mode 100644 index 0000000000..1f417532da --- /dev/null +++ b/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. + diff --git a/utils/wasmbin/wasmld.lpi b/utils/wasmbin/wasmld.lpi index 92de4fc850..9f0bfaeaaa 100644 --- a/utils/wasmbin/wasmld.lpi +++ b/utils/wasmbin/wasmld.lpi @@ -1,16 +1,16 @@ - + - + <UseAppBundle Value="False"/> <ResourceType Value="res"/> diff --git a/utils/wasmbin/wasmmodule.pas b/utils/wasmbin/wasmmodule.pas index 860a7b593f..e5c1580547 100644 --- a/utils/wasmbin/wasmmodule.pas +++ b/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. diff --git a/utils/wasmbin/watparser.pas b/utils/wasmbin/watparser.pas index adcb8e2148..6ae5314846 100644 --- a/utils/wasmbin/watparser.pas +++ b/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); diff --git a/utils/wasmbin/watscanner.pas b/utils/wasmbin/watscanner.pas index c40358f6b1..4da2567932 100644 --- a/utils/wasmbin/watscanner.pas +++ b/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. diff --git a/utils/wasmbin/wattest.lpr b/utils/wasmbin/wattest.lpr index 224350d0d9..67d368546c 100644 --- a/utils/wasmbin/wattest.lpr +++ b/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.