agwat.pas 31 KB

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