njvmcnv.pas 27 KB

123456789101112131415161718192021222324252627282930313233343536373839404142434445464748495051525354555657585960616263646566676869707172737475767778798081828384858687888990919293949596979899100101102103104105106107108109110111112113114115116117118119120121122123124125126127128129130131132133134135136137138139140141142143144145146147148149150151152153154155156157158159160161162163164165166167168169170171172173174175176177178179180181182183184185186187188189190191192193194195196197198199200201202203204205206207208209210211212213214215216217218219220221222223224225226227228229230231232233234235236237238239240241242243244245246247248249250251252253254255256257258259260261262263264265266267268269270271272273274275276277278279280281282283284285286287288289290291292293294295296297298299300301302303304305306307308309310311312313314315316317318319320321322323324325326327328329330331332333334335336337338339340341342343344345346347348349350351352353354355356357358359360361362363364365366367368369370371372373374375376377378379380381382383384385386387388389390391392393394395396397398399400401402403404405406407408409410411412413414415416417418419420421422423424425426427428429430431432433434435436437438439440441442443444445446447448449450451452453454455456457458459460461462463464465466467468469470471472473474475476477478479480481482483484485486487488489490491492493494495496497498499500501502503504505506507508509510511512513514515516517518519520521522523524525526527528529530531532533534535536537538539540541542543544545546547548549550551552553554555556557558559560561562563564565566567568569570571572573574575576577578579580581582583584585586587588589590591592593594595596597598599600601602603604605606607608609610611612613614615616617618619620621622623624625626627628629630631632633634635636637638639640641642643644645646647648649650651652653654655656657658659660661662663664665666667668669670671672673674675676677678679680681682683684685686687688689690691692693694695696697698699700701702
  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. procedure second_int_to_int;override;
  27. { procedure second_string_to_string;override; }
  28. { procedure second_cstring_to_pchar;override; }
  29. { procedure second_string_to_chararray;override; }
  30. { procedure second_array_to_pointer;override; }
  31. function first_int_to_real: tnode; override;
  32. { procedure second_pointer_to_array;override; }
  33. { procedure second_chararray_to_string;override; }
  34. { procedure second_char_to_string;override; }
  35. procedure second_int_to_real;override;
  36. { procedure second_real_to_real;override; }
  37. { procedure second_cord_to_pointer;override; }
  38. { procedure second_proc_to_procvar;override; }
  39. procedure second_bool_to_int;override;
  40. procedure second_int_to_bool;override;
  41. { procedure second_load_smallset;override; }
  42. { procedure second_ansistring_to_pchar;override; }
  43. { procedure second_pchar_to_string;override; }
  44. { procedure second_class_to_intf;override; }
  45. { procedure second_char_to_char;override; }
  46. protected
  47. function target_specific_explicit_typeconv: tnode; override;
  48. function target_specific_general_typeconv(var res: tnode): boolean; override;
  49. end;
  50. tjvmasnode = class(tcgasnode)
  51. protected
  52. function target_specific_typecheck: boolean;override;
  53. public
  54. function pass_1 : tnode;override;
  55. procedure pass_generate_code; override;
  56. end;
  57. tjvmisnode = class(tisnode)
  58. protected
  59. function target_specific_typecheck: boolean;override;
  60. public
  61. function pass_1 : tnode;override;
  62. procedure pass_generate_code; override;
  63. end;
  64. implementation
  65. uses
  66. verbose,globals,globtype,
  67. symconst,symdef,symsym,symtable,aasmbase,aasmdata,
  68. defutil,defcmp,jvmdef,
  69. cgbase,cgutils,pass_1,pass_2,
  70. nbas,ncon,ncal,nld,nmem,procinfo,
  71. nutils,
  72. cpubase,aasmcpu,
  73. tgobj,hlcgobj,hlcgcpu;
  74. {*****************************************************************************
  75. TypeCheckTypeConv
  76. *****************************************************************************}
  77. function tjvmtypeconvnode.typecheck_dynarray_to_openarray: tnode;
  78. begin
  79. { all arrays are equal in Java }
  80. left.resultdef:=resultdef;
  81. result:=left;
  82. left:=nil;
  83. end;
  84. function tjvmtypeconvnode.typecheck_string_to_chararray: tnode;
  85. var
  86. newblock: tblocknode;
  87. newstat: tstatementnode;
  88. restemp: ttempcreatenode;
  89. chartype: string;
  90. begin
  91. if (left.nodetype = stringconstn) and
  92. (tstringconstnode(left).cst_type=cst_conststring) then
  93. inserttypeconv(left,cunicodestringtype);
  94. { even constant strings have to be handled via a helper }
  95. if is_widechar(tarraydef(resultdef).elementdef) then
  96. chartype:='widechar'
  97. else
  98. chartype:='char';
  99. newblock:=internalstatements(newstat);
  100. restemp:=ctempcreatenode.create(resultdef,resultdef.size,tt_persistent,false);
  101. addstatement(newstat,restemp);
  102. addstatement(newstat,ccallnode.createintern('fpc_'+tstringdef(left.resultdef).stringtypname+
  103. '_to_'+chartype+'array',ccallparanode.create(left,ccallparanode.create(
  104. ctemprefnode.create(restemp),nil))));
  105. addstatement(newstat,ctempdeletenode.create_normal_temp(restemp));
  106. addstatement(newstat,ctemprefnode.create(restemp));
  107. result:=newblock;
  108. left:=nil;
  109. end;
  110. {*****************************************************************************
  111. FirstTypeConv
  112. *****************************************************************************}
  113. function tjvmtypeconvnode.first_int_to_real: tnode;
  114. begin
  115. if not is_64bitint(left.resultdef) then
  116. if is_signed(left.resultdef) or
  117. (left.resultdef.size<4) then
  118. inserttypeconv(left,s32inttype)
  119. else
  120. inserttypeconv(left,u32inttype);
  121. firstpass(left);
  122. result := nil;
  123. expectloc:=LOC_FPUREGISTER;
  124. end;
  125. {*****************************************************************************
  126. SecondTypeConv
  127. *****************************************************************************}
  128. procedure tjvmtypeconvnode.second_int_to_int;
  129. var
  130. ressize,
  131. leftsize : longint;
  132. begin
  133. { insert range check if not explicit conversion }
  134. if not(nf_explicit in flags) then
  135. hlcg.g_rangecheck(current_asmdata.CurrAsmList,left.location,left.resultdef,resultdef);
  136. { is the result size smaller? when typecasting from void
  137. we always reuse the current location, because there is
  138. nothing that we can load in a register }
  139. ressize:=resultdef.size;
  140. leftsize :=left.resultdef.size;
  141. if ((ressize<>leftsize) or
  142. ((location.loc in [LOC_REFERENCE,LOC_CREFERENCE]) and
  143. (location.reference.arrayreftype<>art_none) and
  144. (is_widechar(left.resultdef)<>is_widechar(resultdef))) or
  145. is_bitpacked_access(left)) and
  146. not is_void(left.resultdef) then
  147. begin
  148. location_copy(location,left.location);
  149. { reuse a loc_reference when the newsize is smaller than
  150. than the original, except
  151. a) for arrays (they use different load instructions for
  152. differently sized data types)
  153. b) when going from 8 to 4 bytes, because these are different
  154. data types
  155. -- note that this is different from other targets, and will
  156. break stuff like passing byte(shortintvar) to a var-parameter;
  157. although that may be "fixed" again because we have to use
  158. copy-in/copy-out to emulate var-parameters anyway... }
  159. if (location.loc in [LOC_REFERENCE,LOC_CREFERENCE]) and
  160. (location.reference.arrayreftype=art_none) and
  161. (ressize<leftsize) and
  162. (leftsize<=4) then
  163. begin
  164. location.size:=def_cgsize(resultdef);
  165. { no adjustment of the ffset even though Java is big endian,
  166. because the load instruction will remain the same }
  167. end
  168. else
  169. hlcg.location_force_reg(current_asmdata.CurrAsmList,location,left.resultdef,resultdef,false);
  170. end
  171. else
  172. begin
  173. location_copy(location,left.location);
  174. location.size:=def_cgsize(resultdef);
  175. if (ressize < sizeof(aint)) and
  176. (location.loc in [LOC_REGISTER,LOC_CREGISTER]) and
  177. (def_cgsize(left.resultdef)<>def_cgsize(resultdef)) then
  178. begin
  179. location.register:=hlcg.getintregister(current_asmdata.CurrAsmList,resultdef);
  180. location.loc:=LOC_REGISTER;
  181. hlcg.a_load_reg_reg(current_asmdata.CurrAsmList,left.resultdef,resultdef,left.location.register,location.register);
  182. end;
  183. end;
  184. end;
  185. procedure tjvmtypeconvnode.second_int_to_real;
  186. var
  187. srcsize, ressize: longint;
  188. procedure convertsignedstackloc;
  189. begin
  190. case srcsize of
  191. 4:
  192. case ressize of
  193. 4:
  194. current_asmdata.CurrAsmList.concat(taicpu.op_none(a_i2f));
  195. 8:
  196. begin
  197. current_asmdata.CurrAsmList.concat(taicpu.op_none(a_i2d));
  198. thlcgjvm(hlcg).incstack(current_asmdata.CurrAsmList,1);
  199. end;
  200. else
  201. internalerror(2011010601);
  202. end;
  203. 8:
  204. case ressize of
  205. 4:
  206. begin
  207. current_asmdata.CurrAsmList.concat(taicpu.op_none(a_l2f));
  208. thlcgjvm(hlcg).decstack(current_asmdata.CurrAsmList,1);
  209. end;
  210. 8:
  211. current_asmdata.CurrAsmList.concat(taicpu.op_none(a_l2d));
  212. else
  213. internalerror(2011010602);
  214. end;
  215. else
  216. internalerror(2011010603);
  217. end;
  218. end;
  219. var
  220. signeddef : tdef;
  221. l1 : tasmlabel;
  222. begin
  223. srcsize:=left.resultdef.size;
  224. ressize:=resultdef.size;
  225. location_reset(location,LOC_FPUREGISTER,def_cgsize(resultdef));
  226. location.register:=hlcg.getfpuregister(current_asmdata.CurrAsmList,resultdef);
  227. { first always convert as if it's a signed number }
  228. thlcgjvm(hlcg).a_load_loc_stack(current_asmdata.CurrAsmList,left.resultdef,left.location);
  229. convertsignedstackloc;
  230. if not is_signed(left.resultdef) then
  231. begin
  232. { if it was unsigned, add high(cardinal)+1/high(qword)+1 in case
  233. the signed interpretation is < 0 }
  234. current_asmdata.getjumplabel(l1);
  235. if srcsize=4 then
  236. signeddef:=s32inttype
  237. else
  238. signeddef:=s64inttype;
  239. hlcg.a_cmp_const_loc_label(current_asmdata.CurrAsmList,signeddef,OC_GTE,0,left.location,l1);
  240. if srcsize=4 then
  241. thlcgjvm(hlcg).a_loadfpu_const_stack(current_asmdata.CurrAsmList,resultdef,4294967296.0)
  242. else
  243. thlcgjvm(hlcg).a_loadfpu_const_stack(current_asmdata.CurrAsmList,resultdef,18446744073709551616.0);
  244. if ressize=4 then
  245. current_asmdata.CurrAsmList.concat(taicpu.op_none(a_fadd))
  246. else
  247. current_asmdata.CurrAsmList.concat(taicpu.op_none(a_dadd));
  248. hlcg.a_label(current_asmdata.CurrAsmList,l1);
  249. end;
  250. thlcgjvm(hlcg).a_load_stack_reg(current_asmdata.CurrAsmList,resultdef,location.register);
  251. end;
  252. procedure tjvmtypeconvnode.second_bool_to_int;
  253. var
  254. newsize: tcgsize;
  255. oldTrueLabel,oldFalseLabel : tasmlabel;
  256. begin
  257. oldTrueLabel:=current_procinfo.CurrTrueLabel;
  258. oldFalseLabel:=current_procinfo.CurrFalseLabel;
  259. current_asmdata.getjumplabel(current_procinfo.CurrTrueLabel);
  260. current_asmdata.getjumplabel(current_procinfo.CurrFalseLabel);
  261. secondpass(left);
  262. location_copy(location,left.location);
  263. newsize:=def_cgsize(resultdef);
  264. { byte(bytebool) or word(wordbool) or longint(longbool) must be }
  265. { accepted for var parameters and assignments, and must not }
  266. { change the ordinal value or value location. }
  267. { htypechk.valid_for_assign ensures that such locations with a }
  268. { size<sizeof(register) cannot be LOC_CREGISTER (they otherwise }
  269. { could be in case of a plain assignment), and LOC_REGISTER can }
  270. { never be an assignment target. The remaining LOC_REGISTER/ }
  271. { LOC_CREGISTER locations do have to be sign/zero-extended. }
  272. { -- Note: this does not work for Java and 2/4 byte sized
  273. values, because bytebool/wordbool are signed and
  274. are stored in 4 byte locations -> will result in
  275. "byte" with the value high(cardinal); see remark
  276. in second_int_to_int above regarding consequences }
  277. if not(nf_explicit in flags) or
  278. (location.loc in [LOC_FLAGS,LOC_JUMP]) or
  279. ((newsize<>left.location.size) and
  280. ((left.resultdef.size<>resultdef.size) or
  281. not(left.resultdef.size in [4,8]))
  282. ) then
  283. hlcg.location_force_reg(current_asmdata.CurrAsmList,location,left.resultdef,resultdef,true)
  284. else
  285. { may differ in sign, e.g. bytebool -> byte }
  286. location.size:=newsize;
  287. current_procinfo.CurrTrueLabel:=oldTrueLabel;
  288. current_procinfo.CurrFalseLabel:=oldFalseLabel;
  289. end;
  290. procedure tjvmtypeconvnode.second_int_to_bool;
  291. var
  292. hlabel1,hlabel2,oldTrueLabel,oldFalseLabel : tasmlabel;
  293. newsize : tcgsize;
  294. begin
  295. oldTrueLabel:=current_procinfo.CurrTrueLabel;
  296. oldFalseLabel:=current_procinfo.CurrFalseLabel;
  297. current_asmdata.getjumplabel(current_procinfo.CurrTrueLabel);
  298. current_asmdata.getjumplabel(current_procinfo.CurrFalseLabel);
  299. secondpass(left);
  300. if codegenerror then
  301. exit;
  302. { Explicit typecasts from any ordinal type to a boolean type }
  303. { must not change the ordinal value }
  304. if (nf_explicit in flags) and
  305. not(left.location.loc in [LOC_FLAGS,LOC_JUMP]) then
  306. begin
  307. location_copy(location,left.location);
  308. newsize:=def_cgsize(resultdef);
  309. { change of size? change sign only if location is LOC_(C)REGISTER? Then we have to sign/zero-extend }
  310. if (tcgsize2size[newsize]<>tcgsize2size[left.location.size]) or
  311. ((newsize<>left.location.size) and (location.loc in [LOC_REGISTER,LOC_CREGISTER])) then
  312. hlcg.location_force_reg(current_asmdata.CurrAsmList,location,left.resultdef,resultdef,true)
  313. else
  314. location.size:=newsize;
  315. current_procinfo.CurrTrueLabel:=oldTrueLabel;
  316. current_procinfo.CurrFalseLabel:=oldFalseLabel;
  317. exit;
  318. end;
  319. location_reset(location,LOC_REGISTER,def_cgsize(resultdef));
  320. location.register:=hlcg.getintregister(current_asmdata.CurrAsmList,resultdef);
  321. current_asmdata.getjumplabel(hlabel2);
  322. case left.location.loc of
  323. LOC_CREFERENCE,LOC_REFERENCE,LOC_REGISTER,LOC_CREGISTER:
  324. begin
  325. current_asmdata.getjumplabel(hlabel1);
  326. hlcg.a_cmp_const_loc_label(current_asmdata.CurrAsmList,left.resultdef,OC_EQ,0,left.location,hlabel1);
  327. end;
  328. LOC_JUMP :
  329. begin
  330. hlabel1:=current_procinfo.CurrFalseLabel;
  331. hlcg.a_label(current_asmdata.CurrAsmList,current_procinfo.CurrTrueLabel);
  332. end;
  333. else
  334. internalerror(10062);
  335. end;
  336. if not(is_cbool(resultdef)) then
  337. thlcgjvm(hlcg).a_load_const_stack(current_asmdata.CurrAsmList,resultdef,1,R_INTREGISTER)
  338. else
  339. thlcgjvm(hlcg).a_load_const_stack(current_asmdata.CurrAsmList,resultdef,-1,R_INTREGISTER);
  340. { we jump over the next constant load -> they don't appear on the
  341. stack simulataneously }
  342. thlcgjvm(hlcg).decstack(current_asmdata.CurrAsmList,1);
  343. hlcg.a_jmp_always(current_asmdata.CurrAsmList,hlabel2);
  344. hlcg.a_label(current_asmdata.CurrAsmList,hlabel1);
  345. thlcgjvm(hlcg).a_load_const_stack(current_asmdata.CurrAsmList,resultdef,0,R_INTREGISTER);
  346. hlcg.a_label(current_asmdata.CurrAsmList,hlabel2);
  347. thlcgjvm(hlcg).a_load_stack_reg(current_asmdata.CurrAsmList,resultdef,location.register);
  348. current_procinfo.CurrTrueLabel:=oldTrueLabel;
  349. current_procinfo.CurrFalseLabel:=oldFalseLabel;
  350. end;
  351. procedure get_most_nested_types(var fromdef, todef: tdef);
  352. begin
  353. while is_dynamic_array(fromdef) and
  354. is_dynamic_array(todef) do
  355. begin
  356. fromdef:=tarraydef(fromdef).elementdef;
  357. todef:=tarraydef(todef).elementdef;
  358. end;
  359. end;
  360. function tjvmtypeconvnode.target_specific_explicit_typeconv: tnode;
  361. { handle explicit typecast from int to to real or vice versa }
  362. function int_real_explicit_typecast(fdef: tfloatdef; const singlemethod, doublemethod: string): tnode;
  363. var
  364. csym: ttypesym;
  365. psym: tsym;
  366. begin
  367. { use the float/double to raw bits methods to get the bit pattern }
  368. if fdef.floattype=s32real then
  369. begin
  370. csym:=search_system_type('JLFLOAT');
  371. psym:=search_struct_member(tobjectdef(csym.typedef),singlemethod);
  372. end
  373. else
  374. begin
  375. csym:=search_system_type('JLDOUBLE');
  376. psym:=search_struct_member(tobjectdef(csym.typedef),doublemethod);
  377. end;
  378. if not assigned(psym) or
  379. (psym.typ<>procsym) then
  380. internalerror(2011012901);
  381. { call the (static class) method to get the raw bits }
  382. result:=ccallnode.create(ccallparanode.create(left,nil),
  383. tprocsym(psym),psym.owner,
  384. cloadvmtaddrnode.create(ctypenode.create(csym.typedef)),[]);
  385. { convert the result to the result type of this type conversion node }
  386. inserttypeconv_explicit(result,resultdef);
  387. { left is reused }
  388. left:=nil;
  389. end;
  390. var
  391. fromclasscompatible,
  392. toclasscompatible: boolean;
  393. fromdef,
  394. todef: tdef;
  395. begin
  396. result:=nil;
  397. { This routine is only called for explicit typeconversions of same-sized
  398. entities that aren't handled by normal type conversions -> bit pattern
  399. reinterpretations. In the JVM, many of these also need special
  400. handling because of the type safety. }
  401. { don't allow conversions between object-based and non-object-based
  402. types }
  403. fromclasscompatible:=
  404. (left.resultdef.typ=objectdef) or
  405. is_dynamic_array(left.resultdef) or
  406. ((left.resultdef.typ=recorddef) and
  407. (resultdef.typ=objectdef));
  408. toclasscompatible:=
  409. (resultdef.typ=objectdef) or
  410. is_dynamic_array(resultdef) or
  411. ((resultdef.typ=recorddef) and
  412. (left.resultdef.typ=objectdef));
  413. if fromclasscompatible and toclasscompatible then
  414. begin
  415. { we need an as-node to check the validity of the conversion (since
  416. it wasn't handled by another type conversion, we know it can't
  417. have been valid normally)
  418. Exception: (most nested) destination is java.lang.Object, since
  419. everything is compatible with that type }
  420. fromdef:=left.resultdef;
  421. todef:=resultdef;
  422. get_most_nested_types(fromdef,todef);
  423. if not left.resultdef.is_related(resultdef) and
  424. (((fromdef.typ<>objectdef) and
  425. not is_dynamic_array(fromdef)) or
  426. (todef<>java_jlobject)) then
  427. begin
  428. result:=ctypenode.create(resultdef);
  429. if resultdef.typ=objectdef then
  430. result:=cloadvmtaddrnode.create(result);
  431. result:=casnode.create(left,result);
  432. left:=nil;
  433. end;
  434. exit;
  435. end;
  436. { don't allow conversions between different classes of primitive types,
  437. except for a few special cases }
  438. { float to int/enum explicit type conversion: get the bits }
  439. if (left.resultdef.typ=floatdef) and
  440. (is_integer(resultdef) or
  441. (resultdef.typ=enumdef)) then
  442. begin
  443. result:=int_real_explicit_typecast(tfloatdef(left.resultdef),'FLOATTORAWINTBITS','DOUBLETORAWLONGBITS');
  444. exit;
  445. end;
  446. { int to float explicit type conversion: also use the bits }
  447. if (is_integer(left.resultdef) or
  448. (left.resultdef.typ=enumdef)) and
  449. (resultdef.typ=floatdef) then
  450. begin
  451. result:=int_real_explicit_typecast(tfloatdef(resultdef),'INTBITSTOFLOAT','LONGBITSTODOUBLE');
  452. exit;
  453. end;
  454. { nothing special required when going between ordinals and enums }
  455. if (left.resultdef.typ in [orddef,enumdef])=(resultdef.typ in [orddef,enumdef]) then
  456. exit;
  457. { Todo:
  458. * int to set and vice versa
  459. * set to float and vice versa (via int) (maybe)
  460. * regular array of primitive to primitive and vice versa (maybe)
  461. * packed record to primitive and vice versa (maybe)
  462. Definitely not:
  463. * unpacked record to anything and vice versa (no alignment rules
  464. for Java)
  465. }
  466. { anything not explicitly handled is a problem }
  467. CGMessage2(type_e_illegal_type_conversion,left.resultdef.typename,resultdef.typename);
  468. end;
  469. function tjvmtypeconvnode.target_specific_general_typeconv(var res: tnode): boolean;
  470. begin
  471. result:=false;
  472. { deal with explicit typecasts between records and classes (for
  473. FpcBaseRecordType) }
  474. if ((left.resultdef.typ=recorddef) and
  475. (resultdef.typ=objectdef) and
  476. left.resultdef.is_related(resultdef)) or
  477. ((left.resultdef.typ=objectdef) and
  478. (resultdef.typ=recorddef) and
  479. resultdef.is_related(left.resultdef)) and
  480. (nf_explicit in flags) then
  481. begin
  482. convtype:=tc_equal;
  483. res:=target_specific_explicit_typeconv;
  484. result:=true;
  485. end;
  486. end;
  487. {*****************************************************************************
  488. AsNode and IsNode common helpers
  489. *****************************************************************************}
  490. function asis_target_specific_typecheck(node: tasisnode): boolean;
  491. var
  492. fromelt, toelt: tdef;
  493. realfromdef,
  494. realtodef: tdef;
  495. begin
  496. realfromdef:=maybe_find_real_class_definition(node.left.resultdef,false);
  497. realtodef:=node.right.resultdef;
  498. if realtodef.typ=classrefdef then
  499. realtodef:=tclassrefdef(realtodef).pointeddef;
  500. realtodef:=maybe_find_real_class_definition(realtodef,false);
  501. if is_record(realtodef) then
  502. result:=
  503. (realfromdef=java_jlobject) or
  504. (realfromdef=java_fpcbaserecordtype)
  505. else if is_record(realfromdef) then
  506. result:=
  507. (realtodef=java_jlobject) or
  508. (realtodef=java_fpcbaserecordtype)
  509. { dynamic arrays can be converted to java.lang.Object and vice versa }
  510. else if realtodef=java_jlobject then
  511. { dynamic array to java.lang.Object }
  512. result:=is_dynamic_array(realfromdef)
  513. else if is_dynamic_array(realtodef) then
  514. begin
  515. { <x> to dynamic array: only if possibly valid }
  516. fromelt:=node.left.resultdef;
  517. toelt:=realtodef;
  518. get_most_nested_types(fromelt,toelt);
  519. { final levels must be convertable:
  520. a) from array (dynamic or not) to java.lang.Object or vice versa,
  521. or
  522. b) the same primitive/class type
  523. }
  524. result:=
  525. (compare_defs(fromelt,toelt,node.left.nodetype) in [te_exact,te_equal]) or
  526. (((fromelt.typ=objectdef) or
  527. (fromelt.typ=arraydef)) and
  528. ((toelt.typ=objectdef) or
  529. (toelt.typ=arraydef)));
  530. end
  531. else
  532. begin
  533. { full class reference support requires using the Java reflection API,
  534. not yet implemented }
  535. if (node.right.nodetype<>loadvmtaddrn) or
  536. (tloadvmtaddrnode(node.right).left.nodetype<>typen) then
  537. internalerror(2011012601);
  538. result:=false;
  539. end;
  540. if result then
  541. if node.nodetype=asn then
  542. begin
  543. if realtodef.typ<>classrefdef then
  544. node.resultdef:=realtodef
  545. else
  546. node.resultdef:=tclassrefdef(realtodef).pointeddef
  547. end
  548. else
  549. node.resultdef:=pasbool8type;
  550. end;
  551. procedure asis_generate_code(node: tasisnode; opcode: tasmop);
  552. var
  553. checkdef: tdef;
  554. begin
  555. secondpass(node.left);
  556. thlcgjvm(hlcg).a_load_loc_stack(current_asmdata.CurrAsmList,node.left.resultdef,node.left.location);
  557. location_freetemp(current_asmdata.CurrAsmList,node.left.location);
  558. { Perform a checkcast instruction, which will raise an exception in case
  559. the actual type does not match/inherit from the expected type.
  560. Object types need the full type name (package+class name), arrays only
  561. the array definition }
  562. if node.nodetype=asn then
  563. checkdef:=node.resultdef
  564. else if node.right.resultdef.typ=classrefdef then
  565. checkdef:=tclassrefdef(node.right.resultdef).pointeddef
  566. else
  567. checkdef:=node.right.resultdef;
  568. if checkdef.typ in [objectdef,recorddef] then
  569. current_asmdata.CurrAsmList.concat(taicpu.op_sym(opcode,current_asmdata.RefAsmSymbol(tabstractrecorddef(checkdef).jvm_full_typename(true))))
  570. else
  571. current_asmdata.CurrAsmList.concat(taicpu.op_sym(opcode,current_asmdata.RefAsmSymbol(jvmencodetype(checkdef))));
  572. location_reset(node.location,LOC_REGISTER,OS_ADDR);
  573. node.location.register:=hlcg.getaddressregister(current_asmdata.CurrAsmList,node.resultdef);
  574. thlcgjvm(hlcg).a_load_stack_reg(current_asmdata.CurrAsmList,node.resultdef,node.location.register);
  575. end;
  576. {*****************************************************************************
  577. TJVMAsNode
  578. *****************************************************************************}
  579. function tjvmasnode.target_specific_typecheck: boolean;
  580. begin
  581. result:=asis_target_specific_typecheck(self);
  582. end;
  583. function tjvmasnode.pass_1: tnode;
  584. begin
  585. { call-by-reference does not exist in Java, so it's no problem to
  586. change a memory location to a register }
  587. firstpass(left);
  588. if right.nodetype<>typen then
  589. firstpass(right);
  590. expectloc:=LOC_REGISTER;
  591. result:=nil;
  592. end;
  593. procedure tjvmasnode.pass_generate_code;
  594. begin
  595. asis_generate_code(self,a_checkcast);
  596. end;
  597. {*****************************************************************************
  598. TJVMIsNode
  599. *****************************************************************************}
  600. function tjvmisnode.target_specific_typecheck: boolean;
  601. begin
  602. result:=asis_target_specific_typecheck(self);
  603. end;
  604. function tjvmisnode.pass_1: tnode;
  605. begin
  606. firstpass(left);
  607. if right.nodetype<>typen then
  608. firstpass(right);
  609. expectloc:=LOC_REGISTER;
  610. result:=nil;
  611. end;
  612. procedure tjvmisnode.pass_generate_code;
  613. begin
  614. asis_generate_code(self,a_instanceof);
  615. end;
  616. begin
  617. ctypeconvnode:=tjvmtypeconvnode;
  618. casnode:=tjvmasnode;
  619. cisnode:=tjvmisnode;
  620. end.