agwat.pas 34 KB

12345678910111213141516171819202122232425262728293031323334353637383940414243444546474849505152535455565758596061626364656667686970717273747576777879808182838485868788899091929394959697989910010110210310410510610710810911011111211311411511611711811912012112212312412512612712812913013113213313413513613713813914014114214314414514614714814915015115215315415515615715815916016116216316416516616716816917017117217317417517617717817918018118218318418518618718818919019119219319419519619719819920020120220320420520620720820921021121221321421521621721821922022122222322422522622722822923023123223323423523623723823924024124224324424524624724824925025125225325425525625725825926026126226326426526626726826927027127227327427527627727827928028128228328428528628728828929029129229329429529629729829930030130230330430530630730830931031131231331431531631731831932032132232332432532632732832933033133233333433533633733833934034134234334434534634734834935035135235335435535635735835936036136236336436536636736836937037137237337437537637737837938038138238338438538638738838939039139239339439539639739839940040140240340440540640740840941041141241341441541641741841942042142242342442542642742842943043143243343443543643743843944044144244344444544644744844945045145245345445545645745845946046146246346446546646746846947047147247347447547647747847948048148248348448548648748848949049149249349449549649749849950050150250350450550650750850951051151251351451551651751851952052152252352452552652752852953053153253353453553653753853954054154254354454554654754854955055155255355455555655755855956056156256356456556656756856957057157257357457557657757857958058158258358458558658758858959059159259359459559659759859960060160260360460560660760860961061161261361461561661761861962062162262362462562662762862963063163263363463563663763863964064164264364464564664764864965065165265365465565665765865966066166266366466566666766866967067167267367467567667767867968068168268368468568668768868969069169269369469569669769869970070170270370470570670770870971071171271371471571671771871972072172272372472572672772872973073173273373473573673773873974074174274374474574674774874975075175275375475575675775875976076176276376476576676776876977077177277377477577677777877978078178278378478578678778878979079179279379479579679779879980080180280380480580680780880981081181281381481581681781881982082182282382482582682782882983083183283383483583683783883984084184284384484584684784884985085185285385485585685785885986086186286386486586686786886987087187287387487587687787887988088188288388488588688788888989089189289389489589689789889990090190290390490590690790890991091191291391491591691791891992092192292392492592692792892993093193293393493593693793893994094194294394494594694794894995095195295395495595695795895996096196296396496596696796896997097197297397497597697797897998098198298398498598698798898999099199299399499599699799899910001001100210031004100510061007100810091010101110121013101410151016101710181019102010211022102310241025102610271028102910301031103210331034103510361037103810391040104110421043104410451046104710481049105010511052105310541055105610571058105910601061106210631064106510661067106810691070107110721073
  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. cnt: integer;
  729. begin
  730. if not Assigned(p) then Exit;
  731. hp:=tai(p.First);
  732. if not Assigned(hp) then Exit;
  733. cnt := 0;
  734. while Assigned(hp) do begin
  735. case hp.typ of
  736. ait_importexport:
  737. inc(cnt);
  738. end;
  739. hp := tai_impexp(hp.Next);
  740. end;
  741. // writting out table, so wat2wasm can create reallocation symbols
  742. writer.AsmWrite(#9'(table ');
  743. writer.AsmWrite(tostr(cnt));
  744. writer.AsmWrite(' anyfunc)');
  745. writer.AsmWriteLn(#9'(elem 0 (i32.const 0) ');
  746. hp:=tai(p.First);
  747. while Assigned(hp) do begin
  748. case hp.typ of
  749. ait_importexport:
  750. begin
  751. x:=tai_impexp(hp);
  752. writer.AsmWrite(#9#9);
  753. writer.AsmWriteLn(GetWasmName(x.intname));
  754. end;
  755. end;
  756. hp := tai_impexp(hp.Next);
  757. end;
  758. writer.AsmWriteLn(#9') ');
  759. // writing export sections
  760. hp:=tai(p.First);
  761. while Assigned(hp) do begin
  762. case hp.typ of
  763. ait_importexport:
  764. begin
  765. x:=tai_impexp(hp);
  766. writer.AsmWrite(#9#9'(export "');
  767. writer.AsmWrite(x.extname);
  768. writer.AsmWrite('" (');
  769. case x.symstype of
  770. ie_Func: writer.AsmWrite('func');
  771. end;
  772. writer.AsmWrite(' ');
  773. writer.AsmWrite(GetWasmName(x.intname));
  774. writer.AsmWrite('))');
  775. writer.AsmLn;
  776. end;
  777. end;
  778. hp := tai_impexp(hp.Next);
  779. end;
  780. end;
  781. procedure TWabtTextAssembler.WriteUnitExports(st: TSymtable);
  782. var
  783. i : longint;
  784. def : tdef;
  785. begin
  786. if not assigned(st) then
  787. exit;
  788. writer.AsmWrite(#9'(table 0 funcref)');
  789. writer.AsmWriteLn(#9'(elem 0 (i32.const 0) ');
  790. for i:=0 to st.DefList.Count-1 do
  791. begin
  792. def:=tdef(st.DefList[i]);
  793. case def.typ of
  794. procdef :
  795. begin
  796. { methods are also in the static/globalsymtable of the unit
  797. -> make sure they are only written for the objectdefs that
  798. own them }
  799. if
  800. not (po_external in tprocdef(def).procoptions)
  801. then
  802. begin
  803. writer.AsmWrite(#9#9'$');
  804. writer.AsmWriteLn(tprocdef(def).mangledname);
  805. end;
  806. end;
  807. else
  808. ;
  809. end;
  810. end;
  811. writer.AsmWriteLn(#9') ');
  812. end;
  813. procedure TWabtTextAssembler.WriteImports;
  814. var
  815. i : integer;
  816. proc : tprocdef;
  817. sym : tsym;
  818. j : integer;
  819. psym : tprocsym;
  820. begin
  821. for i:=0 to current_module.deflist.Count-1 do begin
  822. if tdef(current_module.deflist[i]).typ = procdef then begin
  823. proc := tprocdef(current_module.deflist[i]);
  824. if (po_external in proc.procoptions) and assigned(proc.import_dll) then begin
  825. writer.AsmWrite(#9'(import "');
  826. writer.AsmWrite(proc.import_dll^);
  827. writer.AsmWrite('" "');
  828. writer.AsmWrite(proc.import_name^);
  829. writer.AsmWrite('" ');
  830. WriteProcDef(proc);
  831. writer.AsmWriteLn(')');
  832. end;
  833. end;
  834. end;
  835. // any symbol used from another unit must be fully declared in .wat
  836. // (reference by symbol name only doesn't work in Wasm)
  837. // the entire entry should declared (as imported) symbol.
  838. // The wasm-import name (name of exernal module and name)
  839. // is not important, as the linker would be using the symbol name
  840. // while linking.
  841. for i:=0 to current_module.unitimportsyms.Count-1 do begin
  842. sym := tsym(current_module.unitimportsyms[i]);
  843. if sym.typ = procsym then begin
  844. psym := tprocsym(sym);
  845. if psym.ProcdefList.Count>0 then
  846. proc := tprocdef(psym.ProcdefList[0])
  847. else
  848. proc := nil;
  849. if proc<>nil then begin
  850. {writer.AsmWrite(#9'(import "_fpc_use" "');
  851. writer.AsmWrite(proc.mangledname);
  852. writer.AsmWrite('" ');}
  853. WriteProcDef(proc, true);
  854. //writer.AsmWrite(')');
  855. end;
  856. end;
  857. end;
  858. end;
  859. procedure TWabtTextAssembler.WriteOutPChar(p: pchar; ofs, len: integer);
  860. var
  861. i : integer;
  862. s : string;
  863. ch : char;
  864. begin
  865. for i:=ofs to ofs+len-1 do begin
  866. ch:=p[i];
  867. case ch of
  868. #0, {This can't be done by range, because a bug in FPC}
  869. #1..#31,
  870. #128..#255 : s:='\'+tostr(ord(ch) shr 6)+tostr((ord(ch) and 63) shr 3)+tostr(ord(ch) and 7);
  871. '"' : s:='\"';
  872. '\' : s:='\\';
  873. else
  874. s:=ch;
  875. end;
  876. writer.AsmWrite(s);
  877. end;
  878. end;
  879. procedure TWabtTextAssembler.WriteConstString(lbl: tai_label;
  880. str: tai_string);
  881. var
  882. i : integer;
  883. ch : char;
  884. s : string;
  885. begin
  886. WriteOutGlobalInt32(lbl.labsym.Name, dataofs);
  887. // (data (get_global $test) "00")
  888. writer.AsmWrite(#9);
  889. writer.AsmWrite('(data (i32.const ');
  890. writer.AsmWrite(tostr(dataOfs));
  891. writer.AsmWrite(') "');
  892. // can be broken apart in multiple data() if needs to be
  893. WriteOutPChar(str.str, 0, str.len);
  894. writer.AsmWrite('"');
  895. writer.AsmWriteLn(') ;; value of '+ lbl.labsym.Name);
  896. inc(dataofs, str.len);
  897. end;
  898. procedure TWabtTextAssembler.WriteConstants(p: TAsmList);
  899. var
  900. i : integer;
  901. hp : tai;
  902. dt : tai;
  903. begin
  904. //WriteTree(p);
  905. hp:=tai(p.First);
  906. while Assigned(hp) do begin
  907. if (hp.typ = ait_label) then begin
  908. dt:=tai(hp.Next);
  909. if Assigned(dt) then begin
  910. case dt.typ of
  911. ait_string:
  912. begin
  913. WriteConstString(tai_label(hp), tai_string(dt));
  914. hp:=dt;
  915. end;
  916. end;
  917. end;
  918. end;
  919. hp:=tai(hp.Next);
  920. end;
  921. end;
  922. { TWatInstrWriter }
  923. constructor TWatInstrWriter.create(_owner: TWabtTextAssembler);
  924. begin
  925. inherited create;
  926. owner := _owner;
  927. end;
  928. procedure TWatInstrWriter.WriteInstruction(hp: tai);
  929. begin
  930. end;
  931. const
  932. as_wasm_wabt_info : tasminfo =
  933. (
  934. id : as_wasm_wabt;
  935. idtxt : 'Wabt';
  936. asmbin : 'wat2wasm';
  937. asmcmd : '-r --no-canonicalize-leb128s -o $OBJ $EXTRAOPT $ASM';
  938. supported_targets : [system_wasm_wasm32];
  939. flags : [];
  940. labelprefix : 'L';
  941. comment : ';; ';
  942. dollarsign : '$';
  943. );
  944. initialization
  945. RegisterAssembler(as_wasm_wabt_info, TWabtTextAssembler);
  946. end.