12345678910111213141516171819202122232425262728293031323334353637383940414243444546474849505152535455565758596061626364656667686970717273747576777879808182838485868788899091929394959697989910010110210310410510610710810911011111211311411511611711811912012112212312412512612712812913013113213313413513613713813914014114214314414514614714814915015115215315415515615715815916016116216316416516616716816917017117217317417517617717817918018118218318418518618718818919019119219319419519619719819920020120220320420520620720820921021121221321421521621721821922022122222322422522622722822923023123223323423523623723823924024124224324424524624724824925025125225325425525625725825926026126226326426526626726826927027127227327427527627727827928028128228328428528628728828929029129229329429529629729829930030130230330430530630730830931031131231331431531631731831932032132232332432532632732832933033133233333433533633733833934034134234334434534634734834935035135235335435535635735835936036136236336436536636736836937037137237337437537637737837938038138238338438538638738838939039139239339439539639739839940040140240340440540640740840941041141241341441541641741841942042142242342442542642742842943043143243343443543643743843944044144244344444544644744844945045145245345445545645745845946046146246346446546646746846947047147247347447547647747847948048148248348448548648748848949049149249349449549649749849950050150250350450550650750850951051151251351451551651751851952052152252352452552652752852953053153253353453553653753853954054154254354454554654754854955055155255355455555655755855956056156256356456556656756856957057157257357457557657757857958058158258358458558658758858959059159259359459559659759859960060160260360460560660760860961061161261361461561661761861962062162262362462562662762862963063163263363463563663763863964064164264364464564664764864965065165265365465565665765865966066166266366466566666766866967067167267367467567667767867968068168268368468568668768868969069169269369469569669769869970070170270370470570670770870971071171271371471571671771871972072172272372472572672772872973073173273373473573673773873974074174274374474574674774874975075175275375475575675775875976076176276376476576676776876977077177277377477577677777877978078178278378478578678778878979079179279379479579679779879980080180280380480580680780880981081181281381481581681781881982082182282382482582682782882983083183283383483583683783883984084184284384484584684784884985085185285385485585685785885986086186286386486586686786886987087187287387487587687787887988088188288388488588688788888989089189289389489589689789889990090190290390490590690790890991091191291391491591691791891992092192292392492592692792892993093193293393493593693793893994094194294394494594694794894995095195295395495595695795895996096196296396496596696796896997097197297397497597697797897998098198298398498598698798898999099199299399499599699799899910001001100210031004100510061007100810091010101110121013101410151016101710181019102010211022102310241025102610271028102910301031103210331034103510361037103810391040104110421043104410451046104710481049105010511052105310541055105610571058105910601061106210631064106510661067106810691070107110721073107410751076107710781079108010811082108310841085108610871088108910901091109210931094109510961097109810991100110111021103110411051106110711081109111011111112111311141115 |
- { This file is part of wasmbin - a collection of WebAssembly binary utils.
- Copyright (C) 2019, 2020 Dmitry Boyarintsev <[email protected]>
- 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.
|