nwasmcon.pas 17 KB

123456789101112131415161718192021222324252627282930313233343536373839404142434445464748495051525354555657585960616263646566676869707172737475767778798081828384858687888990919293949596979899100101102103104105106107108109110111112113114115116117118119120121122123124125126127128129130131132133134135136137138139140141142143144145146147148149150151152153154155156157158159160161162163164165166167168169170171172173174175176177178179180181182183184185186187188189190191192193194195196197198199200201202203204205206207208209210211212213214215216217218219220221222223224225226227228229230231232233234235236237238239240241242243244245246247248249250251252253254255256257258259260261262263264265266267268269270271272273274275276277278279280281282283284285286287288289290291292293294295296297298299300301302303304305306307308309310311312313314315316317318319320321322323324325326327328329330331332333334335336337338339340341342343344345346347348349350351352353354355356357358359360361362363364365366367368369370371372373374375376377378379380381382383384385386387388389390391392393394395396397398399400401402403404405406407408409410411412413414415416417418419420421422423424425426427428429430431432433434435436437438439440441442443444445446447448449450451452453454455456457458459460461462463464465466467468469470471472473474475476477478479480481482483484485486487488489490491492493494495496
  1. {
  2. Copyright (c) 1998-2011 by Florian Klaempfl and Jonas Maebe
  3. Generate assembler for constant nodes for the WebAssembly
  4. This program is free software; you can redistribute it and/or modify
  5. it under the terms of the GNU General Public License as published by
  6. the Free Software Foundation; either version 2 of the License, or
  7. (at your option) any later version.
  8. This program is distributed in the hope that it will be useful,
  9. but WITHOUT ANY WARRANTY; without even the implied warranty of
  10. MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
  11. GNU General Public License for more details.
  12. You should have received a copy of the GNU General Public License
  13. along with this program; if not, write to the Free Software
  14. Foundation, Inc., 675 Mass Ave, Cambridge, MA 02139, USA.
  15. ****************************************************************************
  16. }
  17. unit nwasmcon;
  18. {$i fpcdefs.inc}
  19. interface
  20. uses
  21. globtype,aasmbase,
  22. symtype,
  23. node,ncal,ncon,ncgcon;
  24. type
  25. (*
  26. tjvmordconstnode = class(tcgordconstnode)
  27. { normally, we convert the enum constant into a load of the
  28. appropriate enum class field in pass_1. In some cases (array index),
  29. we want to keep it as an enum constant however }
  30. enumconstok: boolean;
  31. function pass_1: tnode; override;
  32. function docompare(p: tnode): boolean; override;
  33. function dogetcopy: tnode; override;
  34. end;
  35. *)
  36. twasmrealconstnode = class(tcgrealconstnode)
  37. procedure pass_generate_code;override;
  38. end;
  39. (*tjvmstringconstnode = class(tstringconstnode)
  40. function pass_1: tnode; override;
  41. procedure pass_generate_code;override;
  42. class function emptydynstrnil: boolean; override;
  43. end;
  44. *)
  45. (*
  46. tjvmsetconsttype = (
  47. { create symbol for the set constant; the symbol will be initialized
  48. in the class constructor/unit init code (default) }
  49. sct_constsymbol,
  50. { normally, we convert the set constant into a constructor/factory
  51. method to create a set instance. In some cases (simple "in"
  52. expressions, adding an element to an empty set, ...) we want to
  53. keep the set constant instead }
  54. sct_notransform,
  55. { actually construct a JUBitSet/JUEnumSet that contains the set value
  56. (for initializing the sets contstants) }
  57. sct_construct
  58. );
  59. tjvmsetconstnode = class(tcgsetconstnode)
  60. setconsttype: tjvmsetconsttype;
  61. function pass_1: tnode; override;
  62. procedure pass_generate_code; override;
  63. constructor create(s : pconstset;def:tdef);override;
  64. function docompare(p: tnode): boolean; override;
  65. function dogetcopy: tnode; override;
  66. protected
  67. function emitvarsetconst: tasmsymbol; override;
  68. { in case the set has only a single run of consecutive elements,
  69. this function will return its starting index and length }
  70. function find_single_elements_run(from: longint; out start, len: longint): boolean;
  71. function buildbitset: tnode;
  72. function buildenumset(const eledef: tdef): tnode;
  73. function buildsetfromstring(const helpername: string; otherparas: tcallparanode): tnode;
  74. end;
  75. *)
  76. implementation
  77. uses
  78. globals,cutils,widestr,verbose,constexp,fmodule,
  79. symdef,symsym,symcpu,symtable,symconst,
  80. aasmdata,aasmcpu,defutil,
  81. nutils,ncnv,nld,nmem,pass_1,
  82. cgbase,hlcgobj,hlcgcpu,cgutils,cpubase
  83. ;
  84. {*****************************************************************************
  85. TJVMORDCONSTNODE
  86. *****************************************************************************}
  87. (*
  88. function tjvmordconstnode.pass_1: tnode;
  89. var
  90. basedef: tcpuenumdef;
  91. sym: tenumsym;
  92. classfield: tsym;
  93. begin
  94. if (resultdef.typ<>enumdef) or
  95. enumconstok then
  96. begin
  97. result:=inherited pass_1;
  98. exit;
  99. end;
  100. { convert into JVM class instance }
  101. { a) find the enumsym corresponding to the value (may not exist in case
  102. of an explicit typecast of an integer -> error) }
  103. sym:=nil;
  104. sym:=tenumsym(tenumdef(resultdef).int2enumsym(int64(value)));
  105. if not assigned(sym) then
  106. begin
  107. Message(parser_e_range_check_error);
  108. result:=nil;
  109. exit;
  110. end;
  111. { b) find the corresponding class field }
  112. basedef:=tcpuenumdef(tenumdef(resultdef).getbasedef);
  113. classfield:=search_struct_member(basedef.classdef,sym.name);
  114. { c) create loadnode of the field }
  115. result:=nil;
  116. if not handle_staticfield_access(classfield,result) then
  117. internalerror(2011062606);
  118. end;
  119. function tjvmordconstnode.docompare(p: tnode): boolean;
  120. begin
  121. result:=inherited docompare(p);
  122. if result then
  123. result:=(enumconstok=tjvmordconstnode(p).enumconstok);
  124. end;
  125. function tjvmordconstnode.dogetcopy: tnode;
  126. begin
  127. result:=inherited dogetcopy;
  128. tjvmordconstnode(result).enumconstok:=enumconstok;
  129. end;
  130. *)
  131. {*****************************************************************************
  132. TJVMREALCONSTNODE
  133. *****************************************************************************}
  134. procedure twasmrealconstnode.pass_generate_code;
  135. begin
  136. location_reset(location,LOC_FPUREGISTER,def_cgsize(resultdef));
  137. location.register:=hlcg.getfpuregister(current_asmdata.CurrAsmList,resultdef);
  138. thlcgwasm(hlcg).a_loadfpu_const_stack(current_asmdata.CurrAsmList,resultdef,value_real);
  139. //thlwasm(hlcg).a_load_stack_reg(current_asmdata.CurrAsmList,resultdef,location.register);
  140. end;
  141. { tcgstringconstnode }
  142. (*
  143. function tjvmstringconstnode.pass_1: tnode;
  144. var
  145. strclass: tobjectdef;
  146. pw: pcompilerwidestring;
  147. paras: tcallparanode;
  148. wasansi: boolean;
  149. begin
  150. { all Java strings are utf-16. However, there is no way to
  151. declare a constant array of bytes (or any other type), those
  152. have to be constructed by declaring a final field and then
  153. initialising them in the class constructor element per
  154. element. We therefore put the straight ASCII values into
  155. the UTF-16 string, and then at run time extract those and
  156. store them in an Ansistring/AnsiChar array }
  157. result:=inherited pass_1;
  158. if assigned(result) or
  159. (cst_type in [cst_unicodestring,cst_widestring]) then
  160. exit;
  161. { convert the constant into a widestring representation without any
  162. code page conversion }
  163. initwidestring(pw);
  164. ascii2unicode(value_str,len,current_settings.sourcecodepage,pw,false);
  165. ansistringdispose(value_str,len);
  166. pcompilerwidestring(value_str):=pw;
  167. { and now add a node to convert the data into ansistring format at
  168. run time }
  169. wasansi:=false;
  170. case cst_type of
  171. cst_ansistring:
  172. begin
  173. if len=0 then
  174. begin
  175. { we have to use nil rather than an empty string, because an
  176. empty string has a code page and this messes up the code
  177. page selection logic in the RTL }
  178. exit;
  179. end;
  180. strclass:=tobjectdef(search_system_type('ANSISTRINGCLASS').typedef);
  181. wasansi:=true;
  182. end;
  183. cst_shortstring:
  184. strclass:=tobjectdef(search_system_type('SHORTSTRINGCLASS').typedef);
  185. cst_conststring:
  186. { used for array of char }
  187. strclass:=tobjectdef(search_system_type('ANSICHARARRAYCLASS').typedef);
  188. else
  189. internalerror(2011052401);
  190. end;
  191. cst_type:=cst_unicodestring;
  192. paras:=ccallparanode.create(self.getcopy,nil);
  193. if wasansi then
  194. paras:=ccallparanode.create(
  195. genintconstnode(tstringdef(resultdef).encoding),paras);
  196. { since self will be freed, have to make a copy }
  197. result:=ccallnode.createinternmethodres(
  198. cloadvmtaddrnode.create(ctypenode.create(strclass)),
  199. 'CREATEFROMLITERALSTRINGBYTES',paras,resultdef);
  200. end;
  201. procedure tjvmstringconstnode.pass_generate_code;
  202. begin
  203. location_reset(location,LOC_REGISTER,def_cgsize(resultdef));
  204. location.register:=hlcg.getaddressregister(current_asmdata.CurrAsmList,resultdef);
  205. case cst_type of
  206. cst_ansistring:
  207. begin
  208. if len<>0 then
  209. internalerror(2012052604);
  210. hlcg.a_load_const_reg(current_asmdata.CurrAsmList,resultdef,0,location.register);
  211. { done }
  212. exit;
  213. end;
  214. cst_shortstring,
  215. cst_conststring:
  216. internalerror(2012052601);
  217. cst_unicodestring,
  218. cst_widestring:
  219. current_asmdata.CurrAsmList.concat(taicpu.op_wstring(a_ldc,pcompilerwidestring(value_str)));
  220. else
  221. internalerror(2012052602);
  222. end;
  223. thlcgjvm(hlcg).incstack(current_asmdata.CurrAsmList,1);
  224. thlcgjvm(hlcg).a_load_stack_reg(current_asmdata.CurrAsmList,resultdef,location.register);
  225. end;
  226. class function tjvmstringconstnode.emptydynstrnil: boolean;
  227. begin
  228. result:=false;
  229. end;
  230. {*****************************************************************************
  231. TJVMSETCONSTNODE
  232. *****************************************************************************}
  233. function tjvmsetconstnode.buildsetfromstring(const helpername: string; otherparas: tcallparanode): tnode;
  234. var
  235. pw: pcompilerwidestring;
  236. wc: tcompilerwidechar;
  237. i, j, bit, nulls: longint;
  238. begin
  239. initwidestring(pw);
  240. nulls:=0;
  241. for i:=0 to 15 do
  242. begin
  243. wc:=0;
  244. for bit:=0 to 15 do
  245. if (i*16+bit) in value_set^ then
  246. wc:=wc or (1 shl (15-bit));
  247. { don't add trailing zeroes }
  248. if wc=0 then
  249. inc(nulls)
  250. else
  251. begin
  252. for j:=1 to nulls do
  253. concatwidestringchar(pw,0);
  254. nulls:=0;
  255. concatwidestringchar(pw,wc);
  256. end;
  257. end;
  258. result:=ccallnode.createintern(helpername,
  259. ccallparanode.create(cstringconstnode.createunistr(pw),otherparas));
  260. donewidestring(pw);
  261. end;
  262. function tjvmsetconstnode.buildbitset: tnode;
  263. var
  264. mp: tnode;
  265. begin
  266. if value_set^=[] then
  267. begin
  268. mp:=cloadvmtaddrnode.create(ctypenode.create(java_jubitset));
  269. result:=ccallnode.createinternmethod(mp,'CREATE',nil);
  270. exit;
  271. end;
  272. result:=buildsetfromstring('fpc_bitset_from_string',nil);
  273. end;
  274. function tjvmsetconstnode.buildenumset(const eledef: tdef): tnode;
  275. var
  276. stopnode: tnode;
  277. startnode: tnode;
  278. mp: tnode;
  279. len: longint;
  280. start: longint;
  281. enumele: tnode;
  282. paras: tcallparanode;
  283. hassinglerun: boolean;
  284. begin
  285. hassinglerun:=find_single_elements_run(0, start, len);
  286. if hassinglerun then
  287. begin
  288. mp:=cloadvmtaddrnode.create(ctypenode.create(java_juenumset));
  289. if len=0 then
  290. begin
  291. enumele:=cloadvmtaddrnode.create(ctypenode.create(tcpuenumdef(tenumdef(eledef).getbasedef).classdef));
  292. inserttypeconv_explicit(enumele,search_system_type('JLCLASS').typedef);
  293. paras:=ccallparanode.create(enumele,nil);
  294. result:=ccallnode.createinternmethod(mp,'NONEOF',paras)
  295. end
  296. else
  297. begin
  298. startnode:=cordconstnode.create(start,eledef,false);
  299. { immediately firstpass so the enum gets translated into a JLEnum
  300. instance }
  301. firstpass(startnode);
  302. if len=1 then
  303. result:=ccallnode.createinternmethod(mp,'OF',ccallparanode.create(startnode,nil))
  304. else
  305. begin
  306. stopnode:=cordconstnode.create(start+len-1,eledef,false);
  307. firstpass(stopnode);
  308. result:=ccallnode.createinternmethod(mp,'RANGE',ccallparanode.create(stopnode,ccallparanode.create(startnode,nil)));
  309. end
  310. end
  311. end
  312. else
  313. begin
  314. enumele:=cordconstnode.create(tenumsym(tenumdef(eledef).symtable.symlist[0]).value,eledef,false);
  315. firstpass(enumele);
  316. paras:=ccallparanode.create(enumele,nil);
  317. result:=buildsetfromstring('fpc_enumset_from_string',paras);
  318. end;
  319. end;
  320. function tjvmsetconstnode.pass_1: tnode;
  321. var
  322. eledef: tdef;
  323. begin
  324. { we want set constants to be global, so we can reuse them. However,
  325. if the set's elementdef is local, we can't do that since a global
  326. symbol cannot have a local definition (the compiler will crash when
  327. loading the ppu file afterwards) }
  328. if tsetdef(resultdef).elementdef.owner.symtabletype=localsymtable then
  329. setconsttype:=sct_construct;
  330. result:=nil;
  331. case setconsttype of
  332. (*
  333. sct_constsymbol:
  334. begin
  335. { normally a codegen pass routine, but we have to insert a typed
  336. const in case the set constant does not exist yet, and that
  337. should happen in pass_1 (especially since it involves creating
  338. new nodes, which may even have to be tacked on to this code in
  339. case it's the unit initialization code) }
  340. handlevarsetconst;
  341. { no smallsets }
  342. expectloc:=LOC_CREFERENCE;
  343. end;
  344. *)
  345. sct_notransform:
  346. begin
  347. result:=inherited pass_1;
  348. { no smallsets }
  349. expectloc:=LOC_CREFERENCE;
  350. end;
  351. sct_constsymbol,
  352. sct_construct:
  353. begin
  354. eledef:=tsetdef(resultdef).elementdef;
  355. { empty sets don't have an element type, so we don't know whether we
  356. have to constructor a bitset or enumset (and of which type) }
  357. if not assigned(eledef) then
  358. internalerror(2011070202);
  359. if eledef.typ=enumdef then
  360. begin
  361. result:=buildenumset(eledef);
  362. end
  363. else
  364. begin
  365. result:=buildbitset;
  366. end;
  367. inserttypeconv_explicit(result,cpointerdef.getreusable(resultdef));
  368. result:=cderefnode.create(result);
  369. end;
  370. end;
  371. end;
  372. procedure tjvmsetconstnode.pass_generate_code;
  373. begin
  374. case setconsttype of
  375. sct_constsymbol:
  376. begin
  377. { all sets are varsets for the JVM target, no setbase differences }
  378. handlevarsetconst;
  379. end;
  380. else
  381. { must be handled in pass_1 or otherwise transformed }
  382. internalerror(2011070201)
  383. end;
  384. end;
  385. constructor tjvmsetconstnode.create(s: pconstset; def: tdef);
  386. begin
  387. inherited create(s, def);
  388. setconsttype:=sct_constsymbol;
  389. end;
  390. function tjvmsetconstnode.docompare(p: tnode): boolean;
  391. begin
  392. result:=
  393. inherited docompare(p) and
  394. (setconsttype=tjvmsetconstnode(p).setconsttype);
  395. end;
  396. function tjvmsetconstnode.dogetcopy: tnode;
  397. begin
  398. result:=inherited dogetcopy;
  399. tjvmsetconstnode(result).setconsttype:=setconsttype;
  400. end;
  401. function tjvmsetconstnode.emitvarsetconst: tasmsymbol;
  402. var
  403. csym: tconstsym;
  404. ssym: tstaticvarsym;
  405. ps: pnormalset;
  406. begin
  407. { add a read-only typed constant }
  408. new(ps);
  409. ps^:=value_set^;
  410. csym:=cconstsym.create_ptr('_$setconst'+tostr(current_module.symlist.count),constset,ps,resultdef);
  411. csym.visibility:=vis_private;
  412. include(csym.symoptions,sp_internal);
  413. current_module.localsymtable.insert(csym);
  414. { generate assignment of the constant to the typed constant symbol }
  415. ssym:=jvm_add_typed_const_initializer(csym);
  416. result:=current_asmdata.RefAsmSymbol(ssym.mangledname,AT_DATA);
  417. end;
  418. function tjvmsetconstnode.find_single_elements_run(from: longint; out start, len: longint): boolean;
  419. var
  420. i: longint;
  421. begin
  422. i:=from;
  423. result:=true;
  424. { find first element in set }
  425. while (i<=255) and
  426. not(i in value_set^) do
  427. inc(i);
  428. start:=i;
  429. { go to end of the run }
  430. while (i<=255) and
  431. (i in value_set^) do
  432. inc(i);
  433. len:=i-start;
  434. { rest must be unset }
  435. while (i<=255) and
  436. not(i in value_set^) do
  437. inc(i);
  438. if i<>256 then
  439. result:=false;
  440. end;
  441. *)
  442. begin
  443. //cordconstnode:=tjvmordconstnode;
  444. crealconstnode:=twasmrealconstnode;
  445. //cstringconstnode:=tjvmstringconstnode;
  446. //csetconstnode:=tjvmsetconstnode;
  447. end.