agwat.pas 30 KB

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