mirror of
https://gitlab.com/freepascal.org/fpc/source.git
synced 2025-06-18 17:58:16 +02:00
1116 lines
26 KiB
ObjectPascal
1116 lines
26 KiB
ObjectPascal
{ This file is part of wasmbin - a collection of WebAssembly binary utils.
|
|
|
|
Copyright (C) 2019, 2020 Dmitry Boyarintsev <skalogryz.lists@gmail.com>
|
|
Copyright (C) 2020 by the Free Pascal development team
|
|
|
|
This source is free software; you can redistribute it and/or modify it under
|
|
the terms of the GNU General Public License as published by the Free
|
|
Software Foundation; either version 2 of the License, or (at your option)
|
|
any later version.
|
|
|
|
This code is distributed in the hope that it will be useful, but WITHOUT ANY
|
|
WARRANTY; without even the implied warranty of MERCHANTABILITY or FITNESS
|
|
FOR A PARTICULAR PURPOSE. See the GNU General Public License for more
|
|
details.
|
|
|
|
A copy of the GNU General Public License is available on the World Wide Web
|
|
at <http://www.gnu.org/copyleft/gpl.html>. You can also obtain it by writing
|
|
to the Free Software Foundation, Inc., 51 Franklin Street - Fifth Floor,
|
|
Boston, MA 02110-1335, USA.
|
|
}
|
|
|
|
unit watparser;
|
|
|
|
{$mode delphi}{$H+}
|
|
|
|
interface
|
|
|
|
uses
|
|
SysUtils, Classes, wasmtext, wasmmodule, watscanner, wasmbincode, wasmbin;
|
|
|
|
type
|
|
TParseResult = record
|
|
error : string;
|
|
line : integer;
|
|
pos : integer;
|
|
offset : integer;
|
|
end;
|
|
|
|
const
|
|
TokenStr : array[TWatToken] of string = (
|
|
'uknown', 'error',
|
|
'index',
|
|
'string', 'number', '(', ')',
|
|
'assembler symbol',
|
|
|
|
'instruction',
|
|
'func',
|
|
'param', 'result',
|
|
'module', 'mut', 'funcref',
|
|
'i32', 'i64',
|
|
'f32', 'f64',
|
|
'type',
|
|
'import', 'global', 'table', 'memory', 'local', 'export',
|
|
'elem', 'data', 'offset','align','='
|
|
);
|
|
|
|
WasmTypeTokens = [wei32, wei64, wef32, wef64];
|
|
|
|
//function ConsumeToken(sc: TWatScanner; tk: TWatToken): Boolean;
|
|
function ParseModule(sc: TWatScanner; dst: TWasmModule; var errMsg: string): Boolean; overload;
|
|
function ParseModule(sc: TWatScanner; dst: TWasmModule; out err: TParseResult): Boolean; overload;
|
|
|
|
// castType can be otNotused, if no explicit type cast is expected
|
|
function ParseOperand(sc: TWatScanner; var op: TWasmInstrOperand; castType: TWasmInstrOperandType): Boolean;
|
|
|
|
implementation
|
|
|
|
type
|
|
// used to stop the recursive parsing
|
|
|
|
{ EParserError }
|
|
|
|
EParserError = class(Exception)
|
|
offset : integer;
|
|
constructor Create(const amsg: string; aofs: integer);
|
|
end;
|
|
|
|
TAsmSym = record
|
|
name : string;
|
|
value : string;
|
|
end;
|
|
|
|
{ TAsmSymList }
|
|
|
|
TAsmSymList = class(TObject)
|
|
syms : array of TAsmSym;
|
|
count : integer;
|
|
procedure Push(const AName, AValue: string);
|
|
procedure Clear;
|
|
procedure ToLinkInfo(var AInfo: TLinkInfo);
|
|
end;
|
|
|
|
const
|
|
WAT_DEFTYPES='iN or fN';
|
|
|
|
procedure ParseError(sc: TWatScanner; const errMsg: string);
|
|
begin
|
|
raise EParserError.Create(errMsg, sc.ofs);
|
|
end;
|
|
|
|
procedure ErrorExpectButFound(sc: TWatScanner; const expected: string; const butfound: string =''); overload;
|
|
var
|
|
r : string;
|
|
begin
|
|
if butfound = '' then r := sc.resText
|
|
else r := butfound;
|
|
ParseError(sc, 'expected "'+expected+'", but "'+r+'" found');
|
|
end;
|
|
|
|
procedure ErrorUnexpectedEof(sc: TWatScanner);
|
|
begin
|
|
ParseError(sc, 'unexpected end of file');
|
|
end;
|
|
|
|
procedure ConsumeAnyOpenToken(sc: TWatScanner; out tk: TWatToken;
|
|
out hadOpenBrace: Boolean); overload;
|
|
begin
|
|
hadOpenBrace := sc.token = weOpenBrace;
|
|
if hadOpenBrace then sc.Next;
|
|
tk:=sc.token;
|
|
end;
|
|
|
|
procedure ConsumeAnyOpenToken(sc: TWatScanner); overload;
|
|
var
|
|
tk: TWatToken;
|
|
op: Boolean;
|
|
begin
|
|
ConsumeAnyOpenToken(sc, tk, op);
|
|
end;
|
|
|
|
procedure ConsumeAnyOpenToken(sc: TWatScanner; out tk: TWatToken); overload;
|
|
var
|
|
op: Boolean;
|
|
begin
|
|
ConsumeAnyOpenToken(sc, tk, op);
|
|
end;
|
|
|
|
|
|
function ConsumeOpenToken(sc: TWatScanner; tk: TWatToken): Boolean;
|
|
begin
|
|
sc.Next;
|
|
Result := (sc.token=weOpenBrace) or (sc.Token=tk);
|
|
if Result and (sc.token=weOpenBrace) then begin
|
|
sc.Next;
|
|
Result := (sc.Token=tk);
|
|
end;
|
|
end;
|
|
|
|
function ConsumeToken(sc: TWatScanner; tk: TWatToken): Boolean;
|
|
begin
|
|
Result:=sc.token =tk;
|
|
if not Result then
|
|
ErrorExpectButFound(sc,TokenStr[tk])
|
|
else
|
|
sc.Next;
|
|
end;
|
|
|
|
function ParseNumOfId(sc: TWatScanner; out num: integer; out id: string): Boolean;
|
|
begin
|
|
num:=-1;
|
|
id:='';
|
|
case sc.token of
|
|
weNumber: num:=sc.resInt32;
|
|
weIdent: id:=sc.resText;
|
|
else
|
|
ErrorExpectButFound(sc, 'index', TokenStr[sc.token]);
|
|
Result := false;
|
|
end;
|
|
Result := true;
|
|
if Result then sc.Next;
|
|
end;
|
|
|
|
function ParseId(sc: TWatScanner; var id: TWasmId): boolean;
|
|
begin
|
|
Result := ParseNumOfId(sc, id.idNum, id.id);
|
|
end;
|
|
|
|
function TokenTypeToValType(t: TWatToken; out tp: byte): Boolean;
|
|
begin
|
|
Result:=true;
|
|
case t of
|
|
wei32: tp:=valtype_i32;
|
|
wei64: tp:=valtype_i64;
|
|
wef32: tp:=valtype_f32;
|
|
wef64: tp:=valtype_f64;
|
|
else
|
|
tp:=0;
|
|
Result:=false;
|
|
end;
|
|
end;
|
|
|
|
procedure ParseParam(sc: TWatScanner; out id: string; out tp: byte; allowIdent: Boolean = true; consumeClose: Boolean = true);
|
|
begin
|
|
tp:=0;
|
|
id:='';
|
|
|
|
if allowIdent and (sc.token=weIdent) then begin
|
|
id:=sc.resText;
|
|
sc.Next;
|
|
end;
|
|
|
|
if not TokenTypeToValType(sc.token, tp) then
|
|
ErrorExpectButFound(sc, WAT_DEFTYPES, TokenStr[sc.token]);
|
|
|
|
sc.Next;
|
|
|
|
if consumeClose then
|
|
ConsumeToken(sc, weCloseBrace);
|
|
end;
|
|
|
|
procedure ParseNumOrIdx(sc: TWatScanner; out num: integer; out idx: string);
|
|
begin
|
|
if sc.token = weIdent then begin
|
|
idx := sc.resText;
|
|
num := -1;
|
|
end else if sc.token = weNumber then begin
|
|
idx := '';
|
|
num := sc.resInt32;
|
|
end else
|
|
ErrorExpectButFound(sc, 'number');
|
|
sc.Next;
|
|
end;
|
|
|
|
// lookForRefId (if true) parses for the case of (type 0)
|
|
// (if false) just looks for (param i32) (result i32)
|
|
procedure ParseTypeUse(sc: TWatScanner; dst: TWasmFuncType; lookForRefId: Boolean);
|
|
var
|
|
tk : TWatToken;
|
|
nm : integer;
|
|
id : string;
|
|
p : TWasmParam;
|
|
begin
|
|
tk := sc.token;
|
|
if lookForRefId and (tk = weType) then begin
|
|
sc.Next;
|
|
if not ParseNumOfId(sc, nm, id) then
|
|
Exit;
|
|
|
|
if nm>=0 then dst.typeNum:=nm
|
|
else dst.typeIdx:=id;
|
|
ConsumeAnyOpenToken(sc, tk);
|
|
end;
|
|
|
|
while tk = weParam do begin
|
|
p:=dst.AddParam;
|
|
sc.Next;
|
|
|
|
ParseParam(sc, p.id, p.tp, true, false);
|
|
|
|
// Text format specification:
|
|
// Abbreviations
|
|
// Multiple anonymous parameters or results may be combined into a single declaration
|
|
if (p.id = '') and (sc.token in [wei32, wei64, wef32, wef64]) then begin
|
|
while (sc.token in [wei32, wei64, wef32, wef64]) do begin
|
|
p:=dst.AddParam;
|
|
TokenTypeToValType(sc.token, p.tp);
|
|
sc.Next;
|
|
end;
|
|
end;
|
|
ConsumeToken(sc, weCloseBrace);
|
|
|
|
ConsumeAnyOpenToken(sc, tk);
|
|
end;
|
|
|
|
while tk = weResult do begin
|
|
p:=dst.AddResult;
|
|
sc.Next;
|
|
ParseParam(sc, p.id, p.tp, false);
|
|
ConsumeAnyOpenToken(sc, tk);
|
|
end;
|
|
end;
|
|
|
|
function IntToAlign(aint: Integer): integer;
|
|
begin
|
|
Result:=0;
|
|
aint := aint shr 1;
|
|
while aint>0 do begin
|
|
aint := aint shr 1;
|
|
inc(Result);
|
|
end;
|
|
end;
|
|
|
|
procedure ParseInstrList(sc: TWatScanner; dst: TWasmInstrList);
|
|
var
|
|
ci : TWasmInstr;
|
|
ft : TWasmFuncType;
|
|
const
|
|
ParamTypeToOpType : array [TInstParamType] of TWasmInstrOperandType = (
|
|
otNotused, // ipNone
|
|
otUInt32, // ipLeb, // label index or function index
|
|
otUInt32, // ipOfsAlign, // memory arguments, ask for offset + align
|
|
otSInt32, // ipi32, // signed Leb of maximum 4 bytes
|
|
otNotused, // ipi64, // signed Leb of maximum 8 bytes
|
|
otUInt32, // ipu32, // signed Leb of maximum 4 bytes
|
|
otNotused, // ipu64, // signed Leb of maximum 8 bytes
|
|
otFloat32, // ipf32, // float point single
|
|
otFloat64, // ipf64, // float point double
|
|
otNotused, // ipJumpVec, // an array of jump labels used for br_table only
|
|
otNotused, // ipResType, // result type used for blocks, such as If, block or loop
|
|
otNotused, // ipCallType, // used for call_indirect
|
|
otNotused, // ipi32OrFunc, // use for i32.const. Either a numeric OR function id is accepted.
|
|
otUInt32 // ipZero // followed by a single byte zero
|
|
);
|
|
begin
|
|
while sc.token=weInstr do begin
|
|
ci := dst.AddInstr(sc.instrCode);
|
|
sc.Next;
|
|
|
|
case INST_FLAGS[ci.code].Param of
|
|
ipNone:; // do nothing
|
|
|
|
ipLeb:
|
|
ParseNumOrIdx(sc, ci.operandNum, ci.operandIdx);
|
|
|
|
ipOfsAlign: begin
|
|
if sc.token = weOffset then begin
|
|
sc.Next;
|
|
ConsumeToken(sc, weEqual);
|
|
if sc.token<>weNumber then ErrorExpectButFound(sc, 'number');
|
|
//todo: fail on invalid value
|
|
OperandSetInt32(ci.operand1, sc.resInt32(0));
|
|
sc.Next;
|
|
end;
|
|
|
|
if sc.token = weAlign then begin
|
|
sc.Next;
|
|
ConsumeToken(sc, weEqual);
|
|
if sc.token<>weNumber then ErrorExpectButFound(sc, 'number');
|
|
OperandSetInt32(ci.operand2, IntToAlign(sc.resInt32(0)));
|
|
sc.Next;
|
|
end else
|
|
OperandSetInt32(ci.operand2, INST_FLAGS[ci.code].align);
|
|
end;
|
|
|
|
ipi32,ipi64,ipu32,ipu64,ipf32,ipf64,ipi32OrFunc:
|
|
begin
|
|
if (INST_FLAGS[ci.code].Param = ipi32OrFunc) and (sc.token = weIdent) then
|
|
OperandSetText(ci.operand1, sc.resText)
|
|
else if sc.token<>weNumber then begin
|
|
ErrorExpectButFound(sc, 'number');
|
|
Exit;
|
|
end else
|
|
ParseOperand(sc, ci.operand1, ParamTypeToOpType[INST_FLAGS[ci.code].Param]);
|
|
sc.Next;
|
|
end;
|
|
|
|
ipCallType:
|
|
begin
|
|
// call_indirect operator consists of 2 parameters
|
|
// 1 - type call
|
|
// 2 - table reference index. Which should always be zero.
|
|
ConsumeToken(sc, weOpenBrace);
|
|
ft := ci.addInstType;
|
|
ParseTypeUse(sc, ft, true);
|
|
ci.operandNum := 0; // table reference index
|
|
end;
|
|
|
|
//ip2Leb, // memory arguments, ask for offset + align
|
|
ipJumpVec:
|
|
begin
|
|
while (sc.token in [weNumber, weIdent]) do begin
|
|
if (ci.vecTableCount = length(ci.vecTable)) then begin
|
|
if (ci.vecTableCount = 0) then SetLength(ci.vecTable, 2)
|
|
else SetLength(ci.vecTable, ci.vecTableCount * 2);
|
|
end;
|
|
ParseId(sc, ci.vecTable[ci.vecTableCount]);
|
|
inc(ci.vecTableCount);
|
|
end;
|
|
|
|
if (ci.vecTableCount<2) then begin
|
|
ErrorExpectButFound(sc, 'label');
|
|
Exit;
|
|
end;
|
|
|
|
dec(ci.vecTableCount);
|
|
ci.operandIdx := ci.vecTable[ci.vecTableCount].id;
|
|
ci.operandNum := ci.vecTable[ci.vecTableCount].idNum;
|
|
end;
|
|
|
|
ipResType: // result type used for blocks, such as If, block or loop
|
|
begin
|
|
if sc.token = weIdent then begin
|
|
ci.jumplabel := sc.resText;
|
|
sc.Next;
|
|
end;
|
|
|
|
if (sc.token = weOpenBrace) then begin
|
|
ConsumeToken(sc, weOpenBrace);
|
|
ConsumeToken(sc, weResult);
|
|
case sc.token of
|
|
wei32: ci.operandNum := valtype_i32;
|
|
wei64: ci.operandNum := valtype_i64;
|
|
wef32: ci.operandNum := valtype_f32;
|
|
wef64: ci.operandNum := valtype_f64;
|
|
else
|
|
ErrorExpectButFound(sc, 'i32');
|
|
end;
|
|
sc.Next;
|
|
ConsumeToken(sc, weCloseBrace);
|
|
end else
|
|
ci.operandNum := block_type; // no value type
|
|
end;
|
|
|
|
end;
|
|
end;
|
|
|
|
end;
|
|
|
|
|
|
procedure ParseFunc(sc: TWatScanner; dst: TWasmFunc);
|
|
var
|
|
tk : TWatToken;
|
|
p : TWasmParam;
|
|
begin
|
|
if sc.token=weFunc then sc.Next;
|
|
|
|
if sc.token=weIdent then begin
|
|
dst.id:=sc.resText;
|
|
sc.Next;
|
|
end;
|
|
|
|
ConsumeAnyOpenToken(sc, tk);
|
|
|
|
if tk in [weType, weParam, weResult] then begin
|
|
ParseTypeUse(sc, dst.functype, true);
|
|
ConsumeAnyOpenToken(sc, tk);
|
|
end;
|
|
|
|
while tk = weLocal do begin
|
|
p:=dst.AddLocal;
|
|
sc.Next;
|
|
ParseParam(sc, p.id, p.tp, true, false);
|
|
if p.id = '' then begin
|
|
while sc.token in WasmTypeTokens do begin
|
|
p:=dst.AddLocal;
|
|
TokenTypeToValType(sc.token, p.tp);
|
|
sc.Next;
|
|
end;
|
|
end;
|
|
if sc.token=weCloseBrace then sc.Next;
|
|
|
|
ConsumeAnyOpenToken(sc, tk);
|
|
end;
|
|
|
|
if not (sc.token in [weInstr, weCloseBrace]) then
|
|
ErrorExpectButFound(sc, 'identifier');
|
|
|
|
ParseInstrList(sc, dst.instr);
|
|
ConsumeToken(sc, weCloseBrace);
|
|
end;
|
|
|
|
procedure ParseTypeDef(sc: TWatScanner; dst: TWasmFuncType);
|
|
begin
|
|
if sc.token=weType then sc.Next;
|
|
|
|
if (sc.token in [weNumber, weIdent]) then
|
|
ParseNumOfId(sc, dst.typeNum, dst.typeIdx);
|
|
|
|
ConsumeToken(sc, weOpenBrace);
|
|
ConsumeToken(sc, weFunc);
|
|
|
|
if (sc.token = weOpenBrace) then begin
|
|
sc.Next;
|
|
ParseTypeUse(sc, dst, false);
|
|
ConsumeToken(sc, weCloseBrace);
|
|
end;
|
|
|
|
ConsumeToken(sc, weCloseBrace);
|
|
end;
|
|
|
|
procedure ParseGlobal(sc: TWatScanner; dst: TWasmGlobal);
|
|
var
|
|
allowValue: Boolean;
|
|
begin
|
|
if sc.token = weGlobal then sc.Next;
|
|
|
|
allowValue := true;
|
|
// parsing id
|
|
if (sc.token in [weIdent, weNumber]) then ParseId(sc, dst.id);
|
|
|
|
// import or export
|
|
if (sc.token=weOpenBrace) then begin
|
|
sc.Next;
|
|
if sc.token=weImport then begin
|
|
// import
|
|
allowValue := false;
|
|
end else if sc.token=weExport then begin
|
|
// export
|
|
end;
|
|
end;
|
|
|
|
// parsing type. Global can be mutable type (mut i32)
|
|
|
|
if (sc.token=weOpenBrace) then sc.Next;
|
|
if sc.token = weMut then begin
|
|
dst.isMutable := true;
|
|
sc.Next;
|
|
end;
|
|
|
|
if (sc.token in WasmTypeTokens) then begin
|
|
TokenTypeToValType(sc.token, dst.tp);
|
|
sc.Next;
|
|
end else
|
|
ErrorExpectButFound(sc, 'type');
|
|
|
|
if dst.isMutable then ConsumeToken(sc, weCloseBrace);
|
|
|
|
if allowValue and (sc.token = weOpenBrace) then begin
|
|
sc.Next;
|
|
ParseInstrList(sc, dst.StartValue);
|
|
ConsumeToken(sc, weCloseBrace);
|
|
end;
|
|
ConsumeToken(sc, weCloseBrace);
|
|
end;
|
|
|
|
procedure ParseData(sc: TWatScanner; dst: TWasmData);
|
|
var
|
|
l : integer;
|
|
begin
|
|
if sc.token=weData then sc.Next;
|
|
|
|
//id (if not exists, should be zero)
|
|
if sc.token in [weIdent, weNumber] then
|
|
ParseId(sc, dst.id);
|
|
|
|
// offset (if not exist, should be zero)
|
|
if (sc.token = weOpenBrace) then begin
|
|
sc.Next;
|
|
ParseInstrList(sc, dst.StartOffset);
|
|
ConsumeToken(sc, weCloseBrace);
|
|
end;
|
|
|
|
// data (if not exist, then blank)
|
|
if sc.token = weString then begin
|
|
l := length(sc.resText);
|
|
SetLength(dst.databuf, l);
|
|
if l>0 then
|
|
Move(sc.resText[1], dst.databuf[0], l);
|
|
sc.Next;
|
|
end;
|
|
|
|
ConsumeToken(sc, weCloseBrace);
|
|
end;
|
|
|
|
procedure ParseMemory(sc: TWatScanner; dst: TWasmMemory);
|
|
begin
|
|
if sc.token=weMemory then sc.Next;
|
|
|
|
if sc.token in [weIdent] then
|
|
ParseId(sc, dst.id);
|
|
|
|
// todo: parsing of Import / Export
|
|
|
|
if sc.token in [weNumber] then begin
|
|
dst.min := sc.resInt32(0);
|
|
sc.Next;
|
|
end;
|
|
|
|
if sc.token in [weNumber] then begin
|
|
dst.max := sc.resInt32(0);
|
|
sc.Next;
|
|
end;
|
|
|
|
ConsumeToken(sc, weCloseBrace);
|
|
end;
|
|
|
|
procedure ParseExport(sc: TWatScanner; dst: TWasmExport);
|
|
begin
|
|
if sc.token=weExport then
|
|
sc.Next;
|
|
|
|
if sc.token<>weString then
|
|
ErrorExpectButFound(sc, 'string');
|
|
|
|
dst.name := sc.resWasmString;
|
|
sc.Next;
|
|
|
|
ConsumeAnyOpenToken(sc);
|
|
case sc.token of
|
|
weFunc: dst.exportType:=EXPDESC_FUNC;
|
|
weTable: dst.exportType:=EXPDESC_TABLE;
|
|
weMemory: dst.exportType:=EXPDESC_MEM;
|
|
weGlobal: dst.exportType:=EXPDESC_GLOBAL;
|
|
else
|
|
ErrorExpectButFound(sc, 'func');
|
|
end;
|
|
|
|
sc.Next;
|
|
case sc.token of
|
|
weNumber:
|
|
dst.exportNum := sc.resInt32;
|
|
weIdent:
|
|
dst.exportIdx := sc.resText;
|
|
else
|
|
ErrorExpectButFound(sc, 'index');
|
|
end;
|
|
sc.Next;
|
|
ConsumeToken(sc, weCloseBrace);
|
|
ConsumeToken(sc, weCloseBrace);
|
|
end;
|
|
|
|
procedure ConsumeAsmSym(sc: TWatScanner; dst: TAsmSymList);
|
|
begin
|
|
dst.Push(sc.asmCmd, sc.resText);
|
|
sc.Next;
|
|
end;
|
|
|
|
// parseIdOffset - should only be used for elems declareted at module leve
|
|
// if elems declared in a table, parseIdOffset should be set to false
|
|
procedure ParseElem(sc: TWatScanner; dst: TWasmElement; parseIdOffset: Boolean);
|
|
var
|
|
vid : TWasmId;
|
|
begin
|
|
if sc.token = weElem then sc.Next;
|
|
|
|
if parseIdOffset then begin
|
|
ParseId(sc, dst.tableId);
|
|
if (sc.token = weOpenBrace) then begin
|
|
sc.Next;
|
|
ParseInstrList(sc, dst.AddOffset);
|
|
ConsumeToken(sc, weCloseBrace);
|
|
end;
|
|
end;
|
|
|
|
while sc.token in [weIdent, weNumber] do begin
|
|
ParseId(sc, vid);
|
|
dst.AddFuncId(vid);
|
|
end;
|
|
ConsumeToken(sc, weCloseBrace);
|
|
end;
|
|
|
|
procedure ParseTable(sc: TWatScanner; dst: TWasmTable);
|
|
begin
|
|
if sc.token = weTable then sc.Next;
|
|
|
|
// table ident can be missing? If missing, then it's zero
|
|
if (sc.token in [weIdent, weNumber]) then
|
|
ParseId(sc, dst.id);
|
|
|
|
ConsumeToken(sc, weFuncRef);
|
|
dst.elemsType := elem_type;
|
|
|
|
// consuming elements
|
|
if (sc.token = weOpenBrace) then begin
|
|
sc.Next;
|
|
ParseElem(sc, dst.AddElem, false);
|
|
end;
|
|
|
|
ConsumeToken(sc, weCloseBrace);
|
|
end;
|
|
|
|
procedure ParseImport(sc: TWatScanner; dst: TWasmImport);
|
|
var
|
|
tk : TWatToken;
|
|
begin
|
|
if sc.token=weImport then
|
|
sc.Next;
|
|
|
|
if sc.token<>weString then
|
|
ErrorExpectButFound(sc, 'string');
|
|
dst.module := sc.resWasmString;
|
|
sc.Next;
|
|
|
|
if sc.token<>weString then
|
|
ErrorExpectButFound(sc, 'string');
|
|
dst.name := sc.resWasmString;
|
|
sc.Next;
|
|
|
|
ConsumeAnyOpenToken(sc, tk);
|
|
case tk of
|
|
weAsmSymbol: ;
|
|
weFunc: begin
|
|
ParseFunc(sc, dst.AddFunc);
|
|
end;
|
|
weMemory: begin
|
|
ParseMemory(sc, dst.AddMemory);
|
|
end;
|
|
weTable: begin
|
|
ParseTable(sc, dst.AddTable);
|
|
end;
|
|
weGlobal: begin
|
|
ParseGlobal(sc, dst.AddGlobal);
|
|
end;
|
|
else
|
|
ErrorExpectButFound(sc, 'importdesc', TokenStr[sc.token]);
|
|
end;
|
|
ConsumeToken(sc, weCloseBrace);
|
|
end;
|
|
|
|
|
|
procedure ParseModuleInt(sc: TWatScanner; dst: TWasmModule);
|
|
var
|
|
tk : TWatToken;
|
|
symlist : TAsmSymList;
|
|
f : TWasmFunc;
|
|
imp : TWasmImport;
|
|
m : TWasmMemory;
|
|
g : TWasmGlobal;
|
|
e : TWasmElement;
|
|
begin
|
|
if not ConsumeOpenToken(sc, weModule) then
|
|
ErrorExpectButFound(sc, 'module');
|
|
|
|
symlist := TAsmSymList.Create;
|
|
try
|
|
sc.Next;
|
|
ConsumeAnyOpenToken(sc, tk);
|
|
while tk <> weCloseBrace do begin
|
|
case tk of
|
|
weAsmSymbol:
|
|
ConsumeAsmSym(sc, symlist);
|
|
weImport: begin
|
|
imp:=dst.AddImport;
|
|
symlist.ToLinkInfo(imp.LinkInfo);
|
|
ParseImport(sc, imp);
|
|
symlist.Clear;
|
|
end;
|
|
weTable: begin
|
|
ParseTable(sc, dst.AddTable)
|
|
end;
|
|
weFunc: begin
|
|
f:=dst.AddFunc;
|
|
symlist.ToLinkInfo(f.LinkInfo);
|
|
symlist.Clear;
|
|
ParseFunc(sc, f);
|
|
end;
|
|
weMemory:
|
|
begin
|
|
m:=dst.AddMemory;
|
|
symlist.ToLinkInfo(f.LinkInfo);
|
|
symlist.Clear;
|
|
ParseMemory(sc, m);
|
|
end;
|
|
weExport:
|
|
begin
|
|
ParseExport(sc, dst.AddExport);
|
|
symlist.Clear;
|
|
end;
|
|
weData:begin
|
|
ParseData(sc, dst.AddData);
|
|
symlist.Clear;
|
|
end;
|
|
weType: begin
|
|
symlist.Clear;
|
|
ParseTypeDef(sc, dst.AddType);
|
|
end;
|
|
weGlobal: begin
|
|
g:=dst.AddGlobal;
|
|
symlist.ToLinkInfo(g.LinkInfo);
|
|
symlist.Clear;
|
|
ParseGlobal(sc, g);
|
|
end;
|
|
weElem: begin
|
|
e:=dst.AddElement;
|
|
symlist.Clear;
|
|
ParseElem(sc, e, true);
|
|
end;
|
|
else
|
|
ErrorExpectButFound(sc, 'func', TokenStr[sc.token]);
|
|
end;
|
|
ConsumeAnyOpenToken(sc, tk);
|
|
end;
|
|
ConsumeToken(sc, weCloseBrace);
|
|
finally
|
|
symlist.Free;
|
|
end;
|
|
end;
|
|
|
|
function ParseModule(sc: TWatScanner; dst: TWasmModule; var errMsg: string): Boolean;
|
|
var
|
|
res : TParseResult;
|
|
begin
|
|
Result := ParseModule(sc, dst, res);
|
|
if not Result then begin
|
|
errMsg:=Format('line: %d, pos: %d, %s', [res.line, res.pos, res.error]);
|
|
end else
|
|
errMsg:='';
|
|
end;
|
|
|
|
procedure GetLineAndPos(const buf: string; ofs: integer; out line, pos: integer);
|
|
var
|
|
i: integer;
|
|
ll: integer;
|
|
begin
|
|
i:=1;
|
|
line:=1;
|
|
ll:=1;
|
|
while (i<=length(buf)) and (i<ofs) do begin
|
|
if (buf[i]=#13) or (buf[i]=#10) then begin
|
|
inc(line);
|
|
if (i<=length(buf)) and (i<ofs) and ((buf[i]=#13) or (buf[i]=#10)) and (buf[i] <> buf[i-1]) then
|
|
inc(i);
|
|
ll:=i;
|
|
end;
|
|
inc(i);
|
|
end;
|
|
pos:=ofs - ll;
|
|
end;
|
|
|
|
function ParseModule(sc: TWatScanner; dst: TWasmModule; out err: TParseResult): Boolean;
|
|
begin
|
|
try
|
|
err.error:='';
|
|
err.pos:=0;
|
|
err.line:=0;
|
|
err.offset:=0;
|
|
ParseModuleInt(sc, dst);
|
|
Result:=true;
|
|
except
|
|
on x: EParserError do begin
|
|
err.error := x.Message;
|
|
err.offset := x.offset;
|
|
GetLineAndPos(sc.buf, x.offset, err.line, err.pos);
|
|
Result:=false;
|
|
end;
|
|
end;
|
|
end;
|
|
|
|
{ TAsmSymList }
|
|
|
|
procedure TAsmSymList.Push(const AName, AValue: string);
|
|
var
|
|
i : integer;
|
|
begin
|
|
for i:=0 to count-1 do
|
|
if syms[i].name = Aname then begin
|
|
syms[i].value := AValue;
|
|
Exit;
|
|
end;
|
|
|
|
if count=length(syms) then begin
|
|
if count=0 then SetLength(syms, 4)
|
|
else SetLength(syms, count*2);
|
|
end;
|
|
syms[count].name:=AName;
|
|
syms[count].value:=Avalue;
|
|
inc(count);
|
|
end;
|
|
|
|
procedure TAsmSymList.Clear;
|
|
begin
|
|
count:=0;
|
|
end;
|
|
|
|
procedure TAsmSymList.ToLinkInfo(var AInfo: TLinkInfo);
|
|
var
|
|
i : integer;
|
|
begin
|
|
for i:=0 to count-1 do begin
|
|
if syms[i].name = 'name' then
|
|
AInfo.Name := syms[i].value
|
|
else if syms[i].name = 'weak' then
|
|
AInfo.Binding := lbWeak
|
|
else if syms[i].name = 'local' then
|
|
AInfo.Binding := lbLocal
|
|
else if syms[i].name = 'hidden' then
|
|
Ainfo.isHidden := true
|
|
else if syms[i].name = 'undef' then
|
|
AInfo.isUndefined := true
|
|
else if syms[i].name = 'nostrip' then
|
|
AInfo.NoStrip := true
|
|
else if syms[i].name = 'forhost' then
|
|
AInfo.Binding := lbForHost;
|
|
end;
|
|
end;
|
|
|
|
{ EParserError }
|
|
|
|
constructor EParserError.Create(const amsg: string; aofs: integer);
|
|
begin
|
|
inherited Create(amsg);
|
|
offset:=aofs;
|
|
end;
|
|
|
|
const
|
|
INT64MASK = $FFFFFFFF00000000;
|
|
maxInt64 = 9223372036854775807;
|
|
|
|
function Int64ToOperand(v: Int64; var op: TWasmInstrOperand; castType: TWasmInstrOperandType): Boolean;
|
|
begin
|
|
Result := true;
|
|
case castType of
|
|
otNotused:
|
|
if (v and INT64MASK = 0) then begin
|
|
if (v<0) or (v < maxLongint) then begin
|
|
op.tp := otSInt32;
|
|
op.s32 := v;
|
|
end else begin
|
|
op.tp := otUInt32;
|
|
op.u32 := v;
|
|
end
|
|
end else begin
|
|
op.tp := otSInt64;
|
|
op.s64 := v;
|
|
end;
|
|
|
|
otSInt32:
|
|
begin
|
|
Result := (v and INT64MASK = 0);
|
|
if not Result then Exit;
|
|
op.tp := otSInt32;
|
|
op.s32 := v;
|
|
end;
|
|
|
|
otUInt32:
|
|
begin
|
|
Result := (v and INT64MASK = 0) and (v>=0);
|
|
if not Result then Exit;
|
|
op.tp := otUInt32;
|
|
op.u32 := v;
|
|
end;
|
|
|
|
otSInt64: begin
|
|
op.tp := otSInt32;
|
|
op.s64 := v;
|
|
end;
|
|
|
|
otUInt64: begin
|
|
Result := (v>=0);
|
|
op.tp := otUInt64;
|
|
op.u64 := v;
|
|
end;
|
|
|
|
otFloat32: begin
|
|
op.tp := otFloat32;
|
|
op.f32 := v;
|
|
end;
|
|
|
|
otFloat64: begin
|
|
op.tp := otFloat64;
|
|
op.f64 := v;
|
|
end;
|
|
end
|
|
end;
|
|
|
|
function UInt64ToOperand(v: UInt64; var op: TWasmInstrOperand; castType: TWasmInstrOperandType): Boolean;
|
|
begin
|
|
Result := true;
|
|
case castType of
|
|
otNotused:
|
|
if (v and INT64MASK = 0) then begin
|
|
if (v < maxLongint) then begin
|
|
op.tp := otSInt32;
|
|
op.s32 := v;
|
|
end else begin
|
|
op.tp := otUInt32;
|
|
op.u32 := v;
|
|
end
|
|
end else begin
|
|
if v < maxInt64 then begin
|
|
op.tp := otSInt64;
|
|
op.s64 := v;
|
|
end else begin
|
|
op.tp := otUInt64;
|
|
op.u64 := v;
|
|
end;
|
|
end;
|
|
|
|
otSInt32:
|
|
begin
|
|
Result := (v and INT64MASK = 0) and (v < maxLongint);
|
|
if not Result then Exit;
|
|
op.tp := otSInt32;
|
|
op.s32 := v;
|
|
end;
|
|
|
|
otUInt32:
|
|
begin
|
|
Result := (v and INT64MASK = 0);
|
|
if not Result then Exit;
|
|
op.tp := otUInt32;
|
|
op.u32 := v;
|
|
end;
|
|
|
|
otSInt64: begin
|
|
Result := (v <= maxInt64);
|
|
if not Result then Exit;
|
|
op.tp := otSInt32;
|
|
op.s64 := v;
|
|
end;
|
|
|
|
otUInt64: begin
|
|
op.tp := otUInt64;
|
|
op.u64 := v;
|
|
end;
|
|
|
|
otFloat32: begin
|
|
op.tp := otFloat32;
|
|
op.f32 := v;
|
|
end;
|
|
|
|
otFloat64: begin
|
|
op.tp := otFloat64;
|
|
op.f64 := v;
|
|
end;
|
|
end
|
|
end;
|
|
|
|
function TextToFloat32(const txt: string; var vl: Single): Boolean;
|
|
var
|
|
err : integer;
|
|
l : LongWord;
|
|
i : Integer;
|
|
hx : string;
|
|
hl : LongWord;
|
|
const
|
|
BINARY_INF = $7f800000;
|
|
BINARY_NEGINF = $ff800000;
|
|
BINARY_NEGMAN = $00400000;
|
|
begin
|
|
// val() doesn't handle "nan" in wasm compatible
|
|
// any "nan" is always returned as "negative nan" (in Wasm terms)
|
|
// "inf" works just fine
|
|
Result := true;
|
|
if (Pos('nan', txt)>0) then begin
|
|
if txt[1]='-' then l := NtoLE(BINARY_NEGINF)
|
|
else l := NtoLE(BINARY_INF);
|
|
|
|
i:=Pos(':', txt);
|
|
if i>0 then begin
|
|
hx := '$'+Copy(txt, i+3, length(txt)); // skipping '0x'
|
|
Val(hx, hl, err);
|
|
end else
|
|
hl:=BINARY_NEGMAN; // nan
|
|
l:=l or hl;
|
|
vl := PSingle(@l)^;
|
|
end else begin
|
|
vl:=0;
|
|
err:=0;
|
|
if (Pos('0x', txt)>0) then
|
|
vl := HexFloatStrToSingle(txt)
|
|
else begin
|
|
Val(txt, vl, err);
|
|
Result := err = 0;
|
|
end;
|
|
end;
|
|
end;
|
|
|
|
function TextToFloat64(const txt: string; var vl: Double): Boolean;
|
|
var
|
|
err : integer;
|
|
l : QWord;
|
|
i : Integer;
|
|
hx : string;
|
|
hl : QWord;
|
|
const
|
|
BINARY_INF = QWord($7ff0000000000000);
|
|
BINARY_NEGINF = QWord($fff0000000000000);
|
|
BINARY_NEGMAN = QWord($0008000000000000);
|
|
begin
|
|
Result := true;
|
|
if (Pos('nan', txt)>0) then begin
|
|
if txt[1]='-' then l := NtoLE(BINARY_NEGINF)
|
|
else l := NtoLE(BINARY_INF);
|
|
|
|
i:=Pos(':', txt);
|
|
if i>0 then begin
|
|
hx := '$'+Copy(txt, i+3, length(txt)); // skipping '0x'
|
|
Val(hx, hl, err);
|
|
end else
|
|
hl:=BINARY_NEGMAN; // nan
|
|
l:=l or hl;
|
|
vl := PDouble(@l)^;
|
|
end else begin
|
|
vl:=0;
|
|
if (Pos('0x', txt)>0) then
|
|
vl := HexFloatStrToDouble(txt)
|
|
else begin
|
|
Val(txt, vl, err);
|
|
Result := err = 0;
|
|
end;
|
|
end;
|
|
end;
|
|
|
|
function ParseOperand(sc: TWatScanner; var op: TWasmInstrOperand; castType: TWasmInstrOperandType): Boolean;
|
|
var
|
|
i64 : Int64;
|
|
u64 : UInt64;
|
|
err : Integer;
|
|
begin
|
|
Result := Assigned(sc);
|
|
if not Result then Exit;
|
|
|
|
if (castType = otText) or (sc.token <> weNumber) then begin
|
|
OperandSetText(op, sc.resText);
|
|
Exit;
|
|
end;
|
|
|
|
case sc.numformat of
|
|
wnfInteger, wnfHex: begin
|
|
val(sc.resText, i64, err);
|
|
if err = 0 then
|
|
Result := Int64ToOperand(i64, op, castType)
|
|
else begin
|
|
Val(sc.resText, u64, err);
|
|
Result := err = 0;
|
|
if Result then
|
|
Result := UInt64ToOperand(u64, op, castType);
|
|
end;
|
|
end;
|
|
wnfFloat, wnfFloatHex: begin // 0.000
|
|
Result := castType in [otNotused, otFloat32, otFloat64];
|
|
if not Result then Exit;
|
|
if castType = otFloat32 then begin
|
|
op.tp := otFloat32;
|
|
TextToFloat32(sc.resText, op.f32);
|
|
end else begin
|
|
op.tp := otFloat64;
|
|
TextToFloat64(sc.resText, op.f64);
|
|
end;
|
|
end;
|
|
end;
|
|
end;
|
|
|
|
end.
|