njvmcnv.pas 51 KB

1234567891011121314151617181920212223242526272829303132333435363738394041424344454647484950515253545556575859606162636465666768697071727374757677787980818283848586878889909192939495969798991001011021031041051061071081091101111121131141151161171181191201211221231241251261271281291301311321331341351361371381391401411421431441451461471481491501511521531541551561571581591601611621631641651661671681691701711721731741751761771781791801811821831841851861871881891901911921931941951961971981992002012022032042052062072082092102112122132142152162172182192202212222232242252262272282292302312322332342352362372382392402412422432442452462472482492502512522532542552562572582592602612622632642652662672682692702712722732742752762772782792802812822832842852862872882892902912922932942952962972982993003013023033043053063073083093103113123133143153163173183193203213223233243253263273283293303313323333343353363373383393403413423433443453463473483493503513523533543553563573583593603613623633643653663673683693703713723733743753763773783793803813823833843853863873883893903913923933943953963973983994004014024034044054064074084094104114124134144154164174184194204214224234244254264274284294304314324334344354364374384394404414424434444454464474484494504514524534544554564574584594604614624634644654664674684694704714724734744754764774784794804814824834844854864874884894904914924934944954964974984995005015025035045055065075085095105115125135145155165175185195205215225235245255265275285295305315325335345355365375385395405415425435445455465475485495505515525535545555565575585595605615625635645655665675685695705715725735745755765775785795805815825835845855865875885895905915925935945955965975985996006016026036046056066076086096106116126136146156166176186196206216226236246256266276286296306316326336346356366376386396406416426436446456466476486496506516526536546556566576586596606616626636646656666676686696706716726736746756766776786796806816826836846856866876886896906916926936946956966976986997007017027037047057067077087097107117127137147157167177187197207217227237247257267277287297307317327337347357367377387397407417427437447457467477487497507517527537547557567577587597607617627637647657667677687697707717727737747757767777787797807817827837847857867877887897907917927937947957967977987998008018028038048058068078088098108118128138148158168178188198208218228238248258268278288298308318328338348358368378388398408418428438448458468478488498508518528538548558568578588598608618628638648658668678688698708718728738748758768778788798808818828838848858868878888898908918928938948958968978988999009019029039049059069079089099109119129139149159169179189199209219229239249259269279289299309319329339349359369379389399409419429439449459469479489499509519529539549559569579589599609619629639649659669679689699709719729739749759769779789799809819829839849859869879889899909919929939949959969979989991000100110021003100410051006100710081009101010111012101310141015101610171018101910201021102210231024102510261027102810291030103110321033103410351036103710381039104010411042104310441045104610471048104910501051105210531054105510561057105810591060106110621063106410651066106710681069107010711072107310741075107610771078107910801081108210831084108510861087108810891090109110921093109410951096109710981099110011011102110311041105110611071108110911101111111211131114111511161117111811191120112111221123112411251126112711281129113011311132113311341135113611371138113911401141114211431144114511461147114811491150115111521153115411551156115711581159116011611162116311641165116611671168116911701171117211731174117511761177117811791180118111821183118411851186118711881189119011911192119311941195119611971198119912001201120212031204120512061207120812091210121112121213121412151216121712181219122012211222122312241225122612271228122912301231123212331234123512361237123812391240124112421243124412451246124712481249125012511252125312541255125612571258125912601261126212631264126512661267126812691270127112721273127412751276127712781279128012811282128312841285128612871288128912901291129212931294129512961297129812991300130113021303130413051306130713081309131013111312131313141315131613171318131913201321132213231324132513261327132813291330133113321333133413351336133713381339134013411342
  1. {
  2. Copyright (c) 1998-2011 by Florian Klaempfl and Jonas Maebe
  3. Generate JVM code for type converting nodes
  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. unit njvmcnv;
  17. {$i fpcdefs.inc}
  18. interface
  19. uses
  20. node,ncnv,ncgcnv,
  21. symtype;
  22. type
  23. tjvmtypeconvnode = class(tcgtypeconvnode)
  24. function typecheck_dynarray_to_openarray: tnode; override;
  25. function typecheck_string_to_chararray: tnode; override;
  26. function typecheck_char_to_string: tnode; override;
  27. function pass_1: tnode; override;
  28. function simplify(forinline: boolean): tnode; override;
  29. function first_set_to_set : tnode;override;
  30. procedure second_int_to_int;override;
  31. { procedure second_string_to_string;override; }
  32. { procedure second_cstring_to_pchar;override; }
  33. { procedure second_string_to_chararray;override; }
  34. { procedure second_array_to_pointer;override; }
  35. function first_int_to_real: tnode; override;
  36. { procedure second_pointer_to_array;override; }
  37. { procedure second_chararray_to_string;override; }
  38. { procedure second_char_to_string;override; }
  39. procedure second_int_to_real;override;
  40. { procedure second_real_to_real;override; }
  41. { procedure second_cord_to_pointer;override; }
  42. { procedure second_proc_to_procvar;override; }
  43. procedure second_bool_to_int;override;
  44. procedure second_int_to_bool;override;
  45. { procedure second_load_smallset;override; }
  46. { procedure second_ansistring_to_pchar;override; }
  47. { procedure second_pchar_to_string;override; }
  48. { procedure second_class_to_intf;override; }
  49. { procedure second_char_to_char;override; }
  50. procedure second_elem_to_openarray; override;
  51. function target_specific_explicit_typeconv: boolean; override;
  52. function target_specific_general_typeconv: boolean; override;
  53. protected
  54. function do_target_specific_explicit_typeconv(check_only: boolean; out resnode: tnode): boolean;
  55. end;
  56. tjvmasnode = class(tcgasnode)
  57. protected
  58. { to discern beween "obj as tclassref" and "tclassref(obj)" }
  59. classreftypecast: boolean;
  60. function target_specific_typecheck: boolean;override;
  61. public
  62. function pass_1 : tnode;override;
  63. procedure pass_generate_code; override;
  64. function dogetcopy: tnode; override;
  65. function docompare(p: tnode): boolean; override;
  66. constructor ppuload(t: tnodetype; ppufile: tcompilerppufile); override;
  67. procedure ppuwrite(ppufile: tcompilerppufile); override;
  68. end;
  69. tjvmisnode = class(tisnode)
  70. protected
  71. function target_specific_typecheck: boolean;override;
  72. public
  73. function pass_1 : tnode;override;
  74. procedure pass_generate_code; override;
  75. end;
  76. implementation
  77. uses
  78. verbose,globals,globtype,constexp,
  79. symconst,symdef,symsym,symtable,aasmbase,aasmdata,
  80. defutil,defcmp,jvmdef,
  81. cgbase,cgutils,pass_1,pass_2,
  82. nbas,ncon,ncal,ninl,nld,nmem,procinfo,
  83. nutils,
  84. cpubase,aasmcpu,
  85. tgobj,hlcgobj,hlcgcpu;
  86. {*****************************************************************************
  87. TypeCheckTypeConv
  88. *****************************************************************************}
  89. function isvalidprocvartypeconv(fromdef, todef: tdef): boolean;
  90. var
  91. tmethoddef: tdef;
  92. function docheck(def1,def2: tdef): boolean;
  93. begin
  94. result:=false;
  95. if def1.typ<>procvardef then
  96. exit;
  97. if tprocvardef(def1).is_addressonly then
  98. result:=
  99. (def2=java_jlobject) or
  100. (def2=voidpointertype)
  101. else
  102. begin
  103. if not assigned(tmethoddef) then
  104. tmethoddef:=search_system_type('TMETHOD').typedef;
  105. result:=
  106. (def2=methodpointertype) or
  107. (def2=tmethoddef);
  108. end;
  109. end;
  110. begin
  111. tmethoddef:=nil;
  112. result:=
  113. docheck(fromdef,todef) or
  114. docheck(todef,fromdef);
  115. end;
  116. function tjvmtypeconvnode.typecheck_dynarray_to_openarray: tnode;
  117. begin
  118. { all arrays are equal in Java }
  119. result:=nil;
  120. convtype:=tc_equal;
  121. end;
  122. function tjvmtypeconvnode.typecheck_string_to_chararray: tnode;
  123. var
  124. newblock: tblocknode;
  125. newstat: tstatementnode;
  126. restemp: ttempcreatenode;
  127. chartype: string;
  128. begin
  129. if (left.nodetype = stringconstn) and
  130. (tstringconstnode(left).cst_type=cst_conststring) then
  131. inserttypeconv(left,cunicodestringtype);
  132. { even constant strings have to be handled via a helper }
  133. if is_widechar(tarraydef(resultdef).elementdef) then
  134. chartype:='widechar'
  135. else
  136. chartype:='char';
  137. newblock:=internalstatements(newstat);
  138. restemp:=ctempcreatenode.create(resultdef,resultdef.size,tt_persistent,false);
  139. addstatement(newstat,restemp);
  140. addstatement(newstat,ccallnode.createintern('fpc_'+tstringdef(left.resultdef).stringtypname+
  141. '_to_'+chartype+'array',ccallparanode.create(left,ccallparanode.create(
  142. ctemprefnode.create(restemp),nil))));
  143. addstatement(newstat,ctempdeletenode.create_normal_temp(restemp));
  144. addstatement(newstat,ctemprefnode.create(restemp));
  145. result:=newblock;
  146. left:=nil;
  147. end;
  148. function tjvmtypeconvnode.typecheck_char_to_string: tnode;
  149. begin
  150. { make sure the generic code gets a stringdef }
  151. if self.totypedef=java_jlstring then
  152. begin
  153. inserttypeconv(left,cunicodestringtype);
  154. inserttypeconv(left,totypedef);
  155. result:=left;
  156. left:=nil;
  157. exit;
  158. end;
  159. result:=inherited;
  160. end;
  161. {*****************************************************************************
  162. FirstTypeConv
  163. *****************************************************************************}
  164. function tjvmtypeconvnode.first_int_to_real: tnode;
  165. begin
  166. if not is_64bitint(left.resultdef) then
  167. if is_signed(left.resultdef) or
  168. (left.resultdef.size<4) then
  169. inserttypeconv(left,s32inttype)
  170. else
  171. inserttypeconv(left,u32inttype);
  172. firstpass(left);
  173. result := nil;
  174. expectloc:=LOC_FPUREGISTER;
  175. end;
  176. function tjvmtypeconvnode.pass_1: tnode;
  177. begin
  178. if (nf_explicit in flags) then
  179. begin
  180. do_target_specific_explicit_typeconv(false,result);
  181. if assigned(result) then
  182. exit;
  183. end;
  184. result:=inherited pass_1;
  185. end;
  186. function tjvmtypeconvnode.simplify(forinline: boolean): tnode;
  187. begin
  188. result:=inherited simplify(forinline);
  189. if assigned(result) then
  190. exit;
  191. { string constants passed to java.lang.String must be converted to
  192. widestring }
  193. if ((is_conststringnode(left) and
  194. not(tstringconstnode(left).cst_type in [cst_unicodestring,cst_widestring])) or
  195. is_constcharnode(left)) and
  196. (maybe_find_real_class_definition(resultdef,false)=java_jlstring) then
  197. inserttypeconv(left,cunicodestringtype);
  198. end;
  199. function tjvmtypeconvnode.first_set_to_set: tnode;
  200. var
  201. setclassdef: tdef;
  202. helpername: string;
  203. begin
  204. result:=nil;
  205. if (left.nodetype=setconstn) then
  206. result:=inherited
  207. { on native targets, only the binary layout has to match. Here, both
  208. sets also have to be either of enums or ordinals, and in case of
  209. enums they have to be of the same base type }
  210. else if (tsetdef(left.resultdef).elementdef.typ=enumdef)=(tsetdef(resultdef).elementdef.typ=enumdef) and
  211. ((tsetdef(left.resultdef).elementdef.typ<>enumdef) or
  212. (tenumdef(tsetdef(left.resultdef).elementdef).getbasedef=tenumdef(tsetdef(resultdef).elementdef).getbasedef)) and
  213. (tsetdef(left.resultdef).setbase=tsetdef(resultdef).setbase) and
  214. (left.resultdef.size=resultdef.size) then
  215. begin
  216. result:=left;
  217. left:=nil;
  218. end
  219. else
  220. begin
  221. { 'deep' conversion }
  222. if tsetdef(resultdef).elementdef.typ<>enumdef then
  223. begin
  224. if tsetdef(left.resultdef).elementdef.typ<>enumdef then
  225. helpername:='fpc_bitset_to_bitset'
  226. else
  227. helpername:='fpc_enumset_to_bitset';
  228. result:=ccallnode.createintern(helpername,ccallparanode.create(
  229. genintconstnode(tsetdef(resultdef).setbase), ccallparanode.create(
  230. genintconstnode(tsetdef(left.resultdef).setbase),
  231. ccallparanode.create(left,nil))));
  232. end
  233. else
  234. begin
  235. if tsetdef(left.resultdef).elementdef.typ<>enumdef then
  236. begin
  237. helpername:='fpcBitSetToEnumSet';
  238. setclassdef:=java_jubitset;
  239. end
  240. else
  241. begin
  242. helpername:='fpcEnumSetToEnumSet';
  243. setclassdef:=java_juenumset;
  244. end;
  245. left:=caddrnode.create_internal(left);
  246. include(left.flags,nf_typedaddr);
  247. inserttypeconv_explicit(left,setclassdef);
  248. result:=ccallnode.createinternmethod(
  249. cloadvmtaddrnode.create(ctypenode.create(setclassdef)),
  250. helpername,ccallparanode.create(
  251. genintconstnode(tsetdef(resultdef).setbase), ccallparanode.create(
  252. genintconstnode(tsetdef(left.resultdef).setbase),
  253. ccallparanode.create(left,nil))));
  254. end;
  255. inserttypeconv_explicit(result,getpointerdef(resultdef));
  256. result:=cderefnode.create(result);
  257. { reused }
  258. left:=nil;
  259. end;
  260. end;
  261. {*****************************************************************************
  262. SecondTypeConv
  263. *****************************************************************************}
  264. procedure tjvmtypeconvnode.second_int_to_int;
  265. var
  266. ressize,
  267. leftsize : longint;
  268. begin
  269. { insert range check if not explicit conversion }
  270. if not(nf_explicit in flags) then
  271. hlcg.g_rangecheck(current_asmdata.CurrAsmList,left.location,left.resultdef,resultdef);
  272. { is the result size smaller? when typecasting from void
  273. we always reuse the current location, because there is
  274. nothing that we can load in a register }
  275. ressize:=resultdef.size;
  276. leftsize :=left.resultdef.size;
  277. if ((ressize<>leftsize) or
  278. ((location.loc in [LOC_REFERENCE,LOC_CREFERENCE]) and
  279. (location.reference.arrayreftype<>art_none) and
  280. (is_widechar(left.resultdef)<>is_widechar(resultdef))) or
  281. is_bitpacked_access(left)) and
  282. not is_void(left.resultdef) then
  283. begin
  284. location_copy(location,left.location);
  285. { reuse a loc_reference when the newsize is larger than
  286. than the original and 4 bytes, because all <= 4 byte loads will
  287. result in a stack slot that occupies 4 bytes.
  288. Except
  289. a) for arrays (they use different load instructions for
  290. differently sized data types) or symbols (idem)
  291. b) when going from 4 to 8 bytes, because these are different
  292. data types
  293. }
  294. if (location.loc in [LOC_REFERENCE,LOC_CREFERENCE]) and
  295. not assigned(location.reference.symbol) and
  296. (location.reference.arrayreftype=art_none) and
  297. (ressize>leftsize) and
  298. (ressize=4) then
  299. begin
  300. location.size:=def_cgsize(resultdef);
  301. { no adjustment of the offset even though Java is big endian,
  302. because the load instruction will remain the same }
  303. end
  304. else
  305. hlcg.location_force_reg(current_asmdata.CurrAsmList,location,left.resultdef,resultdef,false);
  306. end
  307. else
  308. begin
  309. if (ressize < sizeof(aint)) and
  310. (def_cgsize(left.resultdef)<>def_cgsize(resultdef)) then
  311. begin
  312. location_reset(location,LOC_REGISTER,def_cgsize(resultdef));
  313. location.register:=hlcg.getintregister(current_asmdata.CurrAsmList,resultdef);
  314. hlcg.a_load_loc_reg(current_asmdata.CurrAsmList,left.resultdef,resultdef,left.location,location.register);
  315. end
  316. else
  317. location_copy(location,left.location);
  318. end;
  319. end;
  320. procedure tjvmtypeconvnode.second_int_to_real;
  321. var
  322. srcsize, ressize: longint;
  323. procedure convertsignedstackloc;
  324. begin
  325. case srcsize of
  326. 4:
  327. case ressize of
  328. 4:
  329. current_asmdata.CurrAsmList.concat(taicpu.op_none(a_i2f));
  330. 8:
  331. begin
  332. current_asmdata.CurrAsmList.concat(taicpu.op_none(a_i2d));
  333. thlcgjvm(hlcg).incstack(current_asmdata.CurrAsmList,1);
  334. end;
  335. else
  336. internalerror(2011010601);
  337. end;
  338. 8:
  339. case ressize of
  340. 4:
  341. begin
  342. current_asmdata.CurrAsmList.concat(taicpu.op_none(a_l2f));
  343. thlcgjvm(hlcg).decstack(current_asmdata.CurrAsmList,1);
  344. end;
  345. 8:
  346. current_asmdata.CurrAsmList.concat(taicpu.op_none(a_l2d));
  347. else
  348. internalerror(2011010602);
  349. end;
  350. else
  351. internalerror(2011010603);
  352. end;
  353. end;
  354. var
  355. signeddef : tdef;
  356. l1 : tasmlabel;
  357. begin
  358. srcsize:=left.resultdef.size;
  359. ressize:=resultdef.size;
  360. location_reset(location,LOC_FPUREGISTER,def_cgsize(resultdef));
  361. location.register:=hlcg.getfpuregister(current_asmdata.CurrAsmList,resultdef);
  362. { first always convert as if it's a signed number }
  363. thlcgjvm(hlcg).a_load_loc_stack(current_asmdata.CurrAsmList,left.resultdef,left.location);
  364. convertsignedstackloc;
  365. if not is_signed(left.resultdef) then
  366. begin
  367. { if it was unsigned, add high(cardinal)+1/high(qword)+1 in case
  368. the signed interpretation is < 0 }
  369. current_asmdata.getjumplabel(l1);
  370. if srcsize=4 then
  371. signeddef:=s32inttype
  372. else
  373. signeddef:=s64inttype;
  374. hlcg.a_cmp_const_loc_label(current_asmdata.CurrAsmList,signeddef,OC_GTE,0,left.location,l1);
  375. if srcsize=4 then
  376. thlcgjvm(hlcg).a_loadfpu_const_stack(current_asmdata.CurrAsmList,resultdef,4294967296.0)
  377. else
  378. thlcgjvm(hlcg).a_loadfpu_const_stack(current_asmdata.CurrAsmList,resultdef,18446744073709551616.0);
  379. if ressize=4 then
  380. current_asmdata.CurrAsmList.concat(taicpu.op_none(a_fadd))
  381. else
  382. current_asmdata.CurrAsmList.concat(taicpu.op_none(a_dadd));
  383. hlcg.a_label(current_asmdata.CurrAsmList,l1);
  384. end;
  385. thlcgjvm(hlcg).a_load_stack_reg(current_asmdata.CurrAsmList,resultdef,location.register);
  386. end;
  387. procedure tjvmtypeconvnode.second_bool_to_int;
  388. var
  389. newsize: tcgsize;
  390. oldTrueLabel,oldFalseLabel : tasmlabel;
  391. begin
  392. oldTrueLabel:=current_procinfo.CurrTrueLabel;
  393. oldFalseLabel:=current_procinfo.CurrFalseLabel;
  394. current_asmdata.getjumplabel(current_procinfo.CurrTrueLabel);
  395. current_asmdata.getjumplabel(current_procinfo.CurrFalseLabel);
  396. secondpass(left);
  397. location_copy(location,left.location);
  398. newsize:=def_cgsize(resultdef);
  399. { byte(bytebool) or word(wordbool) or longint(longbool) must be }
  400. { accepted for var parameters and assignments, and must not }
  401. { change the ordinal value or value location. }
  402. { htypechk.valid_for_assign ensures that such locations with a }
  403. { size<sizeof(register) cannot be LOC_CREGISTER (they otherwise }
  404. { could be in case of a plain assignment), and LOC_REGISTER can }
  405. { never be an assignment target. The remaining LOC_REGISTER/ }
  406. { LOC_CREGISTER locations do have to be sign/zero-extended. }
  407. { -- Note: this does not work for Java and 2/4 byte sized
  408. values, because bytebool/wordbool are signed and
  409. are stored in 4 byte locations -> will result in
  410. "byte" with the value high(cardinal); see remark
  411. in second_int_to_int above regarding consequences }
  412. if not(nf_explicit in flags) or
  413. (location.loc in [LOC_FLAGS,LOC_JUMP]) or
  414. ((newsize<>left.location.size) and
  415. ((left.resultdef.size<>resultdef.size) or
  416. not(left.resultdef.size in [4,8]))
  417. ) then
  418. hlcg.location_force_reg(current_asmdata.CurrAsmList,location,left.resultdef,resultdef,true)
  419. else
  420. { may differ in sign, e.g. bytebool -> byte }
  421. location.size:=newsize;
  422. current_procinfo.CurrTrueLabel:=oldTrueLabel;
  423. current_procinfo.CurrFalseLabel:=oldFalseLabel;
  424. end;
  425. procedure tjvmtypeconvnode.second_int_to_bool;
  426. var
  427. hlabel1,hlabel2,oldTrueLabel,oldFalseLabel : tasmlabel;
  428. newsize : tcgsize;
  429. begin
  430. oldTrueLabel:=current_procinfo.CurrTrueLabel;
  431. oldFalseLabel:=current_procinfo.CurrFalseLabel;
  432. current_asmdata.getjumplabel(current_procinfo.CurrTrueLabel);
  433. current_asmdata.getjumplabel(current_procinfo.CurrFalseLabel);
  434. secondpass(left);
  435. if codegenerror then
  436. exit;
  437. { Explicit typecasts from any ordinal type to a boolean type }
  438. { must not change the ordinal value }
  439. if (nf_explicit in flags) and
  440. not(left.location.loc in [LOC_FLAGS,LOC_JUMP]) then
  441. begin
  442. location_copy(location,left.location);
  443. newsize:=def_cgsize(resultdef);
  444. { change of size? change sign only if location is LOC_(C)REGISTER? Then we have to sign/zero-extend }
  445. if (tcgsize2size[newsize]<>tcgsize2size[left.location.size]) or
  446. ((newsize<>left.location.size) and (location.loc in [LOC_REGISTER,LOC_CREGISTER])) then
  447. hlcg.location_force_reg(current_asmdata.CurrAsmList,location,left.resultdef,resultdef,true)
  448. else
  449. location.size:=newsize;
  450. current_procinfo.CurrTrueLabel:=oldTrueLabel;
  451. current_procinfo.CurrFalseLabel:=oldFalseLabel;
  452. exit;
  453. end;
  454. location_reset(location,LOC_REGISTER,def_cgsize(resultdef));
  455. location.register:=hlcg.getintregister(current_asmdata.CurrAsmList,resultdef);
  456. current_asmdata.getjumplabel(hlabel2);
  457. case left.location.loc of
  458. LOC_CREFERENCE,LOC_REFERENCE,LOC_REGISTER,LOC_CREGISTER:
  459. begin
  460. current_asmdata.getjumplabel(hlabel1);
  461. hlcg.a_cmp_const_loc_label(current_asmdata.CurrAsmList,left.resultdef,OC_EQ,0,left.location,hlabel1);
  462. end;
  463. LOC_JUMP :
  464. begin
  465. hlabel1:=current_procinfo.CurrFalseLabel;
  466. hlcg.a_label(current_asmdata.CurrAsmList,current_procinfo.CurrTrueLabel);
  467. end;
  468. else
  469. internalerror(10062);
  470. end;
  471. if not(is_cbool(resultdef)) then
  472. thlcgjvm(hlcg).a_load_const_stack(current_asmdata.CurrAsmList,resultdef,1,R_INTREGISTER)
  473. else
  474. thlcgjvm(hlcg).a_load_const_stack(current_asmdata.CurrAsmList,resultdef,-1,R_INTREGISTER);
  475. { we jump over the next constant load -> they don't appear on the
  476. stack simulataneously }
  477. thlcgjvm(hlcg).decstack(current_asmdata.CurrAsmList,1);
  478. hlcg.a_jmp_always(current_asmdata.CurrAsmList,hlabel2);
  479. hlcg.a_label(current_asmdata.CurrAsmList,hlabel1);
  480. thlcgjvm(hlcg).a_load_const_stack(current_asmdata.CurrAsmList,resultdef,0,R_INTREGISTER);
  481. hlcg.a_label(current_asmdata.CurrAsmList,hlabel2);
  482. thlcgjvm(hlcg).a_load_stack_reg(current_asmdata.CurrAsmList,resultdef,location.register);
  483. current_procinfo.CurrTrueLabel:=oldTrueLabel;
  484. current_procinfo.CurrFalseLabel:=oldFalseLabel;
  485. end;
  486. procedure tjvmtypeconvnode.second_elem_to_openarray;
  487. var
  488. primitivetype: boolean;
  489. opc: tasmop;
  490. mangledname: string;
  491. basereg: tregister;
  492. arrayref: treference;
  493. begin
  494. { create an array with one element of the required type }
  495. thlcgjvm(hlcg).a_load_const_stack(current_asmdata.CurrAsmList,s32inttype,1,R_INTREGISTER);
  496. mangledname:=jvmarrtype(left.resultdef,primitivetype);
  497. if primitivetype then
  498. opc:=a_newarray
  499. else
  500. opc:=a_anewarray;
  501. { doesn't change stack height: one int replaced by one reference }
  502. current_asmdata.CurrAsmList.concat(taicpu.op_sym(opc,current_asmdata.RefAsmSymbol(mangledname)));
  503. { store the data in the newly created array }
  504. basereg:=hlcg.getaddressregister(current_asmdata.CurrAsmList,java_jlobject);
  505. thlcgjvm(hlcg).a_load_stack_reg(current_asmdata.CurrAsmList,java_jlobject,basereg);
  506. reference_reset_base(arrayref,basereg,0,4);
  507. arrayref.arrayreftype:=art_indexconst;
  508. arrayref.indexoffset:=0;
  509. hlcg.a_load_loc_ref(current_asmdata.CurrAsmList,left.resultdef,left.resultdef,left.location,arrayref);
  510. location_reset_ref(location,LOC_REFERENCE,OS_ADDR,4);
  511. tg.gethltemp(current_asmdata.CurrAsmList,java_jlobject,4,tt_normal,location.reference);
  512. hlcg.a_load_reg_ref(current_asmdata.CurrAsmList,java_jlobject,java_jlobject,basereg,location.reference);
  513. end;
  514. procedure get_most_nested_types(var fromdef, todef: tdef);
  515. begin
  516. while is_dynamic_array(fromdef) and
  517. is_dynamic_array(todef) do
  518. begin
  519. fromdef:=tarraydef(fromdef).elementdef;
  520. todef:=tarraydef(todef).elementdef;
  521. end;
  522. fromdef:=maybe_find_real_class_definition(fromdef,false);
  523. todef:=maybe_find_real_class_definition(todef,false);
  524. end;
  525. function tjvmtypeconvnode.do_target_specific_explicit_typeconv(check_only: boolean; out resnode: tnode): boolean;
  526. { handle explicit typecast from int to to real or vice versa }
  527. function int_real_explicit_typecast(fdef: tfloatdef; const singlemethod, doublemethod: string): tnode;
  528. var
  529. csym: ttypesym;
  530. psym: tsym;
  531. begin
  532. { use the float/double to raw bits methods to get the bit pattern }
  533. if fdef.floattype=s32real then
  534. begin
  535. csym:=search_system_type('JLFLOAT');
  536. psym:=search_struct_member(tobjectdef(csym.typedef),singlemethod);
  537. end
  538. else
  539. begin
  540. csym:=search_system_type('JLDOUBLE');
  541. psym:=search_struct_member(tobjectdef(csym.typedef),doublemethod);
  542. end;
  543. if not assigned(psym) or
  544. (psym.typ<>procsym) then
  545. internalerror(2011012901);
  546. { call the (static class) method to get the raw bits }
  547. result:=ccallnode.create(ccallparanode.create(left,nil),
  548. tprocsym(psym),psym.owner,
  549. cloadvmtaddrnode.create(ctypenode.create(csym.typedef)),[]);
  550. { convert the result to the result type of this type conversion node }
  551. inserttypeconv_explicit(result,resultdef);
  552. { left is reused }
  553. left:=nil;
  554. end;
  555. function ord_enum_explicit_typecast(fdef: torddef; todef: tenumdef): tnode;
  556. var
  557. psym: tsym;
  558. begin
  559. { we only create a class for the basedefs }
  560. todef:=todef.getbasedef;
  561. psym:=search_struct_member(todef.classdef,'FPCVALUEOF');
  562. if not assigned(psym) or
  563. (psym.typ<>procsym) then
  564. internalerror(2011062601);
  565. result:=ccallnode.create(ccallparanode.create(left,nil),
  566. tprocsym(psym),psym.owner,
  567. cloadvmtaddrnode.create(ctypenode.create(todef.classdef)),[]);
  568. { convert the result to the result type of this type conversion node }
  569. inserttypeconv_explicit(result,resultdef);
  570. { left is reused }
  571. left:=nil;
  572. end;
  573. function enum_ord_explicit_typecast(fdef: tenumdef; todef: torddef): tnode;
  574. var
  575. psym: tsym;
  576. begin
  577. { we only create a class for the basedef }
  578. fdef:=fdef.getbasedef;
  579. psym:=search_struct_member(fdef.classdef,'FPCORDINAL');
  580. if not assigned(psym) or
  581. (psym.typ<>procsym) then
  582. internalerror(2011062602);
  583. result:=ccallnode.create(nil,tprocsym(psym),psym.owner,left,[]);
  584. { convert the result to the result type of this type conversion node }
  585. inserttypeconv_explicit(result,resultdef);
  586. { left is reused }
  587. left:=nil;
  588. end;
  589. function from_set_explicit_typecast: tnode;
  590. var
  591. helpername: string;
  592. setconvdef: tdef;
  593. begin
  594. if tsetdef(left.resultdef).elementdef.typ=enumdef then
  595. begin
  596. setconvdef:=java_juenumset;
  597. helpername:='fpc_enumset_to_'
  598. end
  599. else
  600. begin
  601. setconvdef:=java_jubitset;
  602. helpername:='fpc_bitset_to_'
  603. end;
  604. if left.resultdef.size<=4 then
  605. helpername:=helpername+'int'
  606. else
  607. helpername:=helpername+'long';
  608. result:=ccallnode.createintern(helpername,ccallparanode.create(
  609. genintconstnode(left.resultdef.size),ccallparanode.create(genintconstnode(tsetdef(left.resultdef).setbase),
  610. ccallparanode.create(ctypeconvnode.create_explicit(left,setconvdef),nil))));
  611. left:=nil;
  612. end;
  613. function to_set_explicit_typecast: tnode;
  614. var
  615. enumclassdef: tobjectdef;
  616. mp: tnode;
  617. helpername: string;
  618. begin
  619. if tsetdef(resultdef).elementdef.typ=enumdef then
  620. begin
  621. inserttypeconv_explicit(left,s64inttype);
  622. enumclassdef:=tenumdef(tsetdef(resultdef).elementdef).getbasedef.classdef;
  623. mp:=cloadvmtaddrnode.create(ctypenode.create(enumclassdef));
  624. helpername:='fpcLongToEnumSet';
  625. { enumclass.fpcLongToEnumSet(left,setbase,setsize) }
  626. result:=ccallnode.createinternmethod(mp,helpername,
  627. ccallparanode.create(genintconstnode(resultdef.size),
  628. ccallparanode.create(genintconstnode(tsetdef(resultdef).setbase),
  629. ccallparanode.create(left,nil))));
  630. end
  631. else
  632. begin
  633. if left.resultdef.size<=4 then
  634. begin
  635. helpername:='fpc_int_to_bitset';
  636. inserttypeconv_explicit(left,s32inttype);
  637. end
  638. else
  639. begin
  640. helpername:='fpc_long_to_bitset';
  641. inserttypeconv_explicit(left,s64inttype);
  642. end;
  643. result:=ccallnode.createintern(helpername,
  644. ccallparanode.create(genintconstnode(resultdef.size),
  645. ccallparanode.create(genintconstnode(tsetdef(resultdef).setbase),
  646. ccallparanode.create(left,nil))));
  647. end;
  648. end;
  649. function ptr_no_typecheck_required(fromdef, todef: tdef): boolean;
  650. function check_type_equality(def1,def2: tdef): boolean;
  651. begin
  652. result:=true;
  653. if is_ansistring(def1) and
  654. (def2=java_ansistring) then
  655. exit;
  656. if is_wide_or_unicode_string(def1) and
  657. (def2=java_jlstring) then
  658. exit;
  659. if def1.typ=pointerdef then
  660. begin
  661. if is_shortstring(tpointerdef(def1).pointeddef) and
  662. (def2=java_shortstring) then
  663. exit;
  664. { pointer-to-set to JUEnumSet/JUBitSet }
  665. if (tpointerdef(def1).pointeddef.typ=setdef) then
  666. begin
  667. if not assigned(tsetdef(tpointerdef(def1).pointeddef).elementdef) then
  668. begin
  669. if (def2=java_jubitset) or
  670. (def2=java_juenumset) then
  671. exit;
  672. end
  673. else if tsetdef(tpointerdef(def1).pointeddef).elementdef.typ=enumdef then
  674. begin
  675. if def2=java_juenumset then
  676. exit;
  677. end
  678. else if def2=java_jubitset then
  679. exit;
  680. end;
  681. end;
  682. result:=false;
  683. end;
  684. function check_array_type_equality(def1,def2: tdef): boolean;
  685. begin
  686. result:=true;
  687. if is_shortstring(def1) and
  688. (def2=java_shortstring) then
  689. exit;
  690. result:=false;
  691. end;
  692. begin
  693. result:=true;
  694. if (todef=java_jlobject) or
  695. (todef=voidpointertype) then
  696. exit;
  697. if compare_defs(fromdef,todef,nothingn)>=te_equal then
  698. exit;
  699. { trecorddef.is_related() must work for inheritance/method checking,
  700. but do not allow records to be directly typecasted into class/
  701. pointer types (you have to use FpcBaseRecordType(@rec) instead) }
  702. if not is_record(fromdef) and
  703. fromdef.is_related(todef) then
  704. exit;
  705. if check_type_equality(fromdef,todef) then
  706. exit;
  707. if check_type_equality(todef,fromdef) then
  708. exit;
  709. if (fromdef.typ=pointerdef) and
  710. (tpointerdef(fromdef).pointeddef.typ=recorddef) and
  711. (todef=java_fpcbaserecordtype) then
  712. exit;
  713. { all classrefs are currently java.lang.Class at the bytecode level }
  714. if (fromdef.typ=classrefdef) and
  715. (todef.typ=objectdef) and
  716. (todef=search_system_type('JLCLASS').typedef) then
  717. exit;
  718. if (fromdef.typ=classrefdef) and
  719. (todef.typ=classrefdef) and
  720. tclassrefdef(fromdef).pointeddef.is_related(tclassrefdef(todef).pointeddef) then
  721. exit;
  722. { special case: "array of shortstring" to "array of ShortstringClass"
  723. and "array of <record>" to "array of FpcRecordBaseType" (normally
  724. you have to use ShortstringClass(@shortstrvar) etc, but that's not
  725. possible in case of passing arrays to e.g. setlength) }
  726. if is_dynamic_array(left.resultdef) and
  727. is_dynamic_array(resultdef) then
  728. begin
  729. if check_array_type_equality(fromdef,todef) or
  730. check_array_type_equality(todef,fromdef) then
  731. exit;
  732. if is_record(fromdef) and
  733. (todef=java_fpcbaserecordtype) then
  734. exit;
  735. end;
  736. result:=false;
  737. end;
  738. var
  739. fromclasscompatible,
  740. toclasscompatible,
  741. procvarconv: boolean;
  742. fromdef,
  743. todef: tdef;
  744. fromarrtype,
  745. toarrtype: char;
  746. begin
  747. resnode:=nil;
  748. if not(convtype in [tc_equal,tc_int_2_int,tc_int_2_bool,tc_bool_2_int,tc_class_2_intf]) or
  749. ((convtype in [tc_equal,tc_int_2_int,tc_bool_2_int,tc_int_2_bool]) and
  750. ((left.resultdef.typ=orddef) and
  751. (resultdef.typ=orddef))) then
  752. begin
  753. result:=false;
  754. exit
  755. end;
  756. { This routine is only called for explicit typeconversions of same-sized
  757. entities that aren't handled by normal type conversions -> bit pattern
  758. reinterpretations. In the JVM, many of these also need special
  759. handling because of the type safety. }
  760. { don't allow conversions between object-based and non-object-based
  761. types }
  762. procvarconv:=isvalidprocvartypeconv(left.resultdef,resultdef);
  763. fromclasscompatible:=
  764. (left.resultdef.typ=formaldef) or
  765. (left.resultdef.typ=pointerdef) or
  766. is_java_class_or_interface(left.resultdef) or
  767. is_dynamic_array(left.resultdef) or
  768. ((left.resultdef.typ in [stringdef,classrefdef]) and
  769. not is_shortstring(left.resultdef)) or
  770. (left.resultdef.typ=enumdef) or
  771. procvarconv;
  772. toclasscompatible:=
  773. (resultdef.typ=pointerdef) or
  774. is_java_class_or_interface(resultdef) or
  775. is_dynamic_array(resultdef) or
  776. ((resultdef.typ in [stringdef,classrefdef]) and
  777. not is_shortstring(resultdef)) or
  778. (resultdef.typ=enumdef) or
  779. procvarconv;
  780. { typescasts from void (the result of untyped_ptr^) to an implicit
  781. pointertype (record, array, ...) also needs a typecheck }
  782. if is_void(left.resultdef) and
  783. jvmimplicitpointertype(resultdef) then
  784. begin
  785. fromclasscompatible:=true;
  786. toclasscompatible:=true;
  787. end;
  788. if fromclasscompatible and toclasscompatible then
  789. begin
  790. { we need an as-node to check the validity of the conversion (since
  791. it wasn't handled by another type conversion, we know it can't
  792. have been valid normally)
  793. Exceptions: (most nested) destination is
  794. * java.lang.Object, since everything is compatible with that type
  795. * related to source
  796. * a primitive that are represented by the same type in Java
  797. (e.g., byte and shortint) }
  798. { in case of arrays, check the compatibility of the innermost types }
  799. fromdef:=left.resultdef;
  800. todef:=resultdef;
  801. get_most_nested_types(fromdef,todef);
  802. { in case of enums, get the equivalent class definitions }
  803. if (fromdef.typ=enumdef) then
  804. fromdef:=tenumdef(fromdef).getbasedef;
  805. if (todef.typ=enumdef) then
  806. todef:=tenumdef(todef).getbasedef;
  807. fromarrtype:=jvmarrtype_setlength(fromdef);
  808. toarrtype:=jvmarrtype_setlength(todef);
  809. if not ptr_no_typecheck_required(fromdef,todef) then
  810. begin
  811. if (fromarrtype in ['A','R','T','E','L']) or
  812. (fromarrtype<>toarrtype) then
  813. begin
  814. if not check_only and
  815. not assignment_side then
  816. begin
  817. resnode:=ctypenode.create(resultdef);
  818. if resultdef.typ=objectdef then
  819. resnode:=cloadvmtaddrnode.create(resnode);
  820. resnode:=casnode.create_internal(left,resnode);
  821. if resultdef.typ=classrefdef then
  822. tjvmasnode(resnode).classreftypecast:=true;
  823. left:=nil;
  824. end
  825. end
  826. { typecasting from a child to a parent type on the assignment side
  827. will (rightly) mess up the type safety verification of the JVM }
  828. else if assignment_side then
  829. CGMessage(type_e_no_managed_assign_generic_typecast);
  830. end;
  831. result:=true;
  832. exit;
  833. end;
  834. { a formaldef can be converted to anything, but not on the assignment
  835. side }
  836. if (left.resultdef.typ=formaldef) and
  837. not assignment_side then
  838. begin
  839. if resultdef.typ in [orddef,floatdef] then
  840. begin
  841. if not check_only then
  842. begin
  843. resnode:=cinlinenode.create(in_unbox_x_y,false,
  844. ccallparanode.create(ctypenode.create(resultdef),
  845. ccallparanode.create(left,nil)));
  846. left:=nil;
  847. end;
  848. result:=true;
  849. exit;
  850. end
  851. else if jvmimplicitpointertype(resultdef) then
  852. begin
  853. { typecast formaldef to pointer to the type, then deref, so that
  854. a proper checkcast is inserted }
  855. if not check_only then
  856. begin
  857. resnode:=ctypeconvnode.create_explicit(left,getpointerdef(resultdef));
  858. resnode:=cderefnode.create(resnode);
  859. left:=nil;
  860. end;
  861. result:=true;
  862. exit;
  863. end;
  864. result:=false;
  865. exit;
  866. end;
  867. { don't allow conversions between different classes of primitive types,
  868. except for a few special cases }
  869. { float to int/enum explicit type conversion: get the bits }
  870. if (left.resultdef.typ=floatdef) and
  871. (is_integer(resultdef) or
  872. (resultdef.typ=enumdef)) then
  873. begin
  874. if not check_only then
  875. resnode:=int_real_explicit_typecast(tfloatdef(left.resultdef),'FLOATTORAWINTBITS','DOUBLETORAWLONGBITS');
  876. result:=true;
  877. exit;
  878. end;
  879. { int to float explicit type conversion: also use the bits }
  880. if (is_integer(left.resultdef) or
  881. (left.resultdef.typ=enumdef)) and
  882. (resultdef.typ=floatdef) then
  883. begin
  884. if not check_only then
  885. begin
  886. if (left.resultdef.typ=enumdef) then
  887. inserttypeconv_explicit(left,s32inttype);
  888. resnode:=int_real_explicit_typecast(tfloatdef(resultdef),'INTBITSTOFLOAT','LONGBITSTODOUBLE');
  889. end;
  890. result:=true;
  891. exit;
  892. end;
  893. { enums }
  894. if (left.resultdef.typ=enumdef) or
  895. (resultdef.typ=enumdef) then
  896. begin
  897. { both enum? }
  898. if (resultdef.typ=left.resultdef.typ) then
  899. begin
  900. { same base type -> nothing special }
  901. fromdef:=tenumdef(left.resultdef).getbasedef;
  902. todef:=tenumdef(resultdef).getbasedef;
  903. if fromdef=todef then
  904. begin
  905. result:=false;
  906. exit;
  907. end;
  908. { convert via ordinal intermediate }
  909. if not check_only then
  910. begin;
  911. inserttypeconv_explicit(left,s32inttype);
  912. inserttypeconv_explicit(left,resultdef);
  913. resnode:=left;
  914. left:=nil
  915. end;
  916. result:=true;
  917. exit;
  918. end;
  919. { enum to orddef & vice versa }
  920. if left.resultdef.typ=orddef then
  921. begin
  922. if not check_only then
  923. resnode:=ord_enum_explicit_typecast(torddef(left.resultdef),tenumdef(resultdef));
  924. result:=true;
  925. exit;
  926. end
  927. else if resultdef.typ=orddef then
  928. begin
  929. if not check_only then
  930. resnode:=enum_ord_explicit_typecast(tenumdef(left.resultdef),torddef(resultdef));
  931. result:=true;
  932. exit;
  933. end
  934. end;
  935. { sets }
  936. if (left.resultdef.typ=setdef) or
  937. (resultdef.typ=setdef) then
  938. begin
  939. { set -> ord/enum/other-set-type }
  940. if (resultdef.typ in [orddef,enumdef]) then
  941. begin
  942. if not check_only then
  943. begin
  944. resnode:=from_set_explicit_typecast;
  945. { convert to desired result }
  946. inserttypeconv_explicit(resnode,resultdef);
  947. end;
  948. result:=true;
  949. exit;
  950. end
  951. { ord/enum -> set }
  952. else if (left.resultdef.typ in [orddef,enumdef]) then
  953. begin
  954. if not check_only then
  955. begin
  956. resnode:=to_set_explicit_typecast;
  957. { convert to desired result }
  958. inserttypeconv_explicit(resnode,getpointerdef(resultdef));
  959. resnode:=cderefnode.create(resnode);
  960. end;
  961. result:=true;
  962. exit;
  963. end;
  964. { if someone needs it, float->set and set->float explicit typecasts
  965. could also be added (cannot be handled by the above, because
  966. float(intvalue) will convert rather than re-interpret the value) }
  967. end;
  968. {$ifndef nounsupported}
  969. { non-literal type conversions }
  970. if convtype in
  971. [tc_char_2_string,
  972. tc_char_2_chararray,
  973. tc_string_2_string,
  974. tc_string_2_chararray,
  975. tc_real_2_real,
  976. tc_proc_2_procvar,
  977. tc_arrayconstructor_2_set,
  978. tc_class_2_intf,
  979. tc_array_2_dynarray] then
  980. begin
  981. result:=false;
  982. exit;
  983. end;
  984. {$endif}
  985. { Todo:
  986. * int to set and vice versa
  987. * set to float and vice versa (via int) (maybe)
  988. * regular array of primitive to primitive and vice versa (maybe)
  989. * packed record to primitive and vice versa (maybe)
  990. Definitely not:
  991. * unpacked record to anything and vice versa (no alignment rules
  992. for Java)
  993. }
  994. { anything not explicitly handled is a problem }
  995. result:=true;
  996. CGMessage2(type_e_illegal_type_conversion,left.resultdef.typename,resultdef.typename);
  997. end;
  998. function tjvmtypeconvnode.target_specific_explicit_typeconv: boolean;
  999. var
  1000. dummyres: tnode;
  1001. begin
  1002. result:=do_target_specific_explicit_typeconv(true,dummyres);
  1003. end;
  1004. function tjvmtypeconvnode.target_specific_general_typeconv: boolean;
  1005. begin
  1006. result:=false;
  1007. { on the JVM platform, enums can always be converted to class instances,
  1008. because enums /are/ class instances there. To prevent the
  1009. typechecking/conversion code from assuming it can treat it like any
  1010. ordinal constant, firstpass() it so that the ordinal constant gets
  1011. replaced with a load of a staticvarsym. This is not done in
  1012. pass_typecheck, because that would prevent many optimizations }
  1013. if (left.nodetype=ordconstn) and
  1014. (left.resultdef.typ=enumdef) and
  1015. (resultdef.typ=objectdef) then
  1016. firstpass(left);
  1017. {$ifndef nounsupported}
  1018. { generated in nmem; replace voidpointertype with java_jlobject }
  1019. if nf_load_procvar in flags then
  1020. begin
  1021. self.totypedef:=java_jlobject;
  1022. resultdef:=java_jlobject;
  1023. end;
  1024. if isvalidprocvartypeconv(left.resultdef,resultdef) then
  1025. begin
  1026. convtype:=tc_equal;
  1027. result:=true;
  1028. exit;
  1029. end;
  1030. {$endif}
  1031. end;
  1032. {*****************************************************************************
  1033. AsNode and IsNode common helpers
  1034. *****************************************************************************}
  1035. function asis_target_specific_typecheck(node: tasisnode): boolean;
  1036. var
  1037. realtodef: tdef;
  1038. begin
  1039. if not(nf_internal in node.flags) then
  1040. begin
  1041. { handle using normal code }
  1042. result:=false;
  1043. exit;
  1044. end;
  1045. result:=true;
  1046. { these are converted type conversion nodes, to insert the checkcast
  1047. operations }
  1048. realtodef:=node.right.resultdef;
  1049. if (realtodef.typ=classrefdef) and
  1050. ((node.nodetype<>asn) or
  1051. not tjvmasnode(node).classreftypecast) then
  1052. realtodef:=tclassrefdef(realtodef).pointeddef;
  1053. realtodef:=maybe_find_real_class_definition(realtodef,false);
  1054. if result then
  1055. if node.nodetype=asn then
  1056. node.resultdef:=realtodef
  1057. else
  1058. node.resultdef:=pasbool8type;
  1059. end;
  1060. function asis_pass_1(node: tasisnode; const methodname: string): tnode;
  1061. var
  1062. ps: tsym;
  1063. call: tnode;
  1064. jlclass: tobjectdef;
  1065. begin
  1066. result:=nil;
  1067. firstpass(node.left);
  1068. if not(node.right.nodetype in [typen,loadvmtaddrn]) then
  1069. begin
  1070. if (node.nodetype=isn) or
  1071. not assigned(tasnode(node).call) then
  1072. begin
  1073. if not is_javaclassref(node.right.resultdef) then
  1074. internalerror(2011041920);
  1075. firstpass(node.right);
  1076. jlclass:=tobjectdef(search_system_type('JLCLASS').typedef);
  1077. ps:=search_struct_member(jlclass,methodname);
  1078. if not assigned(ps) or
  1079. (ps.typ<>procsym) then
  1080. internalerror(2011041910);
  1081. call:=ccallnode.create(ccallparanode.create(node.left,nil),tprocsym(ps),ps.owner,ctypeconvnode.create_explicit(node.right,jlclass),[]);
  1082. node.left:=nil;
  1083. node.right:=nil;
  1084. firstpass(call);
  1085. if codegenerror then
  1086. exit;
  1087. if node.nodetype=isn then
  1088. result:=call
  1089. else
  1090. begin
  1091. tasnode(node).call:=call;
  1092. node.expectloc:=call.expectloc;
  1093. end;
  1094. end;
  1095. end
  1096. else
  1097. begin
  1098. node.expectloc:=LOC_REGISTER;
  1099. result:=nil;
  1100. end;
  1101. end;
  1102. function asis_generate_code(node: tasisnode; opcode: tasmop): boolean;
  1103. var
  1104. checkdef: tdef;
  1105. begin
  1106. if (node.nodetype=asn) and
  1107. assigned(tasnode(node).call) then
  1108. begin
  1109. result:=false;
  1110. exit;
  1111. end;
  1112. result:=true;
  1113. secondpass(node.left);
  1114. thlcgjvm(hlcg).a_load_loc_stack(current_asmdata.CurrAsmList,node.left.resultdef,node.left.location);
  1115. location_freetemp(current_asmdata.CurrAsmList,node.left.location);
  1116. { Perform a checkcast instruction, which will raise an exception in case
  1117. the actual type does not match/inherit from the expected type.
  1118. Object types need the full type name (package+class name), arrays only
  1119. the array definition }
  1120. if node.nodetype=asn then
  1121. checkdef:=node.resultdef
  1122. else if node.right.resultdef.typ=classrefdef then
  1123. checkdef:=tclassrefdef(node.right.resultdef).pointeddef
  1124. else
  1125. checkdef:=node.right.resultdef;
  1126. { replace special types with their equivalent class type }
  1127. if (checkdef.typ=pointerdef) and
  1128. jvmimplicitpointertype(tpointerdef(checkdef).pointeddef) then
  1129. checkdef:=tpointerdef(checkdef).pointeddef;
  1130. if (checkdef=voidpointertype) or
  1131. (checkdef.typ=formaldef) then
  1132. checkdef:=java_jlobject
  1133. else if checkdef.typ=enumdef then
  1134. checkdef:=tenumdef(checkdef).classdef
  1135. else if checkdef.typ=setdef then
  1136. begin
  1137. if tsetdef(checkdef).elementdef.typ=enumdef then
  1138. checkdef:=java_juenumset
  1139. else
  1140. checkdef:=java_jubitset;
  1141. end;
  1142. {$ifndef nounsupported}
  1143. if checkdef.typ=procvardef then
  1144. checkdef:=java_jlobject
  1145. else
  1146. {$endif}
  1147. if is_wide_or_unicode_string(checkdef) then
  1148. checkdef:=java_jlstring
  1149. else if is_ansistring(checkdef) then
  1150. checkdef:=java_ansistring
  1151. else if is_shortstring(checkdef) then
  1152. checkdef:=java_shortstring;
  1153. if checkdef.typ in [objectdef,recorddef] then
  1154. current_asmdata.CurrAsmList.concat(taicpu.op_sym(opcode,current_asmdata.RefAsmSymbol(tabstractrecorddef(checkdef).jvm_full_typename(true))))
  1155. else if checkdef.typ=classrefdef then
  1156. current_asmdata.CurrAsmList.concat(taicpu.op_sym(opcode,current_asmdata.RefAsmSymbol('java/lang/Class')))
  1157. else
  1158. current_asmdata.CurrAsmList.concat(taicpu.op_sym(opcode,current_asmdata.RefAsmSymbol(jvmencodetype(checkdef,false))));
  1159. location_reset(node.location,LOC_REGISTER,OS_ADDR);
  1160. node.location.register:=hlcg.getaddressregister(current_asmdata.CurrAsmList,node.resultdef);
  1161. thlcgjvm(hlcg).a_load_stack_reg(current_asmdata.CurrAsmList,node.resultdef,node.location.register);
  1162. end;
  1163. {*****************************************************************************
  1164. TJVMAsNode
  1165. *****************************************************************************}
  1166. function tjvmasnode.target_specific_typecheck: boolean;
  1167. begin
  1168. result:=asis_target_specific_typecheck(self);
  1169. end;
  1170. function tjvmasnode.pass_1: tnode;
  1171. begin
  1172. result:=asis_pass_1(self,'CAST');
  1173. end;
  1174. procedure tjvmasnode.pass_generate_code;
  1175. begin
  1176. if not asis_generate_code(self,a_checkcast) then
  1177. inherited;
  1178. end;
  1179. function tjvmasnode.dogetcopy: tnode;
  1180. begin
  1181. result:=inherited dogetcopy;
  1182. tjvmasnode(result).classreftypecast:=classreftypecast;
  1183. end;
  1184. function tjvmasnode.docompare(p: tnode): boolean;
  1185. begin
  1186. result:=
  1187. inherited docompare(p) and
  1188. (tjvmasnode(p).classreftypecast=classreftypecast);
  1189. end;
  1190. constructor tjvmasnode.ppuload(t: tnodetype; ppufile: tcompilerppufile);
  1191. begin
  1192. inherited;
  1193. classreftypecast:=boolean(ppufile.getbyte);
  1194. end;
  1195. procedure tjvmasnode.ppuwrite(ppufile: tcompilerppufile);
  1196. begin
  1197. inherited ppuwrite(ppufile);
  1198. ppufile.putbyte(byte(classreftypecast));
  1199. end;
  1200. {*****************************************************************************
  1201. TJVMIsNode
  1202. *****************************************************************************}
  1203. function tjvmisnode.target_specific_typecheck: boolean;
  1204. begin
  1205. result:=asis_target_specific_typecheck(self);
  1206. end;
  1207. function tjvmisnode.pass_1: tnode;
  1208. begin
  1209. result:=asis_pass_1(self,'ISINSTANCE');
  1210. end;
  1211. procedure tjvmisnode.pass_generate_code;
  1212. begin
  1213. if not asis_generate_code(self,a_instanceof) then
  1214. inherited;
  1215. end;
  1216. begin
  1217. ctypeconvnode:=tjvmtypeconvnode;
  1218. casnode:=tjvmasnode;
  1219. cisnode:=tjvmisnode;
  1220. end.