agwat.pas 33 KB

123456789101112131415161718192021222324252627282930313233343536373839404142434445464748495051525354555657585960616263646566676869707172737475767778798081828384858687888990919293949596979899100101102103104105106107108109110111112113114115116117118119120121122123124125126127128129130131132133134135136137138139140141142143144145146147148149150151152153154155156157158159160161162163164165166167168169170171172173174175176177178179180181182183184185186187188189190191192193194195196197198199200201202203204205206207208209210211212213214215216217218219220221222223224225226227228229230231232233234235236237238239240241242243244245246247248249250251252253254255256257258259260261262263264265266267268269270271272273274275276277278279280281282283284285286287288289290291292293294295296297298299300301302303304305306307308309310311312313314315316317318319320321322323324325326327328329330331332333334335336337338339340341342343344345346347348349350351352353354355356357358359360361362363364365366367368369370371372373374375376377378379380381382383384385386387388389390391392393394395396397398399400401402403404405406407408409410411412413414415416417418419420421422423424425426427428429430431432433434435436437438439440441442443444445446447448449450451452453454455456457458459460461462463464465466467468469470471472473474475476477478479480481482483484485486487488489490491492493494495496497498499500501502503504505506507508509510511512513514515516517518519520521522523524525526527528529530531532533534535536537538539540541542543544545546547548549550551552553554555556557558559560561562563564565566567568569570571572573574575576577578579580581582583584585586587588589590591592593594595596597598599600601602603604605606607608609610611612613614615616617618619620621622623624625626627628629630631632633634635636637638639640641642643644645646647648649650651652653654655656657658659660661662663664665666667668669670671672673674675676677678679680681682683684685686687688689690691692693694695696697698699700701702703704705706707708709710711712713714715716717718719720721722723724725726727728729730731732733734735736737738739740741742743744745746747748749750751752753754755756757758759760761762763764765766767768769770771772773774775776777778779780781782783784785786787788789790791792793794795796797798799800801802803804805806807808809810811812813814815816817818819820821822823824825826827828829830831832833834835836837838839840841842843844845846847848849850851852853854855856857858859860861862863864865866867868869870871872873874875876877878879880881882883884885886887888889890891892893894895896897898899900901902903904905906907908909910911912913914915916917918919920921922923924925926927928929930931932933934935936937938939940941942943944945946947948949950951952953954955956957958959960961962963964965966967968969970971972973974975976977978979980981982983984985986987988989990991992993994995996997998999100010011002100310041005100610071008100910101011101210131014101510161017101810191020102110221023102410251026102710281029103010311032103310341035103610371038103910401041104210431044104510461047104810491050105110521053105410551056105710581059
  1. {
  2. Copyright (c) 1998-2010 by the Free Pascal team
  3. This unit implements the WebAssembly text assembler
  4. The text is in S-expression format and should be consumable
  5. By either Binaryen or Wabt
  6. This program is free software; you can redistribute it and/or modify
  7. it under the terms of the GNU General Public License as published by
  8. the Free Software Foundation; either version 2 of the License, or
  9. (at your option) any later version.
  10. This program is distributed in the hope that it will be useful,
  11. but WITHOUT ANY WARRANTY; without even the implied warranty of
  12. MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
  13. GNU General Public License for more details.
  14. You should have received a copy of the GNU General Public License
  15. along with this program; if not, write to the Free Software
  16. Foundation, Inc., 675 Mass Ave, Cambridge, MA 02139, USA.
  17. ****************************************************************************
  18. }
  19. unit agwat;
  20. {$i fpcdefs.inc}
  21. interface
  22. uses
  23. cclasses,systems, cgutils,
  24. globtype,globals,
  25. symconst,symbase,symdef,symsym, symtype,symcpu,
  26. aasmbase,aasmtai,aasmdata,aasmcpu,
  27. assemble
  28. ,cutils
  29. ,cpubase, cgbase
  30. ,fmodule
  31. ,verbose, itcpuwasm
  32. ,cfileutl, tgcpu;
  33. type
  34. TWatInstrWriter = class;
  35. {# This is a derived class which is used to write
  36. Binaryen-styled assembler.
  37. }
  38. { TWatAssembler }
  39. { TWabtTextAssembler }
  40. TWabtTextAssembler=class(texternalassembler)
  41. protected
  42. dataofs : integer;
  43. procedure WriteOutGlobalInt32(const aname: string; val: integer; isconst: boolean = true);
  44. procedure WriteInstruction(hp: tai);
  45. procedure WriteProcDef(pd: tprocdef; stub: Boolean = false; stubUnreachable: Boolean = true);
  46. procedure WriteProcParams(pd: tprocdef);
  47. procedure WriteProcResult(pd: tprocdef);
  48. procedure WriteSymtableProcdefs(st: TSymtable);
  49. procedure WriteSymtableVarSyms(st: TSymtable);
  50. procedure WriteTempAlloc(p:TAsmList);
  51. procedure WriteExports(p: TAsmList);
  52. procedure WriteUnitExports(st: TSymtable);
  53. procedure WriteImports;
  54. procedure WriteOutPChar(p: pchar; ofs, len: integer);
  55. procedure WriteConstString(lbl: tai_label; str: tai_string);
  56. procedure WriteConstants(p: TAsmList);
  57. public
  58. constructor CreateWithWriter(info: pasminfo; wr: TExternalAssemblerOutputFile; freewriter, smart: boolean); override;
  59. procedure WriteTree(p:TAsmList);override;
  60. procedure WriteAsmList;override;
  61. Function DoAssemble:boolean;override;
  62. end;
  63. {# This is the base class for writing instructions.
  64. The WriteInstruction() method must be overridden
  65. to write a single instruction to the assembler
  66. file.
  67. }
  68. { TBinaryenInstrWriter }
  69. { TWatInstrWriter }
  70. TWatInstrWriter = class
  71. constructor create(_owner: TWabtTextAssembler);
  72. procedure WriteInstruction(hp : tai); virtual;
  73. protected
  74. owner: TWabtTextAssembler;
  75. end;
  76. implementation
  77. type
  78. t64bitarray = array[0..7] of byte;
  79. t32bitarray = array[0..3] of byte;
  80. const
  81. line_length = 70;
  82. {****************************************************************************}
  83. { Support routines }
  84. {****************************************************************************}
  85. function fixline(s:string):string;
  86. {
  87. return s with all leading and ending spaces and tabs removed
  88. }
  89. var
  90. i,j,k : integer;
  91. begin
  92. i:=length(s);
  93. while (i>0) and (s[i] in [#9,' ']) do
  94. dec(i);
  95. j:=1;
  96. while (j<i) and (s[j] in [#9,' ']) do
  97. inc(j);
  98. for k:=j to i do
  99. if s[k] in [#0..#31,#127..#255] then
  100. s[k]:='.';
  101. fixline:=Copy(s,j,i-j+1);
  102. end;
  103. function GetWasmName(const st: TSymStr): ansistring;
  104. begin
  105. Result := '$'+st;
  106. Replace(Result, '(','');
  107. Replace(Result, ')','');
  108. end;
  109. function getreferencestring(var ref : treference) : ansistring;
  110. begin
  111. if (ref.index<>NR_NO) then
  112. internalerror(2010122809);
  113. if assigned(ref.symbol) then
  114. begin
  115. // global symbol or field -> full type and name
  116. // ref.base can be <> NR_NO in case an instance field is loaded.
  117. // This register is not part of this instruction, it will have
  118. // been placed on the stack by the previous one.
  119. result:=GetWasmName(ref.symbol.name);
  120. end
  121. else
  122. begin
  123. // local symbol -> stack slot, stored in offset
  124. if ref.base<>NR_STACK_POINTER_REG then
  125. internalerror(2010122810);
  126. result:=tostr(ref.offset);
  127. end;
  128. end;
  129. function constsingle(s: single): ansistring;
  130. begin
  131. result:='0x'+hexstr(longint(t32bitarray(s)),8);
  132. end;
  133. function constdouble(d: double): ansistring;
  134. begin
  135. // force interpretation as double (since we write it out as an
  136. // integer, we never have to swap the endianess). We have to
  137. // include the sign separately because of the way Java parses
  138. // hex numbers (0x8000000000000000 is not a valid long)
  139. result:=hexstr(abs(int64(t64bitarray(d))),16);
  140. if int64(t64bitarray(d))<0 then
  141. result:='-'+result;
  142. result:='0dx'+result;
  143. end;
  144. function getopstr(const o:toper) : ansistring;
  145. var
  146. d: double;
  147. s: single;
  148. begin
  149. case o.typ of
  150. top_reg:
  151. // should have been translated into a memory location by the
  152. // register allocator)
  153. if (cs_no_regalloc in current_settings.globalswitches) then
  154. getopstr:=std_regname(o.reg)
  155. else
  156. internalerror(2010122803);
  157. top_const:
  158. str(o.val,result);
  159. top_ref:
  160. getopstr:=getreferencestring(o.ref^);
  161. top_single:
  162. begin
  163. result:=constsingle(o.sval);
  164. end;
  165. top_double:
  166. begin
  167. result:=constdouble(o.dval);
  168. end;
  169. {top_string:
  170. begin
  171. result:=constastr(o.pcval,o.pcvallen);
  172. end;
  173. top_wstring:
  174. begin
  175. result:=constwstr(o.pwstrval^.data,getlengthwidestring(o.pwstrval));
  176. end}
  177. else
  178. internalerror(2010122802);
  179. end;
  180. end;
  181. { TWabtTextAssembler }
  182. procedure TWabtTextAssembler.WriteOutGlobalInt32(const aname: string;
  183. val: integer; isconst: boolean);
  184. begin
  185. writer.AsmWrite(#9);
  186. writer.AsmWrite('(global $');
  187. writer.AsmWrite(aname);
  188. if not isconst then
  189. writer.AsmWrite(' (mut i32)')
  190. else
  191. writer.AsmWrite(' i32');
  192. writer.AsmWrite(' (i32.const ');
  193. writer.AsmWrite( tostr(val));
  194. writer.AsmWrite(')');
  195. writer.AsmWriteLn(')');
  196. end;
  197. procedure TWabtTextAssembler.WriteInstruction(hp: tai);
  198. var
  199. cpu : taicpu;
  200. i : integer;
  201. isprm : boolean;
  202. begin
  203. //writer.AsmWriteLn('instr');
  204. cpu := taicpu(hp);
  205. writer.AsmWrite(#9);
  206. writer.AsmWrite(wasm_op2str[cpu.opcode] );
  207. if (cpu.opcode = a_call_indirect) then begin
  208. // special wat2wasm syntax "call_indirect (type x)"
  209. writer.AsmWrite(#9);
  210. isprm := true;
  211. for i:=1 to length(cpu.typecode) do
  212. if cpu.typecode[i]=':' then
  213. isprm:=false
  214. else begin
  215. if isprm then writer.AsmWrite('(param ')
  216. else writer.AsmWrite('(result ');
  217. case cpu.typecode[i] of
  218. 'i': writer.AsmWrite('i32');
  219. 'I': writer.AsmWrite('i64');
  220. 'f': writer.AsmWrite('f32');
  221. 'F': writer.AsmWrite('f64');
  222. end;
  223. writer.AsmWrite(')');
  224. end;
  225. writer.AsmLn;
  226. exit;
  227. end;
  228. if (cpu.opcode = a_if) then
  229. writer.AsmWrite(' (result i32)') //todo: this is a hardcode, but shouldn't
  230. else
  231. cpu := taicpu(hp);
  232. if cpu.ops<>0 then
  233. begin
  234. for i:=0 to cpu.ops-1 do
  235. begin
  236. writer.AsmWrite(#9);
  237. if (cpu.opcode in AsmOp_LoadStore) and (cpu.oper[i]^.typ = top_ref) then
  238. writer.AsmWrite('offset='+tostr( cpu.oper[i]^.ref^.offset))
  239. else
  240. writer.AsmWrite(getopstr(cpu.oper[i]^));
  241. end;
  242. end;
  243. if (cpu.opcode = a_call_indirect) then
  244. // special wat2wasm syntax "call_indirect (type x)"
  245. writer.AsmWrite(')');
  246. writer.AsmLn;
  247. end;
  248. procedure TWabtTextAssembler.WriteProcDef(pd: tprocdef; stub: Boolean; stubUnreachable: Boolean);
  249. var
  250. i : integer;
  251. begin
  252. if not assigned(tcpuprocdef(pd).exprasmlist) and
  253. not(po_abstractmethod in pd.procoptions) and
  254. ((pd.proctypeoption in [potype_unitinit,potype_unitfinalize])) then
  255. begin
  256. exit;
  257. end;
  258. writer.AsmWrite('(func ');
  259. writer.AsmWrite( GetWasmName( pd.mangledname ));
  260. //procsym.RealName ));
  261. //writer.AsmWriteln(MethodDefinition(pd));
  262. {if jvmtypeneedssignature(pd) then
  263. begin
  264. writer.AsmWrite('.signature "');
  265. writer.AsmWrite(tcpuprocdef(pd).jvmmangledbasename(true));
  266. writer.AsmWriteln('"');
  267. end;}
  268. writer.AsmLn;
  269. WriteProcParams(pd);
  270. WriteProcResult(pd);
  271. if not stub then begin
  272. //WriteTempAlloc(tcpuprocdef(pd).exprasmlist);
  273. WriteTree(tcpuprocdef(pd).exprasmlist);
  274. end else begin
  275. if stubUnreachable then
  276. writer.AsmWriteLn(#9#9'unreachable');
  277. end;
  278. writer.AsmWriteln(#9')');
  279. writer.AsmLn;
  280. end;
  281. procedure TWabtTextAssembler.WriteProcParams(pd: tprocdef);
  282. var
  283. i : integer;
  284. prm : tcpuparavarsym;
  285. begin
  286. if not Assigned(pd) or
  287. not Assigned(pd.paras) or
  288. (pd.paras.Count=0) then
  289. exit;
  290. for i:=0 to pd.paras.Count-1 do
  291. begin
  292. prm := tcpuparavarsym(pd.paras[i]);
  293. writer.AsmWrite(#9'(param'#9);
  294. case prm.paraloc[callerside].Size of
  295. OS_8..OS_32, OS_S8..OS_S32:
  296. writer.AsmWrite('i32');
  297. OS_64, OS_S64:
  298. writer.AsmWrite('i64');
  299. OS_F32:
  300. writer.AsmWrite('f32');
  301. OS_F64:
  302. writer.AsmWrite('f64');
  303. else
  304. // unsupported calleeside parameter type
  305. Internalerror(2019093001);
  306. end;
  307. writer.AsmWrite(')');
  308. writer.AsmLn;
  309. end;
  310. end;
  311. procedure TWabtTextAssembler.WriteProcResult(pd: tprocdef);
  312. var
  313. bt : TWasmBasicType;
  314. begin
  315. if not assigned(pd) or
  316. not Assigned(pd.returndef) or
  317. (pd.returndef.size = 0)
  318. then exit;
  319. if not defToWasmBasic(pd.returndef, bt) then
  320. bt := wbt_i32;
  321. writer.AsmWrite(#9'(result'#9);
  322. case bt of
  323. wbt_i64: writer.AsmWrite('i64');
  324. wbt_f32: writer.AsmWrite('f32');
  325. wbt_f64: writer.AsmWrite('f64');
  326. else
  327. writer.AsmWrite('i32');
  328. end;
  329. writer.AsmWrite(')');
  330. writer.AsmLn;
  331. end;
  332. procedure TWabtTextAssembler.WriteTree(p: TAsmList);
  333. var
  334. ch : char;
  335. hp : tai;
  336. hp1 : tailineinfo;
  337. s : ansistring;
  338. i,pos : longint;
  339. InlineLevel : longint;
  340. do_line : boolean;
  341. const
  342. WasmBasicTypeStr : array [TWasmBasicType] of string = ('i32','i64','f32','f64');
  343. begin
  344. if not assigned(p) then
  345. exit;
  346. InlineLevel:=0;
  347. { lineinfo is only needed for al_procedures (PFV) }
  348. do_line:=(cs_asm_source in current_settings.globalswitches);
  349. hp:=tai(p.first);
  350. while assigned(hp) do
  351. begin
  352. prefetch(pointer(hp.next)^);
  353. if not(hp.typ in SkipLineInfo) then
  354. begin
  355. hp1 := hp as tailineinfo;
  356. current_filepos:=hp1.fileinfo;
  357. { no line info for inlined code }
  358. if do_line and (inlinelevel=0) then
  359. begin
  360. { load infile }
  361. if lastfileinfo.fileindex<>hp1.fileinfo.fileindex then
  362. begin
  363. infile:=current_module.sourcefiles.get_file(hp1.fileinfo.fileindex);
  364. if assigned(infile) then
  365. begin
  366. { open only if needed !! }
  367. if (cs_asm_source in current_settings.globalswitches) then
  368. infile.open;
  369. end;
  370. { avoid unnecessary reopens of the same file !! }
  371. lastfileinfo.fileindex:=hp1.fileinfo.fileindex;
  372. { be sure to change line !! }
  373. lastfileinfo.line:=-1;
  374. end;
  375. { write source }
  376. if (cs_asm_source in current_settings.globalswitches) and
  377. assigned(infile) then
  378. begin
  379. if (infile<>lastinfile) then
  380. begin
  381. writer.AsmWriteLn(asminfo^.comment+'['+infile.name+']');
  382. if assigned(lastinfile) then
  383. lastinfile.close;
  384. end;
  385. if (hp1.fileinfo.line<>lastfileinfo.line) and
  386. ((hp1.fileinfo.line<infile.maxlinebuf) or (InlineLevel>0)) then
  387. begin
  388. if (hp1.fileinfo.line<>0) and
  389. ((infile.linebuf^[hp1.fileinfo.line]>=0) or (InlineLevel>0)) then
  390. writer.AsmWriteLn(asminfo^.comment+'['+tostr(hp1.fileinfo.line)+'] '+
  391. fixline(infile.GetLineStr(hp1.fileinfo.line)));
  392. { set it to a negative value !
  393. to make that is has been read already !! PM }
  394. if (infile.linebuf^[hp1.fileinfo.line]>=0) then
  395. infile.linebuf^[hp1.fileinfo.line]:=-infile.linebuf^[hp1.fileinfo.line]-1;
  396. end;
  397. end;
  398. lastfileinfo:=hp1.fileinfo;
  399. lastinfile:=infile;
  400. end;
  401. end;
  402. case hp.typ of
  403. ait_comment :
  404. Begin
  405. writer.AsmWrite(asminfo^.comment);
  406. writer.AsmWritePChar(tai_comment(hp).str);
  407. writer.AsmLn;
  408. End;
  409. ait_regalloc :
  410. begin
  411. if (cs_asm_regalloc in current_settings.globalswitches) then
  412. begin
  413. writer.AsmWrite(#9+asminfo^.comment+'Register ');
  414. repeat
  415. writer.AsmWrite(std_regname(Tai_regalloc(hp).reg));
  416. if (hp.next=nil) or
  417. (tai(hp.next).typ<>ait_regalloc) or
  418. (tai_regalloc(hp.next).ratype<>tai_regalloc(hp).ratype) then
  419. break;
  420. hp:=tai(hp.next);
  421. writer.AsmWrite(',');
  422. until false;
  423. writer.AsmWrite(' ');
  424. writer.AsmWriteLn(regallocstr[tai_regalloc(hp).ratype]);
  425. end;
  426. end;
  427. ait_tempalloc :
  428. begin
  429. if (cs_asm_tempalloc in current_settings.globalswitches) then
  430. begin
  431. {$ifdef EXTDEBUG}
  432. if assigned(tai_tempalloc(hp).problem) then
  433. writer.AsmWriteLn(asminfo^.comment+'Temp '+tostr(tai_tempalloc(hp).temppos)+','+
  434. tostr(tai_tempalloc(hp).tempsize)+' '+tai_tempalloc(hp).problem^)
  435. else
  436. {$endif EXTDEBUG}
  437. end;
  438. end;
  439. ait_align :
  440. begin
  441. end;
  442. ait_section :
  443. begin
  444. end;
  445. ait_datablock :
  446. begin
  447. // internalerror(2010122701);
  448. end;
  449. ait_const:
  450. begin
  451. writer.AsmWriteln('constant');
  452. // internalerror(2010122702);
  453. end;
  454. ait_realconst :
  455. begin
  456. internalerror(2010122703);
  457. end;
  458. ait_string :
  459. begin
  460. pos:=0;
  461. for i:=1 to tai_string(hp).len do
  462. begin
  463. if pos=0 then
  464. begin
  465. writer.AsmWrite(#9'strconst: '#9'"');
  466. pos:=20;
  467. end;
  468. ch:=tai_string(hp).str[i-1];
  469. case ch of
  470. #0, {This can't be done by range, because a bug in FPC}
  471. #1..#31,
  472. #128..#255 : s:='\'+tostr(ord(ch) shr 6)+tostr((ord(ch) and 63) shr 3)+tostr(ord(ch) and 7);
  473. '"' : s:='\"';
  474. '\' : s:='\\';
  475. else
  476. s:=ch;
  477. end;
  478. writer.AsmWrite(s);
  479. inc(pos,length(s));
  480. if (pos>line_length) or (i=tai_string(hp).len) then
  481. begin
  482. writer.AsmWriteLn('"');
  483. pos:=0;
  484. end;
  485. end;
  486. end;
  487. ait_label :
  488. begin
  489. // don't write any labels. Wasm don't support it
  490. // labels are only allowed with the respective block structures
  491. end;
  492. ait_symbol :
  493. begin
  494. if (tai_symbol(hp).sym.typ = AT_FUNCTION) then
  495. begin
  496. end
  497. else
  498. begin
  499. writer.AsmWrite('data symbol: ');
  500. writer.AsmWriteln(tai_symbol(hp).sym.name);
  501. // internalerror(2010122706);
  502. end;
  503. end;
  504. ait_symbol_end :
  505. begin
  506. end;
  507. ait_instruction :
  508. begin
  509. WriteInstruction(hp);
  510. end;
  511. ait_force_line,
  512. ait_function_name : ;
  513. ait_cutobject :
  514. begin
  515. end;
  516. ait_marker :
  517. if tai_marker(hp).kind=mark_NoLineInfoStart then
  518. inc(InlineLevel)
  519. else if tai_marker(hp).kind=mark_NoLineInfoEnd then
  520. dec(InlineLevel);
  521. ait_directive :
  522. begin
  523. { the CPU directive is probably not supported by the JVM assembler,
  524. so it's commented out }
  525. //todo:
  526. writer.AsmWrite(asminfo^.comment);
  527. if tai_directive(hp).directive=asd_cpu then
  528. writer.AsmWrite(asminfo^.comment);
  529. writer.AsmWrite('.'+directivestr[tai_directive(hp).directive]+' ');
  530. if tai_directive(hp).name<>'' then
  531. writer.AsmWrite(tai_directive(hp).name);
  532. writer.AsmLn;
  533. end;
  534. ait_local :
  535. begin
  536. writer.AsmWrite(#9'(local ');
  537. if tai_local(hp).name <> '' then
  538. begin
  539. writer.AsmWrite(' ');
  540. writer.AsmWrite(tai_local(hp).name);
  541. writer.AsmWrite(' ');
  542. end;
  543. writer.AsmWrite( WasmBasicTypeStr[ tai_local(hp).bastyp ] );
  544. writer.AsmWrite(')');
  545. writer.AsmLn;
  546. end;
  547. else
  548. internalerror(2010122707);
  549. end;
  550. hp:=tai(hp.next);
  551. end;
  552. end;
  553. procedure TWabtTextAssembler.WriteAsmList;
  554. var
  555. hal : tasmlisttype;
  556. begin
  557. writer.MarkEmpty;
  558. writer.AsmWriteLn('(module ');
  559. writer.AsmWriteLn('(import "env" "memory" (memory 0)) ;;');
  560. WriteImports;
  561. WriteConstants(current_asmdata.asmlists[al_const]);
  562. WriteConstants(current_asmdata.asmlists[al_typedconsts]);
  563. //current_asmdata.CurrAsmList.labe
  564. { print all global variables }
  565. //current_asmdata.AsmSymbolDict
  566. writer.AsmWrite(#9'(global $__stack_top (mut i32) (i32.const ');
  567. writer.AsmWrite(tostr(globals.stacksize));
  568. writer.AsmWriteLn('))');
  569. WriteSymtableVarSyms(current_module.globalsymtable);
  570. WriteSymtableVarSyms(current_module.localsymtable);
  571. //writer.AsmLn;
  572. { print all global procedures/functions }
  573. WriteSymtableProcdefs(current_module.globalsymtable);
  574. WriteSymtableProcdefs(current_module.localsymtable);
  575. if current_module.islibrary then begin
  576. WriteExports(current_asmdata.asmlists[al_exports]);
  577. end else
  578. WriteUnitExports(current_module.globalsymtable);
  579. //WriteSymtableStructDefs(current_module.globalsymtable);
  580. //WriteSymtableStructDefs(current_module.localsymtable);
  581. //writer.decorator.LinePrefix := '';
  582. writer.AsmWriteLn(')');
  583. writer.AsmLn;
  584. end;
  585. function TWabtTextAssembler.DoAssemble: boolean;
  586. begin
  587. Result:=inherited DoAssemble;
  588. // the tool updates the symbol flags, so the linker
  589. // is capable of producing an executable
  590. if Result then
  591. RequotedExecuteProcess('wasmtool',' --symbolauto '+ObjFileName);
  592. end;
  593. constructor TWabtTextAssembler.CreateWithWriter(info: pasminfo;
  594. wr: TExternalAssemblerOutputFile; freewriter, smart: boolean);
  595. begin
  596. inherited CreateWithWriter(info, wr, freewriter, smart);
  597. end;
  598. procedure TWabtTextAssembler.WriteSymtableProcdefs(st: TSymtable);
  599. var
  600. i : longint;
  601. def : tdef;
  602. begin
  603. if not assigned(st) then
  604. exit;
  605. for i:=0 to st.DefList.Count-1 do
  606. begin
  607. def:=tdef(st.DefList[i]);
  608. case def.typ of
  609. procdef :
  610. begin
  611. { methods are also in the static/globalsymtable of the unit
  612. -> make sure they are only written for the objectdefs that
  613. own them }
  614. if (not(st.symtabletype in [staticsymtable,globalsymtable]) or
  615. (def.owner=st)) and
  616. not(df_generic in def.defoptions) and
  617. not (po_external in tprocdef(def).procoptions)
  618. then
  619. begin
  620. WriteProcDef(tprocdef(def));
  621. if assigned(tprocdef(def).localst) then
  622. WriteSymtableProcdefs(tprocdef(def).localst);
  623. end;
  624. end;
  625. else
  626. ;
  627. end;
  628. end;
  629. end;
  630. procedure TWabtTextAssembler.WriteSymtableVarSyms(st: TSymtable);
  631. var
  632. i : integer;
  633. sym : tsym;
  634. begin
  635. if not assigned(st) then
  636. exit;
  637. for i:=0 to st.SymList.Count-1 do
  638. begin
  639. sym:=tsym(st.SymList[i]);
  640. case sym.typ of
  641. staticvarsym:
  642. begin
  643. //WriteFieldSym(tabstractvarsym(sym));
  644. //if (sym.typ=staticvarsym) and
  645. // assigned(tstaticvarsym(sym).defaultconstsym) then
  646. // WriteFieldSym(tabstractvarsym(tstaticvarsym(sym).defaultconstsym));
  647. WriteOutGlobalInt32(tcpustaticvarsym(sym).mangledname, dataofs);
  648. inc(dataofs, tcpustaticvarsym(sym).getsize);
  649. end;
  650. fieldvarsym:
  651. begin
  652. writer.AsmWriteLn(';; field');
  653. end;
  654. constsym:
  655. begin
  656. //if (sym.typ=staticvarsym) and
  657. // assigned(tstaticvarsym(sym).defaultconstsym) then
  658. // WriteFieldSym(tabstractvarsym(tstaticvarsym(sym).defaultconstsym));
  659. //{ multiple procedures can have constants with the same name }
  660. //if not assigned(sym.owner.defowner) or
  661. // (tdef(sym.owner.defowner).typ<>procdef) then
  662. // WriteConstSym(tconstsym(sym));
  663. writer.AsmWriteLn(';; constant');
  664. end;
  665. {procsym:
  666. begin
  667. for j:=0 to tprocsym(sym).procdeflist.count-1 do
  668. if not(df_generic in tprocdef(tprocsym(sym).procdeflist[j]).defoptions) then
  669. WriteSymtableVarSyms(tprocdef(tprocsym(sym).procdeflist[j]).localst);
  670. end;}
  671. else
  672. ;
  673. end;
  674. end;
  675. end;
  676. procedure TWabtTextAssembler.WriteTempAlloc(p: TAsmList);
  677. var
  678. hp: tai;
  679. tmp: array of tai_tempalloc;
  680. mx : integer;
  681. i : integer;
  682. begin
  683. if not assigned(p) then
  684. exit;
  685. mx := -1;
  686. hp:=tai(p.first);
  687. while assigned(hp) do
  688. begin
  689. //prefetch(pointer(hp.next)^);
  690. if (hp.typ = ait_tempalloc) and
  691. tai_tempalloc(hp).allocation and
  692. (tai_tempalloc(hp).temppos >= mx) then
  693. mx := tai_tempalloc(hp).temppos+1;
  694. hp:=tai(hp.next);
  695. end;
  696. if (mx <= 0) then exit; // no temp allocations used
  697. SetLength(tmp, mx);
  698. hp:=tai(p.first);
  699. while assigned(hp) do
  700. begin
  701. //prefetch(pointer(hp.next)^);
  702. if (hp.typ = ait_tempalloc) and
  703. (tai_tempalloc(hp).allocation) and
  704. (tmp[ tai_tempalloc(hp).temppos ] = nil) then
  705. begin
  706. tmp[ tai_tempalloc(hp).temppos ] := tai_tempalloc(hp);
  707. dec(mx);
  708. if mx = 0 then break;
  709. end;
  710. hp:=tai(hp.next);
  711. end;
  712. for i:=0 to length(tmp)-1 do
  713. begin
  714. if tmp[i] = nil then continue;
  715. writer.AsmWrite(#9'(local'#9);
  716. if tmp[i].tempsize<=4 then writer.AsmWrite('i32')
  717. else if tmp[i].tempsize = 8 then writer.AsmWrite('i64');
  718. writer.AsmWrite(')');
  719. writer.AsmWrite(#9+asminfo^.comment+'Temp '+tostr(tmp[i].temppos)+','+
  720. tostr(tmp[i].tempsize)+' '+tempallocstr[tmp[i].allocation]);
  721. writer.AsmLn;
  722. end;
  723. end;
  724. procedure TWabtTextAssembler.WriteExports(p: TAsmList);
  725. var
  726. hp: tai;
  727. x: tai_impexp;
  728. begin
  729. if not Assigned(p) then Exit;
  730. hp:=tai(p.First);
  731. if not Assigned(hp) then Exit;
  732. // writting out table, so wat2wasm can create reallocation symbols
  733. writer.AsmWrite(#9'(table 0 anyfunc)');
  734. writer.AsmWriteLn(#9'(elem 0 (i32.const 0) ');
  735. while Assigned(hp) do begin
  736. case hp.typ of
  737. ait_importexport:
  738. begin
  739. x:=tai_impexp(hp);
  740. writer.AsmWrite(#9#9);
  741. writer.AsmWriteLn(GetWasmName(x.intname));
  742. end;
  743. end;
  744. hp := tai_impexp(hp.Next);
  745. end;
  746. writer.AsmWriteLn(#9') ');
  747. // writing export sections
  748. hp:=tai(p.First);
  749. while Assigned(hp) do begin
  750. case hp.typ of
  751. ait_importexport:
  752. begin
  753. x:=tai_impexp(hp);
  754. writer.AsmWrite(#9#9'(export "');
  755. writer.AsmWrite(x.extname);
  756. writer.AsmWrite('" (');
  757. case x.symstype of
  758. ie_Func: writer.AsmWrite('func');
  759. end;
  760. writer.AsmWrite(' ');
  761. writer.AsmWrite(GetWasmName(x.intname));
  762. writer.AsmWrite('))');
  763. writer.AsmLn;
  764. end;
  765. end;
  766. hp := tai_impexp(hp.Next);
  767. end;
  768. end;
  769. procedure TWabtTextAssembler.WriteUnitExports(st: TSymtable);
  770. var
  771. i : longint;
  772. def : tdef;
  773. begin
  774. if not assigned(st) then
  775. exit;
  776. writer.AsmWrite(#9'(table 0 funcref)');
  777. writer.AsmWriteLn(#9'(elem 0 (i32.const 0) ');
  778. for i:=0 to st.DefList.Count-1 do
  779. begin
  780. def:=tdef(st.DefList[i]);
  781. case def.typ of
  782. procdef :
  783. begin
  784. { methods are also in the static/globalsymtable of the unit
  785. -> make sure they are only written for the objectdefs that
  786. own them }
  787. if
  788. not (po_external in tprocdef(def).procoptions)
  789. then
  790. begin
  791. writer.AsmWrite(#9#9'$');
  792. writer.AsmWriteLn(tprocdef(def).mangledname);
  793. end;
  794. end;
  795. else
  796. ;
  797. end;
  798. end;
  799. writer.AsmWriteLn(#9') ');
  800. end;
  801. procedure TWabtTextAssembler.WriteImports;
  802. var
  803. i : integer;
  804. proc : tprocdef;
  805. sym : tsym;
  806. j : integer;
  807. psym : tprocsym;
  808. begin
  809. for i:=0 to current_module.deflist.Count-1 do begin
  810. if tdef(current_module.deflist[i]).typ = procdef then begin
  811. proc := tprocdef(current_module.deflist[i]);
  812. if (po_external in proc.procoptions) and assigned(proc.import_dll) then begin
  813. writer.AsmWrite(#9'(import "');
  814. writer.AsmWrite(proc.import_dll^);
  815. writer.AsmWrite('" "');
  816. writer.AsmWrite(proc.import_name^);
  817. writer.AsmWrite('" ');
  818. WriteProcDef(proc);
  819. writer.AsmWriteLn(')');
  820. end;
  821. end;
  822. end;
  823. // any symbol used from another unit must be fully declared in .wat
  824. // (reference by symbol name only doesn't work in Wasm)
  825. // the entire entry should declared (as imported) symbol.
  826. // The wasm-import name (name of exernal module and name)
  827. // is not important, as the linker would be using the symbol name
  828. // while linking.
  829. for i:=0 to current_module.unitimportsyms.Count-1 do begin
  830. sym := tsym(current_module.unitimportsyms[i]);
  831. if sym.typ = procsym then begin
  832. psym := tprocsym(sym);
  833. if psym.ProcdefList.Count>0 then
  834. proc := tprocdef(psym.ProcdefList[0])
  835. else
  836. proc := nil;
  837. if proc<>nil then begin
  838. {writer.AsmWrite(#9'(import "_fpc_use" "');
  839. writer.AsmWrite(proc.mangledname);
  840. writer.AsmWrite('" ');}
  841. WriteProcDef(proc, true);
  842. //writer.AsmWrite(')');
  843. end;
  844. end;
  845. end;
  846. end;
  847. procedure TWabtTextAssembler.WriteOutPChar(p: pchar; ofs, len: integer);
  848. var
  849. i : integer;
  850. s : string;
  851. ch : char;
  852. begin
  853. for i:=ofs to ofs+len-1 do begin
  854. ch:=p[i];
  855. case ch of
  856. #0, {This can't be done by range, because a bug in FPC}
  857. #1..#31,
  858. #128..#255 : s:='\'+tostr(ord(ch) shr 6)+tostr((ord(ch) and 63) shr 3)+tostr(ord(ch) and 7);
  859. '"' : s:='\"';
  860. '\' : s:='\\';
  861. else
  862. s:=ch;
  863. end;
  864. writer.AsmWrite(s);
  865. end;
  866. end;
  867. procedure TWabtTextAssembler.WriteConstString(lbl: tai_label;
  868. str: tai_string);
  869. var
  870. i : integer;
  871. ch : char;
  872. s : string;
  873. begin
  874. WriteOutGlobalInt32(lbl.labsym.Name, dataofs);
  875. // (data (get_global $test) "00")
  876. writer.AsmWrite(#9);
  877. writer.AsmWrite('(data (i32.const ');
  878. writer.AsmWrite(tostr(dataOfs));
  879. writer.AsmWrite(') "');
  880. // can be broken apart in multiple data() if needs to be
  881. WriteOutPChar(str.str, 0, str.len);
  882. writer.AsmWrite('"');
  883. writer.AsmWriteLn(') ;; value of '+ lbl.labsym.Name);
  884. inc(dataofs, str.len);
  885. end;
  886. procedure TWabtTextAssembler.WriteConstants(p: TAsmList);
  887. var
  888. i : integer;
  889. hp : tai;
  890. dt : tai;
  891. begin
  892. //WriteTree(p);
  893. hp:=tai(p.First);
  894. while Assigned(hp) do begin
  895. if (hp.typ = ait_label) then begin
  896. dt:=tai(hp.Next);
  897. if Assigned(dt) then begin
  898. case dt.typ of
  899. ait_string:
  900. begin
  901. WriteConstString(tai_label(hp), tai_string(dt));
  902. hp:=dt;
  903. end;
  904. end;
  905. end;
  906. end;
  907. hp:=tai(hp.Next);
  908. end;
  909. end;
  910. { TWatInstrWriter }
  911. constructor TWatInstrWriter.create(_owner: TWabtTextAssembler);
  912. begin
  913. inherited create;
  914. owner := _owner;
  915. end;
  916. procedure TWatInstrWriter.WriteInstruction(hp: tai);
  917. begin
  918. end;
  919. const
  920. as_wasm_wabt_info : tasminfo =
  921. (
  922. id : as_wasm_wabt;
  923. idtxt : 'Wabt';
  924. asmbin : 'wat2wasm';
  925. asmcmd : '-r --no-canonicalize-leb128s -o $OBJ $EXTRAOPT $ASM';
  926. supported_targets : [system_wasm_wasm32];
  927. flags : [];
  928. labelprefix : 'L';
  929. comment : ';; ';
  930. dollarsign : '$';
  931. );
  932. initialization
  933. RegisterAssembler(as_wasm_wabt_info, TWabtTextAssembler);
  934. end.