watparser.pas 27 KB

12345678910111213141516171819202122232425262728293031323334353637383940414243444546474849505152535455565758596061626364656667686970717273747576777879808182838485868788899091929394959697989910010110210310410510610710810911011111211311411511611711811912012112212312412512612712812913013113213313413513613713813914014114214314414514614714814915015115215315415515615715815916016116216316416516616716816917017117217317417517617717817918018118218318418518618718818919019119219319419519619719819920020120220320420520620720820921021121221321421521621721821922022122222322422522622722822923023123223323423523623723823924024124224324424524624724824925025125225325425525625725825926026126226326426526626726826927027127227327427527627727827928028128228328428528628728828929029129229329429529629729829930030130230330430530630730830931031131231331431531631731831932032132232332432532632732832933033133233333433533633733833934034134234334434534634734834935035135235335435535635735835936036136236336436536636736836937037137237337437537637737837938038138238338438538638738838939039139239339439539639739839940040140240340440540640740840941041141241341441541641741841942042142242342442542642742842943043143243343443543643743843944044144244344444544644744844945045145245345445545645745845946046146246346446546646746846947047147247347447547647747847948048148248348448548648748848949049149249349449549649749849950050150250350450550650750850951051151251351451551651751851952052152252352452552652752852953053153253353453553653753853954054154254354454554654754854955055155255355455555655755855956056156256356456556656756856957057157257357457557657757857958058158258358458558658758858959059159259359459559659759859960060160260360460560660760860961061161261361461561661761861962062162262362462562662762862963063163263363463563663763863964064164264364464564664764864965065165265365465565665765865966066166266366466566666766866967067167267367467567667767867968068168268368468568668768868969069169269369469569669769869970070170270370470570670770870971071171271371471571671771871972072172272372472572672772872973073173273373473573673773873974074174274374474574674774874975075175275375475575675775875976076176276376476576676776876977077177277377477577677777877978078178278378478578678778878979079179279379479579679779879980080180280380480580680780880981081181281381481581681781881982082182282382482582682782882983083183283383483583683783883984084184284384484584684784884985085185285385485585685785885986086186286386486586686786886987087187287387487587687787887988088188288388488588688788888989089189289389489589689789889990090190290390490590690790890991091191291391491591691791891992092192292392492592692792892993093193293393493593693793893994094194294394494594694794894995095195295395495595695795895996096196296396496596696796896997097197297397497597697797897998098198298398498598698798898999099199299399499599699799899910001001100210031004100510061007100810091010101110121013101410151016101710181019102010211022102310241025102610271028102910301031103210331034103510361037103810391040104110421043104410451046104710481049105010511052105310541055105610571058105910601061106210631064106510661067106810691070107110721073107410751076107710781079108010811082108310841085108610871088108910901091109210931094109510961097109810991100110111021103110411051106110711081109111011111112111311141115
  1. { This file is part of wasmbin - a collection of WebAssembly binary utils.
  2. Copyright (C) 2019, 2020 Dmitry Boyarintsev <[email protected]>
  3. Copyright (C) 2020 by the Free Pascal development team
  4. This source is free software; you can redistribute it and/or modify it under
  5. the terms of the GNU General Public License as published by the Free
  6. Software Foundation; either version 2 of the License, or (at your option)
  7. any later version.
  8. This code is distributed in the hope that it will be useful, but WITHOUT ANY
  9. WARRANTY; without even the implied warranty of MERCHANTABILITY or FITNESS
  10. FOR A PARTICULAR PURPOSE. See the GNU General Public License for more
  11. details.
  12. A copy of the GNU General Public License is available on the World Wide Web
  13. at <http://www.gnu.org/copyleft/gpl.html>. You can also obtain it by writing
  14. to the Free Software Foundation, Inc., 51 Franklin Street - Fifth Floor,
  15. Boston, MA 02110-1335, USA.
  16. }
  17. unit watparser;
  18. {$mode delphi}{$H+}
  19. interface
  20. uses
  21. SysUtils, Classes, wasmtext, wasmmodule, watscanner, wasmbincode, wasmbin;
  22. type
  23. TParseResult = record
  24. error : string;
  25. line : integer;
  26. pos : integer;
  27. offset : integer;
  28. end;
  29. const
  30. TokenStr : array[TWatToken] of string = (
  31. 'uknown', 'error',
  32. 'index',
  33. 'string', 'number', '(', ')',
  34. 'assembler symbol',
  35. 'instruction',
  36. 'func',
  37. 'param', 'result',
  38. 'module', 'mut', 'funcref',
  39. 'i32', 'i64',
  40. 'f32', 'f64',
  41. 'type',
  42. 'import', 'global', 'table', 'memory', 'local', 'export',
  43. 'elem', 'data', 'offset','align','='
  44. );
  45. WasmTypeTokens = [wei32, wei64, wef32, wef64];
  46. //function ConsumeToken(sc: TWatScanner; tk: TWatToken): Boolean;
  47. function ParseModule(sc: TWatScanner; dst: TWasmModule; var errMsg: string): Boolean; overload;
  48. function ParseModule(sc: TWatScanner; dst: TWasmModule; out err: TParseResult): Boolean; overload;
  49. // castType can be otNotused, if no explicit type cast is expected
  50. function ParseOperand(sc: TWatScanner; var op: TWasmInstrOperand; castType: TWasmInstrOperandType): Boolean;
  51. implementation
  52. type
  53. // used to stop the recursive parsing
  54. { EParserError }
  55. EParserError = class(Exception)
  56. offset : integer;
  57. constructor Create(const amsg: string; aofs: integer);
  58. end;
  59. TAsmSym = record
  60. name : string;
  61. value : string;
  62. end;
  63. { TAsmSymList }
  64. TAsmSymList = class(TObject)
  65. syms : array of TAsmSym;
  66. count : integer;
  67. procedure Push(const AName, AValue: string);
  68. procedure Clear;
  69. procedure ToLinkInfo(var AInfo: TLinkInfo);
  70. end;
  71. const
  72. WAT_DEFTYPES='iN or fN';
  73. procedure ParseError(sc: TWatScanner; const errMsg: string);
  74. begin
  75. raise EParserError.Create(errMsg, sc.ofs);
  76. end;
  77. procedure ErrorExpectButFound(sc: TWatScanner; const expected: string; const butfound: string =''); overload;
  78. var
  79. r : string;
  80. begin
  81. if butfound = '' then r := sc.resText
  82. else r := butfound;
  83. ParseError(sc, 'expected "'+expected+'", but "'+r+'" found');
  84. end;
  85. procedure ErrorUnexpectedEof(sc: TWatScanner);
  86. begin
  87. ParseError(sc, 'unexpected end of file');
  88. end;
  89. procedure ConsumeAnyOpenToken(sc: TWatScanner; out tk: TWatToken;
  90. out hadOpenBrace: Boolean); overload;
  91. begin
  92. hadOpenBrace := sc.token = weOpenBrace;
  93. if hadOpenBrace then sc.Next;
  94. tk:=sc.token;
  95. end;
  96. procedure ConsumeAnyOpenToken(sc: TWatScanner); overload;
  97. var
  98. tk: TWatToken;
  99. op: Boolean;
  100. begin
  101. ConsumeAnyOpenToken(sc, tk, op);
  102. end;
  103. procedure ConsumeAnyOpenToken(sc: TWatScanner; out tk: TWatToken); overload;
  104. var
  105. op: Boolean;
  106. begin
  107. ConsumeAnyOpenToken(sc, tk, op);
  108. end;
  109. function ConsumeOpenToken(sc: TWatScanner; tk: TWatToken): Boolean;
  110. begin
  111. sc.Next;
  112. Result := (sc.token=weOpenBrace) or (sc.Token=tk);
  113. if Result and (sc.token=weOpenBrace) then begin
  114. sc.Next;
  115. Result := (sc.Token=tk);
  116. end;
  117. end;
  118. function ConsumeToken(sc: TWatScanner; tk: TWatToken): Boolean;
  119. begin
  120. Result:=sc.token =tk;
  121. if not Result then
  122. ErrorExpectButFound(sc,TokenStr[tk])
  123. else
  124. sc.Next;
  125. end;
  126. function ParseNumOfId(sc: TWatScanner; out num: integer; out id: string): Boolean;
  127. begin
  128. num:=-1;
  129. id:='';
  130. case sc.token of
  131. weNumber: num:=sc.resInt32;
  132. weIdent: id:=sc.resText;
  133. else
  134. ErrorExpectButFound(sc, 'index', TokenStr[sc.token]);
  135. Result := false;
  136. end;
  137. Result := true;
  138. if Result then sc.Next;
  139. end;
  140. function ParseId(sc: TWatScanner; var id: TWasmId): boolean;
  141. begin
  142. Result := ParseNumOfId(sc, id.idNum, id.id);
  143. end;
  144. function TokenTypeToValType(t: TWatToken; out tp: byte): Boolean;
  145. begin
  146. Result:=true;
  147. case t of
  148. wei32: tp:=valtype_i32;
  149. wei64: tp:=valtype_i64;
  150. wef32: tp:=valtype_f32;
  151. wef64: tp:=valtype_f64;
  152. else
  153. tp:=0;
  154. Result:=false;
  155. end;
  156. end;
  157. procedure ParseParam(sc: TWatScanner; out id: string; out tp: byte; allowIdent: Boolean = true; consumeClose: Boolean = true);
  158. begin
  159. tp:=0;
  160. id:='';
  161. if allowIdent and (sc.token=weIdent) then begin
  162. id:=sc.resText;
  163. sc.Next;
  164. end;
  165. if not TokenTypeToValType(sc.token, tp) then
  166. ErrorExpectButFound(sc, WAT_DEFTYPES, TokenStr[sc.token]);
  167. sc.Next;
  168. if consumeClose then
  169. ConsumeToken(sc, weCloseBrace);
  170. end;
  171. procedure ParseNumOrIdx(sc: TWatScanner; out num: integer; out idx: string);
  172. begin
  173. if sc.token = weIdent then begin
  174. idx := sc.resText;
  175. num := -1;
  176. end else if sc.token = weNumber then begin
  177. idx := '';
  178. num := sc.resInt32;
  179. end else
  180. ErrorExpectButFound(sc, 'number');
  181. sc.Next;
  182. end;
  183. // lookForRefId (if true) parses for the case of (type 0)
  184. // (if false) just looks for (param i32) (result i32)
  185. procedure ParseTypeUse(sc: TWatScanner; dst: TWasmFuncType; lookForRefId: Boolean);
  186. var
  187. tk : TWatToken;
  188. nm : integer;
  189. id : string;
  190. p : TWasmParam;
  191. begin
  192. tk := sc.token;
  193. if lookForRefId and (tk = weType) then begin
  194. sc.Next;
  195. if not ParseNumOfId(sc, nm, id) then
  196. Exit;
  197. if nm>=0 then dst.typeNum:=nm
  198. else dst.typeIdx:=id;
  199. ConsumeAnyOpenToken(sc, tk);
  200. end;
  201. while tk = weParam do begin
  202. p:=dst.AddParam;
  203. sc.Next;
  204. ParseParam(sc, p.id, p.tp, true, false);
  205. // Text format specification:
  206. // Abbreviations
  207. // Multiple anonymous parameters or results may be combined into a single declaration
  208. if (p.id = '') and (sc.token in [wei32, wei64, wef32, wef64]) then begin
  209. while (sc.token in [wei32, wei64, wef32, wef64]) do begin
  210. p:=dst.AddParam;
  211. TokenTypeToValType(sc.token, p.tp);
  212. sc.Next;
  213. end;
  214. end;
  215. ConsumeToken(sc, weCloseBrace);
  216. ConsumeAnyOpenToken(sc, tk);
  217. end;
  218. while tk = weResult do begin
  219. p:=dst.AddResult;
  220. sc.Next;
  221. ParseParam(sc, p.id, p.tp, false);
  222. ConsumeAnyOpenToken(sc, tk);
  223. end;
  224. end;
  225. function IntToAlign(aint: Integer): integer;
  226. begin
  227. Result:=0;
  228. aint := aint shr 1;
  229. while aint>0 do begin
  230. aint := aint shr 1;
  231. inc(Result);
  232. end;
  233. end;
  234. procedure ParseInstrList(sc: TWatScanner; dst: TWasmInstrList);
  235. var
  236. ci : TWasmInstr;
  237. ft : TWasmFuncType;
  238. const
  239. ParamTypeToOpType : array [TInstParamType] of TWasmInstrOperandType = (
  240. otNotused, // ipNone
  241. otUInt32, // ipLeb, // label index or function index
  242. otUInt32, // ipOfsAlign, // memory arguments, ask for offset + align
  243. otSInt32, // ipi32, // signed Leb of maximum 4 bytes
  244. otNotused, // ipi64, // signed Leb of maximum 8 bytes
  245. otUInt32, // ipu32, // signed Leb of maximum 4 bytes
  246. otNotused, // ipu64, // signed Leb of maximum 8 bytes
  247. otFloat32, // ipf32, // float point single
  248. otFloat64, // ipf64, // float point double
  249. otNotused, // ipJumpVec, // an array of jump labels used for br_table only
  250. otNotused, // ipResType, // result type used for blocks, such as If, block or loop
  251. otNotused, // ipCallType, // used for call_indirect
  252. otNotused, // ipi32OrFunc, // use for i32.const. Either a numeric OR function id is accepted.
  253. otUInt32 // ipZero // followed by a single byte zero
  254. );
  255. begin
  256. while sc.token=weInstr do begin
  257. ci := dst.AddInstr(sc.instrCode);
  258. sc.Next;
  259. case INST_FLAGS[ci.code].Param of
  260. ipNone:; // do nothing
  261. ipLeb:
  262. ParseNumOrIdx(sc, ci.operandNum, ci.operandIdx);
  263. ipOfsAlign: begin
  264. if sc.token = weOffset then begin
  265. sc.Next;
  266. ConsumeToken(sc, weEqual);
  267. if sc.token<>weNumber then ErrorExpectButFound(sc, 'number');
  268. //todo: fail on invalid value
  269. OperandSetInt32(ci.operand1, sc.resInt32(0));
  270. sc.Next;
  271. end;
  272. if sc.token = weAlign then begin
  273. sc.Next;
  274. ConsumeToken(sc, weEqual);
  275. if sc.token<>weNumber then ErrorExpectButFound(sc, 'number');
  276. OperandSetInt32(ci.operand2, IntToAlign(sc.resInt32(0)));
  277. sc.Next;
  278. end else
  279. OperandSetInt32(ci.operand2, INST_FLAGS[ci.code].align);
  280. end;
  281. ipi32,ipi64,ipu32,ipu64,ipf32,ipf64,ipi32OrFunc:
  282. begin
  283. if (INST_FLAGS[ci.code].Param = ipi32OrFunc) and (sc.token = weIdent) then
  284. OperandSetText(ci.operand1, sc.resText)
  285. else if sc.token<>weNumber then begin
  286. ErrorExpectButFound(sc, 'number');
  287. Exit;
  288. end else
  289. ParseOperand(sc, ci.operand1, ParamTypeToOpType[INST_FLAGS[ci.code].Param]);
  290. sc.Next;
  291. end;
  292. ipCallType:
  293. begin
  294. // call_indirect operator consists of 2 parameters
  295. // 1 - type call
  296. // 2 - table reference index. Which should always be zero.
  297. ConsumeToken(sc, weOpenBrace);
  298. ft := ci.addInstType;
  299. ParseTypeUse(sc, ft, true);
  300. ci.operandNum := 0; // table reference index
  301. end;
  302. //ip2Leb, // memory arguments, ask for offset + align
  303. ipJumpVec:
  304. begin
  305. while (sc.token in [weNumber, weIdent]) do begin
  306. if (ci.vecTableCount = length(ci.vecTable)) then begin
  307. if (ci.vecTableCount = 0) then SetLength(ci.vecTable, 2)
  308. else SetLength(ci.vecTable, ci.vecTableCount * 2);
  309. end;
  310. ParseId(sc, ci.vecTable[ci.vecTableCount]);
  311. inc(ci.vecTableCount);
  312. end;
  313. if (ci.vecTableCount<2) then begin
  314. ErrorExpectButFound(sc, 'label');
  315. Exit;
  316. end;
  317. dec(ci.vecTableCount);
  318. ci.operandIdx := ci.vecTable[ci.vecTableCount].id;
  319. ci.operandNum := ci.vecTable[ci.vecTableCount].idNum;
  320. end;
  321. ipResType: // result type used for blocks, such as If, block or loop
  322. begin
  323. if sc.token = weIdent then begin
  324. ci.jumplabel := sc.resText;
  325. sc.Next;
  326. end;
  327. if (sc.token = weOpenBrace) then begin
  328. ConsumeToken(sc, weOpenBrace);
  329. ConsumeToken(sc, weResult);
  330. case sc.token of
  331. wei32: ci.operandNum := valtype_i32;
  332. wei64: ci.operandNum := valtype_i64;
  333. wef32: ci.operandNum := valtype_f32;
  334. wef64: ci.operandNum := valtype_f64;
  335. else
  336. ErrorExpectButFound(sc, 'i32');
  337. end;
  338. sc.Next;
  339. ConsumeToken(sc, weCloseBrace);
  340. end else
  341. ci.operandNum := block_type; // no value type
  342. end;
  343. end;
  344. end;
  345. end;
  346. procedure ParseFunc(sc: TWatScanner; dst: TWasmFunc);
  347. var
  348. tk : TWatToken;
  349. p : TWasmParam;
  350. begin
  351. if sc.token=weFunc then sc.Next;
  352. if sc.token=weIdent then begin
  353. dst.id:=sc.resText;
  354. sc.Next;
  355. end;
  356. ConsumeAnyOpenToken(sc, tk);
  357. if tk in [weType, weParam, weResult] then begin
  358. ParseTypeUse(sc, dst.functype, true);
  359. ConsumeAnyOpenToken(sc, tk);
  360. end;
  361. while tk = weLocal do begin
  362. p:=dst.AddLocal;
  363. sc.Next;
  364. ParseParam(sc, p.id, p.tp, true, false);
  365. if p.id = '' then begin
  366. while sc.token in WasmTypeTokens do begin
  367. p:=dst.AddLocal;
  368. TokenTypeToValType(sc.token, p.tp);
  369. sc.Next;
  370. end;
  371. end;
  372. if sc.token=weCloseBrace then sc.Next;
  373. ConsumeAnyOpenToken(sc, tk);
  374. end;
  375. if not (sc.token in [weInstr, weCloseBrace]) then
  376. ErrorExpectButFound(sc, 'identifier');
  377. ParseInstrList(sc, dst.instr);
  378. ConsumeToken(sc, weCloseBrace);
  379. end;
  380. procedure ParseTypeDef(sc: TWatScanner; dst: TWasmFuncType);
  381. begin
  382. if sc.token=weType then sc.Next;
  383. if (sc.token in [weNumber, weIdent]) then
  384. ParseNumOfId(sc, dst.typeNum, dst.typeIdx);
  385. ConsumeToken(sc, weOpenBrace);
  386. ConsumeToken(sc, weFunc);
  387. if (sc.token = weOpenBrace) then begin
  388. sc.Next;
  389. ParseTypeUse(sc, dst, false);
  390. ConsumeToken(sc, weCloseBrace);
  391. end;
  392. ConsumeToken(sc, weCloseBrace);
  393. end;
  394. procedure ParseGlobal(sc: TWatScanner; dst: TWasmGlobal);
  395. var
  396. allowValue: Boolean;
  397. begin
  398. if sc.token = weGlobal then sc.Next;
  399. allowValue := true;
  400. // parsing id
  401. if (sc.token in [weIdent, weNumber]) then ParseId(sc, dst.id);
  402. // import or export
  403. if (sc.token=weOpenBrace) then begin
  404. sc.Next;
  405. if sc.token=weImport then begin
  406. // import
  407. allowValue := false;
  408. end else if sc.token=weExport then begin
  409. // export
  410. end;
  411. end;
  412. // parsing type. Global can be mutable type (mut i32)
  413. if (sc.token=weOpenBrace) then sc.Next;
  414. if sc.token = weMut then begin
  415. dst.isMutable := true;
  416. sc.Next;
  417. end;
  418. if (sc.token in WasmTypeTokens) then begin
  419. TokenTypeToValType(sc.token, dst.tp);
  420. sc.Next;
  421. end else
  422. ErrorExpectButFound(sc, 'type');
  423. if dst.isMutable then ConsumeToken(sc, weCloseBrace);
  424. if allowValue and (sc.token = weOpenBrace) then begin
  425. sc.Next;
  426. ParseInstrList(sc, dst.StartValue);
  427. ConsumeToken(sc, weCloseBrace);
  428. end;
  429. ConsumeToken(sc, weCloseBrace);
  430. end;
  431. procedure ParseData(sc: TWatScanner; dst: TWasmData);
  432. var
  433. l : integer;
  434. begin
  435. if sc.token=weData then sc.Next;
  436. //id (if not exists, should be zero)
  437. if sc.token in [weIdent, weNumber] then
  438. ParseId(sc, dst.id);
  439. // offset (if not exist, should be zero)
  440. if (sc.token = weOpenBrace) then begin
  441. sc.Next;
  442. ParseInstrList(sc, dst.StartOffset);
  443. ConsumeToken(sc, weCloseBrace);
  444. end;
  445. // data (if not exist, then blank)
  446. if sc.token = weString then begin
  447. l := length(sc.resText);
  448. SetLength(dst.databuf, l);
  449. if l>0 then
  450. Move(sc.resText[1], dst.databuf[0], l);
  451. sc.Next;
  452. end;
  453. ConsumeToken(sc, weCloseBrace);
  454. end;
  455. procedure ParseMemory(sc: TWatScanner; dst: TWasmMemory);
  456. begin
  457. if sc.token=weMemory then sc.Next;
  458. if sc.token in [weIdent] then
  459. ParseId(sc, dst.id);
  460. // todo: parsing of Import / Export
  461. if sc.token in [weNumber] then begin
  462. dst.min := sc.resInt32(0);
  463. sc.Next;
  464. end;
  465. if sc.token in [weNumber] then begin
  466. dst.max := sc.resInt32(0);
  467. sc.Next;
  468. end;
  469. ConsumeToken(sc, weCloseBrace);
  470. end;
  471. procedure ParseExport(sc: TWatScanner; dst: TWasmExport);
  472. begin
  473. if sc.token=weExport then
  474. sc.Next;
  475. if sc.token<>weString then
  476. ErrorExpectButFound(sc, 'string');
  477. dst.name := sc.resWasmString;
  478. sc.Next;
  479. ConsumeAnyOpenToken(sc);
  480. case sc.token of
  481. weFunc: dst.exportType:=EXPDESC_FUNC;
  482. weTable: dst.exportType:=EXPDESC_TABLE;
  483. weMemory: dst.exportType:=EXPDESC_MEM;
  484. weGlobal: dst.exportType:=EXPDESC_GLOBAL;
  485. else
  486. ErrorExpectButFound(sc, 'func');
  487. end;
  488. sc.Next;
  489. case sc.token of
  490. weNumber:
  491. dst.exportNum := sc.resInt32;
  492. weIdent:
  493. dst.exportIdx := sc.resText;
  494. else
  495. ErrorExpectButFound(sc, 'index');
  496. end;
  497. sc.Next;
  498. ConsumeToken(sc, weCloseBrace);
  499. ConsumeToken(sc, weCloseBrace);
  500. end;
  501. procedure ConsumeAsmSym(sc: TWatScanner; dst: TAsmSymList);
  502. begin
  503. dst.Push(sc.asmCmd, sc.resText);
  504. sc.Next;
  505. end;
  506. // parseIdOffset - should only be used for elems declareted at module leve
  507. // if elems declared in a table, parseIdOffset should be set to false
  508. procedure ParseElem(sc: TWatScanner; dst: TWasmElement; parseIdOffset: Boolean);
  509. var
  510. vid : TWasmId;
  511. begin
  512. if sc.token = weElem then sc.Next;
  513. if parseIdOffset then begin
  514. ParseId(sc, dst.tableId);
  515. if (sc.token = weOpenBrace) then begin
  516. sc.Next;
  517. ParseInstrList(sc, dst.AddOffset);
  518. ConsumeToken(sc, weCloseBrace);
  519. end;
  520. end;
  521. while sc.token in [weIdent, weNumber] do begin
  522. ParseId(sc, vid);
  523. dst.AddFuncId(vid);
  524. end;
  525. ConsumeToken(sc, weCloseBrace);
  526. end;
  527. procedure ParseTable(sc: TWatScanner; dst: TWasmTable);
  528. begin
  529. if sc.token = weTable then sc.Next;
  530. // table ident can be missing? If missing, then it's zero
  531. if (sc.token in [weIdent, weNumber]) then
  532. ParseId(sc, dst.id);
  533. ConsumeToken(sc, weFuncRef);
  534. dst.elemsType := elem_type;
  535. // consuming elements
  536. if (sc.token = weOpenBrace) then begin
  537. sc.Next;
  538. ParseElem(sc, dst.AddElem, false);
  539. end;
  540. ConsumeToken(sc, weCloseBrace);
  541. end;
  542. procedure ParseImport(sc: TWatScanner; dst: TWasmImport);
  543. var
  544. tk : TWatToken;
  545. begin
  546. if sc.token=weImport then
  547. sc.Next;
  548. if sc.token<>weString then
  549. ErrorExpectButFound(sc, 'string');
  550. dst.module := sc.resWasmString;
  551. sc.Next;
  552. if sc.token<>weString then
  553. ErrorExpectButFound(sc, 'string');
  554. dst.name := sc.resWasmString;
  555. sc.Next;
  556. ConsumeAnyOpenToken(sc, tk);
  557. case tk of
  558. weAsmSymbol: ;
  559. weFunc: begin
  560. ParseFunc(sc, dst.AddFunc);
  561. end;
  562. weMemory: begin
  563. ParseMemory(sc, dst.AddMemory);
  564. end;
  565. weTable: begin
  566. ParseTable(sc, dst.AddTable);
  567. end;
  568. weGlobal: begin
  569. ParseGlobal(sc, dst.AddGlobal);
  570. end;
  571. else
  572. ErrorExpectButFound(sc, 'importdesc', TokenStr[sc.token]);
  573. end;
  574. ConsumeToken(sc, weCloseBrace);
  575. end;
  576. procedure ParseModuleInt(sc: TWatScanner; dst: TWasmModule);
  577. var
  578. tk : TWatToken;
  579. symlist : TAsmSymList;
  580. f : TWasmFunc;
  581. imp : TWasmImport;
  582. m : TWasmMemory;
  583. g : TWasmGlobal;
  584. e : TWasmElement;
  585. begin
  586. if not ConsumeOpenToken(sc, weModule) then
  587. ErrorExpectButFound(sc, 'module');
  588. symlist := TAsmSymList.Create;
  589. try
  590. sc.Next;
  591. ConsumeAnyOpenToken(sc, tk);
  592. while tk <> weCloseBrace do begin
  593. case tk of
  594. weAsmSymbol:
  595. ConsumeAsmSym(sc, symlist);
  596. weImport: begin
  597. imp:=dst.AddImport;
  598. symlist.ToLinkInfo(imp.LinkInfo);
  599. ParseImport(sc, imp);
  600. symlist.Clear;
  601. end;
  602. weTable: begin
  603. ParseTable(sc, dst.AddTable)
  604. end;
  605. weFunc: begin
  606. f:=dst.AddFunc;
  607. symlist.ToLinkInfo(f.LinkInfo);
  608. symlist.Clear;
  609. ParseFunc(sc, f);
  610. end;
  611. weMemory:
  612. begin
  613. m:=dst.AddMemory;
  614. symlist.ToLinkInfo(f.LinkInfo);
  615. symlist.Clear;
  616. ParseMemory(sc, m);
  617. end;
  618. weExport:
  619. begin
  620. ParseExport(sc, dst.AddExport);
  621. symlist.Clear;
  622. end;
  623. weData:begin
  624. ParseData(sc, dst.AddData);
  625. symlist.Clear;
  626. end;
  627. weType: begin
  628. symlist.Clear;
  629. ParseTypeDef(sc, dst.AddType);
  630. end;
  631. weGlobal: begin
  632. g:=dst.AddGlobal;
  633. symlist.ToLinkInfo(g.LinkInfo);
  634. symlist.Clear;
  635. ParseGlobal(sc, g);
  636. end;
  637. weElem: begin
  638. e:=dst.AddElement;
  639. symlist.Clear;
  640. ParseElem(sc, e, true);
  641. end;
  642. else
  643. ErrorExpectButFound(sc, 'func', TokenStr[sc.token]);
  644. end;
  645. ConsumeAnyOpenToken(sc, tk);
  646. end;
  647. ConsumeToken(sc, weCloseBrace);
  648. finally
  649. symlist.Free;
  650. end;
  651. end;
  652. function ParseModule(sc: TWatScanner; dst: TWasmModule; var errMsg: string): Boolean;
  653. var
  654. res : TParseResult;
  655. begin
  656. Result := ParseModule(sc, dst, res);
  657. if not Result then begin
  658. errMsg:=Format('line: %d, pos: %d, %s', [res.line, res.pos, res.error]);
  659. end else
  660. errMsg:='';
  661. end;
  662. procedure GetLineAndPos(const buf: string; ofs: integer; out line, pos: integer);
  663. var
  664. i: integer;
  665. ll: integer;
  666. begin
  667. i:=1;
  668. line:=1;
  669. ll:=1;
  670. while (i<=length(buf)) and (i<ofs) do begin
  671. if (buf[i]=#13) or (buf[i]=#10) then begin
  672. inc(line);
  673. if (i<=length(buf)) and (i<ofs) and ((buf[i]=#13) or (buf[i]=#10)) and (buf[i] <> buf[i-1]) then
  674. inc(i);
  675. ll:=i;
  676. end;
  677. inc(i);
  678. end;
  679. pos:=ofs - ll;
  680. end;
  681. function ParseModule(sc: TWatScanner; dst: TWasmModule; out err: TParseResult): Boolean;
  682. begin
  683. try
  684. err.error:='';
  685. err.pos:=0;
  686. err.line:=0;
  687. err.offset:=0;
  688. ParseModuleInt(sc, dst);
  689. Result:=true;
  690. except
  691. on x: EParserError do begin
  692. err.error := x.Message;
  693. err.offset := x.offset;
  694. GetLineAndPos(sc.buf, x.offset, err.line, err.pos);
  695. Result:=false;
  696. end;
  697. end;
  698. end;
  699. { TAsmSymList }
  700. procedure TAsmSymList.Push(const AName, AValue: string);
  701. var
  702. i : integer;
  703. begin
  704. for i:=0 to count-1 do
  705. if syms[i].name = Aname then begin
  706. syms[i].value := AValue;
  707. Exit;
  708. end;
  709. if count=length(syms) then begin
  710. if count=0 then SetLength(syms, 4)
  711. else SetLength(syms, count*2);
  712. end;
  713. syms[count].name:=AName;
  714. syms[count].value:=Avalue;
  715. inc(count);
  716. end;
  717. procedure TAsmSymList.Clear;
  718. begin
  719. count:=0;
  720. end;
  721. procedure TAsmSymList.ToLinkInfo(var AInfo: TLinkInfo);
  722. var
  723. i : integer;
  724. begin
  725. for i:=0 to count-1 do begin
  726. if syms[i].name = 'name' then
  727. AInfo.Name := syms[i].value
  728. else if syms[i].name = 'weak' then
  729. AInfo.Binding := lbWeak
  730. else if syms[i].name = 'local' then
  731. AInfo.Binding := lbLocal
  732. else if syms[i].name = 'hidden' then
  733. Ainfo.isHidden := true
  734. else if syms[i].name = 'undef' then
  735. AInfo.isUndefined := true
  736. else if syms[i].name = 'nostrip' then
  737. AInfo.NoStrip := true
  738. else if syms[i].name = 'forhost' then
  739. AInfo.Binding := lbForHost;
  740. end;
  741. end;
  742. { EParserError }
  743. constructor EParserError.Create(const amsg: string; aofs: integer);
  744. begin
  745. inherited Create(amsg);
  746. offset:=aofs;
  747. end;
  748. const
  749. INT64MASK = $FFFFFFFF00000000;
  750. maxInt64 = 9223372036854775807;
  751. function Int64ToOperand(v: Int64; var op: TWasmInstrOperand; castType: TWasmInstrOperandType): Boolean;
  752. begin
  753. Result := true;
  754. case castType of
  755. otNotused:
  756. if (v and INT64MASK = 0) then begin
  757. if (v<0) or (v < maxLongint) then begin
  758. op.tp := otSInt32;
  759. op.s32 := v;
  760. end else begin
  761. op.tp := otUInt32;
  762. op.u32 := v;
  763. end
  764. end else begin
  765. op.tp := otSInt64;
  766. op.s64 := v;
  767. end;
  768. otSInt32:
  769. begin
  770. Result := (v and INT64MASK = 0);
  771. if not Result then Exit;
  772. op.tp := otSInt32;
  773. op.s32 := v;
  774. end;
  775. otUInt32:
  776. begin
  777. Result := (v and INT64MASK = 0) and (v>=0);
  778. if not Result then Exit;
  779. op.tp := otUInt32;
  780. op.u32 := v;
  781. end;
  782. otSInt64: begin
  783. op.tp := otSInt32;
  784. op.s64 := v;
  785. end;
  786. otUInt64: begin
  787. Result := (v>=0);
  788. op.tp := otUInt64;
  789. op.u64 := v;
  790. end;
  791. otFloat32: begin
  792. op.tp := otFloat32;
  793. op.f32 := v;
  794. end;
  795. otFloat64: begin
  796. op.tp := otFloat64;
  797. op.f64 := v;
  798. end;
  799. end
  800. end;
  801. function UInt64ToOperand(v: UInt64; var op: TWasmInstrOperand; castType: TWasmInstrOperandType): Boolean;
  802. begin
  803. Result := true;
  804. case castType of
  805. otNotused:
  806. if (v and INT64MASK = 0) then begin
  807. if (v < maxLongint) then begin
  808. op.tp := otSInt32;
  809. op.s32 := v;
  810. end else begin
  811. op.tp := otUInt32;
  812. op.u32 := v;
  813. end
  814. end else begin
  815. if v < maxInt64 then begin
  816. op.tp := otSInt64;
  817. op.s64 := v;
  818. end else begin
  819. op.tp := otUInt64;
  820. op.u64 := v;
  821. end;
  822. end;
  823. otSInt32:
  824. begin
  825. Result := (v and INT64MASK = 0) and (v < maxLongint);
  826. if not Result then Exit;
  827. op.tp := otSInt32;
  828. op.s32 := v;
  829. end;
  830. otUInt32:
  831. begin
  832. Result := (v and INT64MASK = 0);
  833. if not Result then Exit;
  834. op.tp := otUInt32;
  835. op.u32 := v;
  836. end;
  837. otSInt64: begin
  838. Result := (v <= maxInt64);
  839. if not Result then Exit;
  840. op.tp := otSInt32;
  841. op.s64 := v;
  842. end;
  843. otUInt64: begin
  844. op.tp := otUInt64;
  845. op.u64 := v;
  846. end;
  847. otFloat32: begin
  848. op.tp := otFloat32;
  849. op.f32 := v;
  850. end;
  851. otFloat64: begin
  852. op.tp := otFloat64;
  853. op.f64 := v;
  854. end;
  855. end
  856. end;
  857. function TextToFloat32(const txt: string; var vl: Single): Boolean;
  858. var
  859. err : integer;
  860. l : LongWord;
  861. i : Integer;
  862. hx : string;
  863. hl : LongWord;
  864. const
  865. BINARY_INF = $7f800000;
  866. BINARY_NEGINF = $ff800000;
  867. BINARY_NEGMAN = $00400000;
  868. begin
  869. // val() doesn't handle "nan" in wasm compatible
  870. // any "nan" is always returned as "negative nan" (in Wasm terms)
  871. // "inf" works just fine
  872. Result := true;
  873. if (Pos('nan', txt)>0) then begin
  874. if txt[1]='-' then l := NtoLE(BINARY_NEGINF)
  875. else l := NtoLE(BINARY_INF);
  876. i:=Pos(':', txt);
  877. if i>0 then begin
  878. hx := '$'+Copy(txt, i+3, length(txt)); // skipping '0x'
  879. Val(hx, hl, err);
  880. end else
  881. hl:=BINARY_NEGMAN; // nan
  882. l:=l or hl;
  883. vl := PSingle(@l)^;
  884. end else begin
  885. vl:=0;
  886. err:=0;
  887. if (Pos('0x', txt)>0) then
  888. vl := HexFloatStrToSingle(txt)
  889. else begin
  890. Val(txt, vl, err);
  891. Result := err = 0;
  892. end;
  893. end;
  894. end;
  895. function TextToFloat64(const txt: string; var vl: Double): Boolean;
  896. var
  897. err : integer;
  898. l : QWord;
  899. i : Integer;
  900. hx : string;
  901. hl : QWord;
  902. const
  903. BINARY_INF = QWord($7ff0000000000000);
  904. BINARY_NEGINF = QWord($fff0000000000000);
  905. BINARY_NEGMAN = QWord($0008000000000000);
  906. begin
  907. Result := true;
  908. if (Pos('nan', txt)>0) then begin
  909. if txt[1]='-' then l := NtoLE(BINARY_NEGINF)
  910. else l := NtoLE(BINARY_INF);
  911. i:=Pos(':', txt);
  912. if i>0 then begin
  913. hx := '$'+Copy(txt, i+3, length(txt)); // skipping '0x'
  914. Val(hx, hl, err);
  915. end else
  916. hl:=BINARY_NEGMAN; // nan
  917. l:=l or hl;
  918. vl := PDouble(@l)^;
  919. end else begin
  920. vl:=0;
  921. if (Pos('0x', txt)>0) then
  922. vl := HexFloatStrToDouble(txt)
  923. else begin
  924. Val(txt, vl, err);
  925. Result := err = 0;
  926. end;
  927. end;
  928. end;
  929. function ParseOperand(sc: TWatScanner; var op: TWasmInstrOperand; castType: TWasmInstrOperandType): Boolean;
  930. var
  931. i64 : Int64;
  932. u64 : UInt64;
  933. err : Integer;
  934. begin
  935. Result := Assigned(sc);
  936. if not Result then Exit;
  937. if (castType = otText) or (sc.token <> weNumber) then begin
  938. OperandSetText(op, sc.resText);
  939. Exit;
  940. end;
  941. case sc.numformat of
  942. wnfInteger, wnfHex: begin
  943. val(sc.resText, i64, err);
  944. if err = 0 then
  945. Result := Int64ToOperand(i64, op, castType)
  946. else begin
  947. Val(sc.resText, u64, err);
  948. Result := err = 0;
  949. if Result then
  950. Result := UInt64ToOperand(u64, op, castType);
  951. end;
  952. end;
  953. wnfFloat, wnfFloatHex: begin // 0.000
  954. Result := castType in [otNotused, otFloat32, otFloat64];
  955. if not Result then Exit;
  956. if castType = otFloat32 then begin
  957. op.tp := otFloat32;
  958. TextToFloat32(sc.resText, op.f32);
  959. end else begin
  960. op.tp := otFloat64;
  961. TextToFloat64(sc.resText, op.f64);
  962. end;
  963. end;
  964. end;
  965. end;
  966. end.