agwat.pas 28 KB

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