njvmcnv.pas 64 KB

1234567891011121314151617181920212223242526272829303132333435363738394041424344454647484950515253545556575859606162636465666768697071727374757677787980818283848586878889909192939495969798991001011021031041051061071081091101111121131141151161171181191201211221231241251261271281291301311321331341351361371381391401411421431441451461471481491501511521531541551561571581591601611621631641651661671681691701711721731741751761771781791801811821831841851861871881891901911921931941951961971981992002012022032042052062072082092102112122132142152162172182192202212222232242252262272282292302312322332342352362372382392402412422432442452462472482492502512522532542552562572582592602612622632642652662672682692702712722732742752762772782792802812822832842852862872882892902912922932942952962972982993003013023033043053063073083093103113123133143153163173183193203213223233243253263273283293303313323333343353363373383393403413423433443453463473483493503513523533543553563573583593603613623633643653663673683693703713723733743753763773783793803813823833843853863873883893903913923933943953963973983994004014024034044054064074084094104114124134144154164174184194204214224234244254264274284294304314324334344354364374384394404414424434444454464474484494504514524534544554564574584594604614624634644654664674684694704714724734744754764774784794804814824834844854864874884894904914924934944954964974984995005015025035045055065075085095105115125135145155165175185195205215225235245255265275285295305315325335345355365375385395405415425435445455465475485495505515525535545555565575585595605615625635645655665675685695705715725735745755765775785795805815825835845855865875885895905915925935945955965975985996006016026036046056066076086096106116126136146156166176186196206216226236246256266276286296306316326336346356366376386396406416426436446456466476486496506516526536546556566576586596606616626636646656666676686696706716726736746756766776786796806816826836846856866876886896906916926936946956966976986997007017027037047057067077087097107117127137147157167177187197207217227237247257267277287297307317327337347357367377387397407417427437447457467477487497507517527537547557567577587597607617627637647657667677687697707717727737747757767777787797807817827837847857867877887897907917927937947957967977987998008018028038048058068078088098108118128138148158168178188198208218228238248258268278288298308318328338348358368378388398408418428438448458468478488498508518528538548558568578588598608618628638648658668678688698708718728738748758768778788798808818828838848858868878888898908918928938948958968978988999009019029039049059069079089099109119129139149159169179189199209219229239249259269279289299309319329339349359369379389399409419429439449459469479489499509519529539549559569579589599609619629639649659669679689699709719729739749759769779789799809819829839849859869879889899909919929939949959969979989991000100110021003100410051006100710081009101010111012101310141015101610171018101910201021102210231024102510261027102810291030103110321033103410351036103710381039104010411042104310441045104610471048104910501051105210531054105510561057105810591060106110621063106410651066106710681069107010711072107310741075107610771078107910801081108210831084108510861087108810891090109110921093109410951096109710981099110011011102110311041105110611071108110911101111111211131114111511161117111811191120112111221123112411251126112711281129113011311132113311341135113611371138113911401141114211431144114511461147114811491150115111521153115411551156115711581159116011611162116311641165116611671168116911701171117211731174117511761177117811791180118111821183118411851186118711881189119011911192119311941195119611971198119912001201120212031204120512061207120812091210121112121213121412151216121712181219122012211222122312241225122612271228122912301231123212331234123512361237123812391240124112421243124412451246124712481249125012511252125312541255125612571258125912601261126212631264126512661267126812691270127112721273127412751276127712781279128012811282128312841285128612871288128912901291129212931294129512961297129812991300130113021303130413051306130713081309131013111312131313141315131613171318131913201321132213231324132513261327132813291330133113321333133413351336133713381339134013411342134313441345134613471348134913501351135213531354135513561357135813591360136113621363136413651366136713681369137013711372137313741375137613771378137913801381138213831384138513861387138813891390139113921393139413951396139713981399140014011402140314041405140614071408140914101411141214131414141514161417141814191420142114221423142414251426142714281429143014311432143314341435143614371438143914401441144214431444144514461447144814491450145114521453145414551456145714581459146014611462146314641465146614671468146914701471147214731474147514761477147814791480148114821483148414851486148714881489149014911492149314941495149614971498149915001501150215031504150515061507150815091510151115121513151415151516151715181519152015211522152315241525152615271528152915301531153215331534153515361537153815391540154115421543154415451546154715481549155015511552155315541555155615571558155915601561156215631564156515661567156815691570157115721573157415751576157715781579158015811582158315841585158615871588158915901591159215931594159515961597159815991600160116021603160416051606160716081609161016111612161316141615161616171618161916201621162216231624162516261627162816291630163116321633163416351636163716381639164016411642164316441645164616471648164916501651165216531654165516561657165816591660
  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. class function target_specific_need_equal_typeconv(fromdef, todef: tdef): boolean; override;
  25. function typecheck_dynarray_to_openarray: tnode; override;
  26. function typecheck_string_to_chararray: tnode; override;
  27. function typecheck_string_to_string: tnode;override;
  28. function typecheck_char_to_string: tnode; override;
  29. function typecheck_proc_to_procvar: tnode; override;
  30. function pass_1: tnode; override;
  31. function simplify(forinline: boolean): tnode; override;
  32. function first_cstring_to_pchar: tnode;override;
  33. function first_set_to_set : tnode;override;
  34. function first_nil_to_methodprocvar: tnode; override;
  35. function first_proc_to_procvar: tnode; override;
  36. function first_ansistring_to_pchar: tnode; override;
  37. procedure second_int_to_int;override;
  38. procedure second_cstring_to_pchar;override;
  39. { procedure second_string_to_chararray;override; }
  40. { procedure second_array_to_pointer;override; }
  41. function first_int_to_real: tnode; override;
  42. procedure second_pointer_to_array;override;
  43. { procedure second_chararray_to_string;override; }
  44. { procedure second_char_to_string;override; }
  45. procedure second_int_to_real;override;
  46. { procedure second_real_to_real;override; }
  47. { procedure second_cord_to_pointer;override; }
  48. procedure second_proc_to_procvar;override;
  49. procedure second_nil_to_methodprocvar;override;
  50. procedure second_bool_to_int;override;
  51. procedure second_int_to_bool;override;
  52. { procedure second_load_smallset;override; }
  53. { procedure second_ansistring_to_pchar;override; }
  54. { procedure second_pchar_to_string;override; }
  55. { procedure second_class_to_intf;override; }
  56. { procedure second_char_to_char;override; }
  57. procedure second_elem_to_openarray; override;
  58. function target_specific_explicit_typeconv: boolean; override;
  59. function target_specific_general_typeconv: boolean; override;
  60. protected
  61. function do_target_specific_explicit_typeconv(check_only: boolean; out resnode: tnode): boolean;
  62. end;
  63. tjvmasnode = class(tcgasnode)
  64. protected
  65. { to discern beween "obj as tclassref" and "tclassref(obj)" }
  66. classreftypecast: boolean;
  67. function target_specific_typecheck: boolean;override;
  68. public
  69. function pass_1 : tnode;override;
  70. procedure pass_generate_code; override;
  71. function dogetcopy: tnode; override;
  72. function docompare(p: tnode): boolean; override;
  73. constructor ppuload(t: tnodetype; ppufile: tcompilerppufile); override;
  74. procedure ppuwrite(ppufile: tcompilerppufile); override;
  75. end;
  76. tjvmisnode = class(tisnode)
  77. protected
  78. function target_specific_typecheck: boolean;override;
  79. public
  80. function pass_1 : tnode;override;
  81. procedure pass_generate_code; override;
  82. end;
  83. implementation
  84. uses
  85. verbose,globals,globtype,constexp,cutils,
  86. symbase,symconst,symdef,symsym,symcpu,symtable,aasmbase,aasmdata,
  87. defutil,defcmp,jvmdef,
  88. cgbase,cgutils,pass_1,pass_2,
  89. nbas,ncon,ncal,ninl,nld,nmem,procinfo,
  90. nutils,paramgr,
  91. cpubase,cpuinfo,aasmcpu,
  92. tgobj,hlcgobj,hlcgcpu;
  93. {*****************************************************************************
  94. TypeCheckTypeConv
  95. *****************************************************************************}
  96. function isvalidprocvartypeconv(fromdef, todef: tdef): boolean;
  97. var
  98. tmethoddef: tdef;
  99. function docheck(def1,def2: tdef): boolean;
  100. begin
  101. result:=false;
  102. if def1.typ<>procvardef then
  103. exit;
  104. { is_addressonly procvars are treated like regular pointer-sized data,
  105. po_methodpointer procvars like implicit pointers to a struct }
  106. if tprocvardef(def1).is_addressonly then
  107. result:=
  108. ((def2.typ=procvardef) and
  109. tprocvardef(def2).is_addressonly) or
  110. (def2=java_jlobject) or
  111. (def2=voidpointertype)
  112. else if po_methodpointer in tprocvardef(def1).procoptions then
  113. begin
  114. if not assigned(tmethoddef) then
  115. tmethoddef:=search_system_type('TMETHOD').typedef;
  116. result:=
  117. (def2=methodpointertype) or
  118. (def2=tmethoddef) or
  119. ((def2.typ=procvardef) and
  120. (po_methodpointer in tprocvardef(def2).procoptions));
  121. end;
  122. { can't typecast nested procvars, they need 3 data pointers }
  123. end;
  124. begin
  125. tmethoddef:=nil;
  126. result:=
  127. docheck(fromdef,todef) or
  128. docheck(todef,fromdef);
  129. end;
  130. class function tjvmtypeconvnode.target_specific_need_equal_typeconv(fromdef, todef: tdef): boolean;
  131. begin
  132. result:=
  133. (fromdef<>todef) and
  134. { two procdefs that are structurally the same but semantically different
  135. still need a convertion }
  136. (
  137. ((fromdef.typ=procvardef) and
  138. (todef.typ=procvardef))
  139. );
  140. end;
  141. function tjvmtypeconvnode.typecheck_dynarray_to_openarray: tnode;
  142. begin
  143. { all arrays are equal in Java }
  144. result:=nil;
  145. convtype:=tc_equal;
  146. end;
  147. function tjvmtypeconvnode.typecheck_string_to_chararray: tnode;
  148. var
  149. newblock: tblocknode;
  150. newstat: tstatementnode;
  151. restemp: ttempcreatenode;
  152. chartype: string;
  153. begin
  154. if (left.nodetype = stringconstn) and
  155. (tstringconstnode(left).cst_type=cst_conststring) then
  156. inserttypeconv(left,cunicodestringtype);
  157. { even constant strings have to be handled via a helper }
  158. if is_widechar(tarraydef(resultdef).elementdef) then
  159. chartype:='widechar'
  160. else
  161. chartype:='char';
  162. newblock:=internalstatements(newstat);
  163. restemp:=ctempcreatenode.create(resultdef,resultdef.size,tt_persistent,false);
  164. addstatement(newstat,restemp);
  165. addstatement(newstat,ccallnode.createintern('fpc_'+tstringdef(left.resultdef).stringtypname+
  166. '_to_'+chartype+'array',ccallparanode.create(left,ccallparanode.create(
  167. ctemprefnode.create(restemp),nil))));
  168. addstatement(newstat,ctempdeletenode.create_normal_temp(restemp));
  169. addstatement(newstat,ctemprefnode.create(restemp));
  170. result:=newblock;
  171. left:=nil;
  172. end;
  173. function tjvmtypeconvnode.typecheck_string_to_string: tnode;
  174. begin
  175. { make sure the generic code gets a stringdef }
  176. if (maybe_find_real_class_definition(resultdef,false)=java_jlstring) or
  177. (maybe_find_real_class_definition(left.resultdef,false)=java_jlstring) then
  178. begin
  179. left:=ctypeconvnode.create(left,cunicodestringtype);
  180. left.flags:=flags;
  181. result:=ctypeconvnode.create(left,resultdef);
  182. result.flags:=flags;
  183. left:=nil;
  184. end
  185. else
  186. result:=inherited;
  187. end;
  188. function tjvmtypeconvnode.typecheck_char_to_string: tnode;
  189. begin
  190. { make sure the generic code gets a stringdef }
  191. if self.totypedef=java_jlstring then
  192. begin
  193. inserttypeconv(left,cunicodestringtype);
  194. inserttypeconv(left,totypedef);
  195. result:=left;
  196. left:=nil;
  197. exit;
  198. end;
  199. result:=inherited;
  200. end;
  201. function tjvmtypeconvnode.typecheck_proc_to_procvar: tnode;
  202. begin
  203. result:=inherited typecheck_proc_to_procvar;
  204. if not assigned(totypedef) or
  205. (totypedef.typ<>procvardef) then
  206. begin
  207. if assigned(tcpuprocvardef(resultdef).classdef) then
  208. internalerror(2011072405);
  209. { associate generic classdef; this is the result of an @proc
  210. expression, and such expressions can never result in a direct call
  211. -> no invoke() method required (which only exists in custom
  212. constructed descendents created for defined procvar types) }
  213. if is_nested_pd(tabstractprocdef(resultdef)) then
  214. { todo }
  215. internalerror(2011072406)
  216. else
  217. tcpuprocvardef(resultdef).classdef:=java_procvarbase;
  218. end;
  219. end;
  220. {*****************************************************************************
  221. FirstTypeConv
  222. *****************************************************************************}
  223. function tjvmtypeconvnode.first_int_to_real: tnode;
  224. begin
  225. if not is_64bitint(left.resultdef) and
  226. not is_currency(left.resultdef) then
  227. if is_signed(left.resultdef) or
  228. (left.resultdef.size<4) then
  229. inserttypeconv(left,s32inttype)
  230. else
  231. inserttypeconv(left,u32inttype);
  232. firstpass(left);
  233. result := nil;
  234. expectloc:=LOC_FPUREGISTER;
  235. end;
  236. function tjvmtypeconvnode.pass_1: tnode;
  237. begin
  238. if (nf_explicit in flags) or
  239. { some implicit type conversions from voidpointer to other types
  240. (such as dynamic array) are allowed too, even though the types are
  241. incompatible -> make sure we check those too and insert checkcast
  242. instructions as necessary }
  243. (is_voidpointer(left.resultdef) and
  244. not is_voidpointer(resultdef)) then
  245. begin
  246. do_target_specific_explicit_typeconv(false,result);
  247. if assigned(result) then
  248. exit;
  249. end;
  250. result:=inherited pass_1;
  251. end;
  252. function tjvmtypeconvnode.simplify(forinline: boolean): tnode;
  253. begin
  254. result:=inherited simplify(forinline);
  255. if assigned(result) then
  256. exit;
  257. { string constants passed to java.lang.String must be converted to
  258. widestring }
  259. if ((is_conststringnode(left) and
  260. not(tstringconstnode(left).cst_type in [cst_unicodestring,cst_widestring])) or
  261. is_constcharnode(left)) and
  262. (maybe_find_real_class_definition(resultdef,false)=java_jlstring) then
  263. inserttypeconv(left,cunicodestringtype);
  264. end;
  265. function tjvmtypeconvnode.first_cstring_to_pchar: tnode;
  266. var
  267. vs: tstaticvarsym;
  268. begin
  269. result:=inherited;
  270. if assigned(result) then
  271. exit;
  272. { nil pointer -> valid address }
  273. if (left.nodetype=stringconstn) and
  274. (tstringconstnode(left).cst_type in [cst_widestring,cst_unicodestring,cst_ansistring]) and
  275. (tstringconstnode(left).len=0) then
  276. begin
  277. if tstringconstnode(left).cst_type=cst_ansistring then
  278. vs:=tstaticvarsym(systemunit.Find('FPC_EMPTYANSICHAR'))
  279. else
  280. vs:=tstaticvarsym(systemunit.Find('FPC_EMPTYWIDECHAR'));
  281. if not assigned(vs) then
  282. internalerror(2012052605);
  283. result:=caddrnode.create(cloadnode.create(vs,vs.owner));
  284. result:=ctypeconvnode.create_explicit(result,resultdef);
  285. end;
  286. end;
  287. function tjvmtypeconvnode.first_set_to_set: tnode;
  288. var
  289. setclassdef: tdef;
  290. helpername: string;
  291. begin
  292. result:=nil;
  293. if (left.nodetype=setconstn) then
  294. result:=inherited
  295. { on native targets, only the binary layout has to match. Here, both
  296. sets also have to be either of enums or ordinals, and in case of
  297. enums they have to be of the same base type }
  298. else if (tsetdef(left.resultdef).elementdef.typ=enumdef)=(tsetdef(resultdef).elementdef.typ=enumdef) and
  299. ((tsetdef(left.resultdef).elementdef.typ<>enumdef) or
  300. (tenumdef(tsetdef(left.resultdef).elementdef).getbasedef=tenumdef(tsetdef(resultdef).elementdef).getbasedef)) and
  301. (tsetdef(left.resultdef).setbase=tsetdef(resultdef).setbase) and
  302. (left.resultdef.size=resultdef.size) then
  303. begin
  304. result:=left;
  305. left:=nil;
  306. end
  307. else
  308. begin
  309. { 'deep' conversion }
  310. if tsetdef(resultdef).elementdef.typ<>enumdef then
  311. begin
  312. if tsetdef(left.resultdef).elementdef.typ<>enumdef then
  313. helpername:='fpc_bitset_to_bitset'
  314. else
  315. helpername:='fpc_enumset_to_bitset';
  316. result:=ccallnode.createintern(helpername,ccallparanode.create(
  317. genintconstnode(tsetdef(resultdef).setbase), ccallparanode.create(
  318. genintconstnode(tsetdef(left.resultdef).setbase),
  319. ccallparanode.create(left,nil))));
  320. end
  321. else
  322. begin
  323. if tsetdef(left.resultdef).elementdef.typ<>enumdef then
  324. begin
  325. helpername:='fpcBitSetToEnumSet';
  326. setclassdef:=java_jubitset;
  327. end
  328. else
  329. begin
  330. helpername:='fpcEnumSetToEnumSet';
  331. setclassdef:=java_juenumset;
  332. end;
  333. left:=caddrnode.create_internal(left);
  334. include(left.flags,nf_typedaddr);
  335. inserttypeconv_explicit(left,setclassdef);
  336. result:=ccallnode.createinternmethod(
  337. cloadvmtaddrnode.create(ctypenode.create(setclassdef)),
  338. helpername,ccallparanode.create(
  339. genintconstnode(tsetdef(resultdef).setbase), ccallparanode.create(
  340. genintconstnode(tsetdef(left.resultdef).setbase),
  341. ccallparanode.create(left,nil))));
  342. end;
  343. inserttypeconv_explicit(result,cpointerdef.getreusable(resultdef));
  344. result:=cderefnode.create(result);
  345. { reused }
  346. left:=nil;
  347. end;
  348. end;
  349. function tjvmtypeconvnode.first_nil_to_methodprocvar: tnode;
  350. begin
  351. result:=inherited first_nil_to_methodprocvar;
  352. if assigned(result) then
  353. exit;
  354. if not assigned(tcpuprocvardef(resultdef).classdef) then
  355. tcpuprocvardef(resultdef).classdef:=java_procvarbase;
  356. result:=ccallnode.createinternmethod(
  357. cloadvmtaddrnode.create(ctypenode.create(tcpuprocvardef(resultdef).classdef)),'CREATE',nil);
  358. { method pointer is an implicit pointer type }
  359. result:=ctypeconvnode.create_explicit(result,cpointerdef.getreusable(resultdef));
  360. result:=cderefnode.create(result);
  361. end;
  362. function tjvmtypeconvnode.first_proc_to_procvar: tnode;
  363. var
  364. constrparas: tcallparanode;
  365. newpara: tnode;
  366. procdefparas: tarrayconstructornode;
  367. pvs: tparavarsym;
  368. fvs: tsym;
  369. i: longint;
  370. corrclass: tdef;
  371. jlclass: tobjectdef;
  372. encodedtype: tsymstr;
  373. procload: tnode;
  374. procdef: tprocdef;
  375. st: tsymtable;
  376. pushaddr: boolean;
  377. begin
  378. result:=inherited first_proc_to_procvar;
  379. if assigned(result) then
  380. exit;
  381. procdef:=tloadnode(left).procdef;
  382. procload:=tloadnode(left).left;
  383. if not assigned(procload) then
  384. begin
  385. { nested or regular routine -> figure out whether unit-level or
  386. nested, and if nested whether it's nested in a method or in a
  387. regular routine }
  388. st:=procdef.owner;
  389. while st.symtabletype=localsymtable do
  390. st:=st.defowner.owner;
  391. if st.symtabletype in [objectsymtable,recordsymtable] then
  392. { nested routine in method -> part of encloding class }
  393. procload:=cloadvmtaddrnode.create(ctypenode.create(tdef(st.defowner)))
  394. else
  395. begin
  396. { regular procedure/function -> get type representing unit
  397. class }
  398. while not(st.symtabletype in [staticsymtable,globalsymtable]) do
  399. st:=st.defowner.owner;
  400. corrclass:=search_named_unit_globaltype(st.realname^,'__FPC_JVM_MODULE_CLASS_ALIAS$',true).typedef;
  401. procload:=cloadvmtaddrnode.create(ctypenode.create(tdef(corrclass)));
  402. end;
  403. end;
  404. { todo: support nested procvars }
  405. if is_nested_pd(procdef) then
  406. internalerror(2011072607);
  407. { constructor FpcBaseProcVarType.create(inst: jlobject; const method: unicodestring; const argTypes: array of JLClass); }
  408. constrparas:=ccallparanode.create(ctypeconvnode.create_explicit(procload,java_jlobject),nil);
  409. if not assigned(procdef.import_name) then
  410. constrparas:=ccallparanode.create(cstringconstnode.createstr(procdef.procsym.realname),constrparas)
  411. else
  412. constrparas:=ccallparanode.create(cstringconstnode.createstr(procdef.import_name^),constrparas);
  413. procdefparas:=nil;
  414. jlclass:=tobjectdef(search_system_type('JLCLASS').typedef);
  415. { in reverse to make it easier to build the arrayconstructorn }
  416. for i:=procdef.paras.count-1 downto 0 do
  417. begin
  418. pvs:=tparavarsym(procdef.paras[i]);
  419. { self is is an implicit parameter for normal methods }
  420. if (vo_is_self in pvs.varoptions) and
  421. not(po_classmethod in procdef.procoptions) then
  422. continue;
  423. { in case of an arraydef, pass by jlclass.forName() to get the classdef
  424. (could be optimized by adding support to loadvmtaddrnode to also deal
  425. with arrays, although we'd have to create specific arraydefs for var/
  426. out/constref parameters }
  427. pushaddr:=paramanager.push_copyout_param(pvs.varspez,pvs.vardef,procdef.proccalloption);
  428. if pushaddr or
  429. (pvs.vardef.typ=arraydef) then
  430. begin
  431. encodedtype:=jvmencodetype(pvs.vardef,false);
  432. if pushaddr then
  433. encodedtype:='['+encodedtype;
  434. replace(encodedtype,'/','.');
  435. newpara:=ccallnode.createinternmethod(cloadvmtaddrnode.create(ctypenode.create(jlclass)),'FORNAME',
  436. ccallparanode.create(cstringconstnode.createstr(encodedtype),nil));
  437. end
  438. else
  439. begin
  440. corrclass:=jvmgetcorrespondingclassdef(pvs.vardef);
  441. if pvs.vardef.typ in [orddef,floatdef] then
  442. begin
  443. { get the class representing the primitive type }
  444. fvs:=search_struct_member(tobjectdef(corrclass),'FTYPE');
  445. newpara:=nil;
  446. if not handle_staticfield_access(fvs,newpara) then
  447. internalerror(2011072417);
  448. end
  449. else
  450. newpara:=cloadvmtaddrnode.create(ctypenode.create(corrclass));
  451. newpara:=ctypeconvnode.create_explicit(newpara,jlclass);
  452. end;
  453. procdefparas:=carrayconstructornode.create(newpara,procdefparas);
  454. end;
  455. if not assigned(procdefparas) then
  456. procdefparas:=carrayconstructornode.create(nil,nil);
  457. constrparas:=ccallparanode.create(procdefparas,constrparas);
  458. result:=ccallnode.createinternmethod(cloadvmtaddrnode.create(ctypenode.create(tcpuprocvardef(resultdef).classdef)),'CREATE',constrparas);
  459. { typecast to the procvar type }
  460. if tprocvardef(resultdef).is_addressonly then
  461. result:=ctypeconvnode.create_explicit(result,resultdef)
  462. else
  463. begin
  464. result:=ctypeconvnode.create_explicit(result,cpointerdef.getreusable(resultdef));
  465. result:=cderefnode.create(result)
  466. end;
  467. { reused }
  468. tloadnode(left).left:=nil;
  469. end;
  470. function tjvmtypeconvnode.first_ansistring_to_pchar: tnode;
  471. var
  472. ps: tsym;
  473. begin
  474. { also called for unicodestring->pwidechar, not supported since we can't
  475. directly access the characters in java.lang.String }
  476. if not is_ansistring(left.resultdef) or
  477. not is_pchar(resultdef) then
  478. begin
  479. CGMessage2(type_e_illegal_type_conversion,left.resultdef.typename,resultdef.typename);
  480. result:=nil;
  481. exit;
  482. end;
  483. ps:=search_struct_member(java_ansistring,'INTERNCHARS');
  484. if not assigned(ps) or
  485. (ps.typ<>procsym) then
  486. internalerror(2011081401);
  487. { AnsistringClass.internChars is a static class method that will either
  488. return the internal fdata ansichar array of the string, or an array
  489. with a single #0 }
  490. result:=ccallnode.create(ccallparanode.create(left,nil),tprocsym(ps),
  491. ps.owner,
  492. cloadvmtaddrnode.create(ctypenode.create(java_ansistring)),[],nil);
  493. include(result.flags,nf_isproperty);
  494. result:=ctypeconvnode.create_explicit(result,resultdef);
  495. { reused }
  496. left:=nil;
  497. end;
  498. {*****************************************************************************
  499. SecondTypeConv
  500. *****************************************************************************}
  501. procedure tjvmtypeconvnode.second_int_to_int;
  502. var
  503. ressize,
  504. leftsize : longint;
  505. begin
  506. { insert range check if not explicit conversion }
  507. if not(nf_explicit in flags) then
  508. hlcg.g_rangecheck(current_asmdata.CurrAsmList,left.location,left.resultdef,resultdef);
  509. { is the result size smaller? when typecasting from void
  510. we always reuse the current location, because there is
  511. nothing that we can load in a register }
  512. ressize:=resultdef.size;
  513. leftsize :=left.resultdef.size;
  514. if ((ressize<>leftsize) or
  515. ((left.location.loc in [LOC_REFERENCE,LOC_CREFERENCE]) and
  516. (left.location.reference.arrayreftype<>art_none) and
  517. (is_widechar(left.resultdef)<>is_widechar(resultdef))) or
  518. is_bitpacked_access(left)) and
  519. not is_void(left.resultdef) then
  520. begin
  521. location_copy(location,left.location);
  522. { reuse a loc_reference when the newsize is larger than
  523. than the original and 4 bytes, because all <= 4 byte loads will
  524. result in a stack slot that occupies 4 bytes.
  525. Except
  526. a) for arrays (they use different load instructions for
  527. differently sized data types) or symbols (idem)
  528. b) when going from 4 to 8 bytes, because these are different
  529. data types
  530. }
  531. if (location.loc in [LOC_REFERENCE,LOC_CREFERENCE]) and
  532. not assigned(location.reference.symbol) and
  533. (location.reference.arrayreftype=art_none) and
  534. (ressize>leftsize) and
  535. (ressize=4) then
  536. begin
  537. location.size:=def_cgsize(resultdef);
  538. { no adjustment of the offset even though Java is big endian,
  539. because the load instruction will remain the same }
  540. end
  541. else
  542. hlcg.location_force_reg(current_asmdata.CurrAsmList,location,left.resultdef,resultdef,false);
  543. end
  544. else
  545. begin
  546. if ((ressize < sizeof(aint)) and
  547. (def_cgsize(left.resultdef)<>def_cgsize(resultdef))) or
  548. (is_widechar(left.resultdef)<>is_widechar(resultdef)) then
  549. begin
  550. location_reset(location,LOC_REGISTER,def_cgsize(resultdef));
  551. location.register:=hlcg.getintregister(current_asmdata.CurrAsmList,resultdef);
  552. hlcg.a_load_loc_reg(current_asmdata.CurrAsmList,left.resultdef,resultdef,left.location,location.register);
  553. end
  554. else
  555. location_copy(location,left.location);
  556. end;
  557. end;
  558. procedure tjvmtypeconvnode.second_cstring_to_pchar;
  559. begin
  560. location_copy(location,left.location);
  561. end;
  562. procedure tjvmtypeconvnode.second_pointer_to_array;
  563. begin
  564. { arrays are implicit pointers in Java -> same location }
  565. location_copy(location,left.location);
  566. end;
  567. procedure tjvmtypeconvnode.second_int_to_real;
  568. var
  569. srcsize, ressize: longint;
  570. procedure convertsignedstackloc;
  571. begin
  572. case srcsize of
  573. 4:
  574. case ressize of
  575. 4:
  576. current_asmdata.CurrAsmList.concat(taicpu.op_none(a_i2f));
  577. 8:
  578. begin
  579. current_asmdata.CurrAsmList.concat(taicpu.op_none(a_i2d));
  580. thlcgjvm(hlcg).incstack(current_asmdata.CurrAsmList,1);
  581. end;
  582. else
  583. internalerror(2011010601);
  584. end;
  585. 8:
  586. case ressize of
  587. 4:
  588. begin
  589. current_asmdata.CurrAsmList.concat(taicpu.op_none(a_l2f));
  590. thlcgjvm(hlcg).decstack(current_asmdata.CurrAsmList,1);
  591. end;
  592. 8:
  593. current_asmdata.CurrAsmList.concat(taicpu.op_none(a_l2d));
  594. else
  595. internalerror(2011010602);
  596. end;
  597. else
  598. internalerror(2011010603);
  599. end;
  600. end;
  601. var
  602. signeddef : tdef;
  603. l1 : tasmlabel;
  604. begin
  605. srcsize:=left.resultdef.size;
  606. ressize:=resultdef.size;
  607. location_reset(location,LOC_FPUREGISTER,def_cgsize(resultdef));
  608. location.register:=hlcg.getfpuregister(current_asmdata.CurrAsmList,resultdef);
  609. { first always convert as if it's a signed number }
  610. thlcgjvm(hlcg).a_load_loc_stack(current_asmdata.CurrAsmList,left.resultdef,left.location);
  611. convertsignedstackloc;
  612. if not is_signed(left.resultdef) then
  613. begin
  614. { if it was unsigned, add high(cardinal)+1/high(qword)+1 in case
  615. the signed interpretation is < 0 }
  616. current_asmdata.getjumplabel(l1);
  617. if srcsize=4 then
  618. signeddef:=s32inttype
  619. else
  620. signeddef:=s64inttype;
  621. hlcg.a_cmp_const_loc_label(current_asmdata.CurrAsmList,signeddef,OC_GTE,0,left.location,l1);
  622. if srcsize=4 then
  623. thlcgjvm(hlcg).a_loadfpu_const_stack(current_asmdata.CurrAsmList,resultdef,4294967296.0)
  624. else
  625. thlcgjvm(hlcg).a_loadfpu_const_stack(current_asmdata.CurrAsmList,resultdef,18446744073709551616.0);
  626. if ressize=4 then
  627. current_asmdata.CurrAsmList.concat(taicpu.op_none(a_fadd))
  628. else
  629. current_asmdata.CurrAsmList.concat(taicpu.op_none(a_dadd));
  630. hlcg.a_label(current_asmdata.CurrAsmList,l1);
  631. end;
  632. thlcgjvm(hlcg).a_load_stack_reg(current_asmdata.CurrAsmList,resultdef,location.register);
  633. end;
  634. procedure tjvmtypeconvnode.second_proc_to_procvar;
  635. begin
  636. internalerror(2011072506);
  637. end;
  638. procedure tjvmtypeconvnode.second_nil_to_methodprocvar;
  639. var
  640. r: Treference;
  641. begin
  642. tg.gethltemp(current_asmdata.currasmlist,java_jlobject,java_jlobject.size,tt_normal,r);
  643. hlcg.a_load_const_ref(current_asmdata.CurrAsmList,java_jlobject,0,r);
  644. location_reset_ref(location,LOC_REFERENCE,def_cgsize(resultdef),1);
  645. location.reference:=r;
  646. end;
  647. procedure tjvmtypeconvnode.second_bool_to_int;
  648. var
  649. newsize: tcgsize;
  650. begin
  651. secondpass(left);
  652. location_copy(location,left.location);
  653. newsize:=def_cgsize(resultdef);
  654. { byte(bytebool) or word(wordbool) or longint(longbool) must be }
  655. { accepted for var parameters and assignments, and must not }
  656. { change the ordinal value or value location. }
  657. { htypechk.valid_for_assign ensures that such locations with a }
  658. { size<sizeof(register) cannot be LOC_CREGISTER (they otherwise }
  659. { could be in case of a plain assignment), and LOC_REGISTER can }
  660. { never be an assignment target. The remaining LOC_REGISTER/ }
  661. { LOC_CREGISTER locations do have to be sign/zero-extended. }
  662. { -- Note: this does not work for Java and 2/4 byte sized
  663. values, because bytebool/wordbool are signed and
  664. are stored in 4 byte locations -> will result in
  665. "byte" with the value high(cardinal); see remark
  666. in second_int_to_int above regarding consequences }
  667. if not(nf_explicit in flags) or
  668. (location.loc in [LOC_FLAGS,LOC_JUMP]) or
  669. ((newsize<>left.location.size) and
  670. ((left.resultdef.size<>resultdef.size) or
  671. not(left.resultdef.size in [4,8]))
  672. ) then
  673. hlcg.location_force_reg(current_asmdata.CurrAsmList,location,left.resultdef,resultdef,true)
  674. else
  675. { may differ in sign, e.g. bytebool -> byte }
  676. location.size:=newsize;
  677. end;
  678. procedure tjvmtypeconvnode.second_int_to_bool;
  679. var
  680. hlabel1,hlabel2: tasmlabel;
  681. newsize : tcgsize;
  682. begin
  683. secondpass(left);
  684. if codegenerror then
  685. exit;
  686. { Explicit typecasts from any ordinal type to a boolean type }
  687. { must not change the ordinal value }
  688. { Exception: Android verifier... }
  689. if (nf_explicit in flags) and
  690. not(left.location.loc in [LOC_FLAGS,LOC_JUMP]) and
  691. not(current_settings.cputype=cpu_dalvik) then
  692. begin
  693. location_copy(location,left.location);
  694. newsize:=def_cgsize(resultdef);
  695. { change of size? change sign only if location is LOC_(C)REGISTER? Then we have to sign/zero-extend }
  696. if (tcgsize2size[newsize]<>tcgsize2size[left.location.size]) or
  697. ((newsize<>left.location.size) and (location.loc in [LOC_REGISTER,LOC_CREGISTER])) then
  698. hlcg.location_force_reg(current_asmdata.CurrAsmList,location,left.resultdef,resultdef,true)
  699. else
  700. location.size:=newsize;
  701. exit;
  702. end;
  703. location_reset(location,LOC_REGISTER,def_cgsize(resultdef));
  704. location.register:=hlcg.getintregister(current_asmdata.CurrAsmList,resultdef);
  705. current_asmdata.getjumplabel(hlabel2);
  706. case left.location.loc of
  707. LOC_CREFERENCE,LOC_REFERENCE,LOC_REGISTER,LOC_CREGISTER:
  708. begin
  709. current_asmdata.getjumplabel(hlabel1);
  710. hlcg.a_cmp_const_loc_label(current_asmdata.CurrAsmList,left.resultdef,OC_EQ,0,left.location,hlabel1);
  711. end;
  712. LOC_JUMP :
  713. begin
  714. hlabel1:=left.location.falselabel;
  715. hlcg.a_label(current_asmdata.CurrAsmList,left.location.truelabel);
  716. end;
  717. else
  718. internalerror(10062);
  719. end;
  720. if not(is_cbool(resultdef)) then
  721. thlcgjvm(hlcg).a_load_const_stack(current_asmdata.CurrAsmList,resultdef,1,R_INTREGISTER)
  722. else
  723. thlcgjvm(hlcg).a_load_const_stack(current_asmdata.CurrAsmList,resultdef,-1,R_INTREGISTER);
  724. { we jump over the next constant load -> they don't appear on the
  725. stack simulataneously }
  726. thlcgjvm(hlcg).decstack(current_asmdata.CurrAsmList,1);
  727. hlcg.a_jmp_always(current_asmdata.CurrAsmList,hlabel2);
  728. hlcg.a_label(current_asmdata.CurrAsmList,hlabel1);
  729. thlcgjvm(hlcg).a_load_const_stack(current_asmdata.CurrAsmList,resultdef,0,R_INTREGISTER);
  730. hlcg.a_label(current_asmdata.CurrAsmList,hlabel2);
  731. thlcgjvm(hlcg).a_load_stack_reg(current_asmdata.CurrAsmList,resultdef,location.register);
  732. end;
  733. procedure tjvmtypeconvnode.second_elem_to_openarray;
  734. var
  735. primitivetype: boolean;
  736. opc: tasmop;
  737. mangledname: string;
  738. basereg: tregister;
  739. arrayref: treference;
  740. begin
  741. { create an array with one element of the required type }
  742. thlcgjvm(hlcg).a_load_const_stack(current_asmdata.CurrAsmList,s32inttype,1,R_INTREGISTER);
  743. mangledname:=jvmarrtype(left.resultdef,primitivetype);
  744. if primitivetype then
  745. opc:=a_newarray
  746. else
  747. opc:=a_anewarray;
  748. { doesn't change stack height: one int replaced by one reference }
  749. current_asmdata.CurrAsmList.concat(taicpu.op_sym(opc,current_asmdata.RefAsmSymbol(mangledname)));
  750. { store the data in the newly created array }
  751. basereg:=hlcg.getaddressregister(current_asmdata.CurrAsmList,java_jlobject);
  752. thlcgjvm(hlcg).a_load_stack_reg(current_asmdata.CurrAsmList,java_jlobject,basereg);
  753. reference_reset_base(arrayref,basereg,0,4);
  754. arrayref.arrayreftype:=art_indexconst;
  755. arrayref.indexoffset:=0;
  756. hlcg.a_load_loc_ref(current_asmdata.CurrAsmList,left.resultdef,left.resultdef,left.location,arrayref);
  757. location_reset_ref(location,LOC_REFERENCE,OS_ADDR,4);
  758. tg.gethltemp(current_asmdata.CurrAsmList,java_jlobject,4,tt_normal,location.reference);
  759. hlcg.a_load_reg_ref(current_asmdata.CurrAsmList,java_jlobject,java_jlobject,basereg,location.reference);
  760. end;
  761. procedure get_most_nested_types(var fromdef, todef: tdef);
  762. begin
  763. while is_dynamic_array(fromdef) and
  764. is_dynamic_array(todef) do
  765. begin
  766. fromdef:=tarraydef(fromdef).elementdef;
  767. todef:=tarraydef(todef).elementdef;
  768. end;
  769. fromdef:=maybe_find_real_class_definition(fromdef,false);
  770. todef:=maybe_find_real_class_definition(todef,false);
  771. end;
  772. function tjvmtypeconvnode.do_target_specific_explicit_typeconv(check_only: boolean; out resnode: tnode): boolean;
  773. { handle explicit typecast from int to to real or vice versa }
  774. function int_real_explicit_typecast(fdef: tfloatdef; const singlemethod, doublemethod: string): tnode;
  775. var
  776. csym: ttypesym;
  777. psym: tsym;
  778. begin
  779. { use the float/double to raw bits methods to get the bit pattern }
  780. if fdef.floattype=s32real then
  781. begin
  782. csym:=search_system_type('JLFLOAT');
  783. psym:=search_struct_member(tobjectdef(csym.typedef),singlemethod);
  784. end
  785. else
  786. begin
  787. csym:=search_system_type('JLDOUBLE');
  788. psym:=search_struct_member(tobjectdef(csym.typedef),doublemethod);
  789. end;
  790. if not assigned(psym) or
  791. (psym.typ<>procsym) then
  792. internalerror(2011012901);
  793. { call the (static class) method to get the raw bits }
  794. result:=ccallnode.create(ccallparanode.create(left,nil),
  795. tprocsym(psym),psym.owner,
  796. cloadvmtaddrnode.create(ctypenode.create(csym.typedef)),[],nil);
  797. { convert the result to the result type of this type conversion node }
  798. inserttypeconv_explicit(result,resultdef);
  799. { left is reused }
  800. left:=nil;
  801. end;
  802. function ord_enum_explicit_typecast(fdef: torddef; todef: tcpuenumdef): tnode;
  803. var
  804. psym: tsym;
  805. begin
  806. { we only create a class for the basedefs }
  807. todef:=tcpuenumdef(todef.getbasedef);
  808. psym:=search_struct_member(todef.classdef,'FPCVALUEOF');
  809. if not assigned(psym) or
  810. (psym.typ<>procsym) then
  811. internalerror(2011062601);
  812. result:=ccallnode.create(ccallparanode.create(left,nil),
  813. tprocsym(psym),psym.owner,
  814. cloadvmtaddrnode.create(ctypenode.create(todef.classdef)),[],nil);
  815. { convert the result to the result type of this type conversion node }
  816. inserttypeconv_explicit(result,resultdef);
  817. { left is reused }
  818. left:=nil;
  819. end;
  820. function enum_ord_explicit_typecast(fdef: tcpuenumdef; todef: torddef): tnode;
  821. var
  822. psym: tsym;
  823. begin
  824. { we only create a class for the basedef }
  825. fdef:=tcpuenumdef(fdef.getbasedef);
  826. psym:=search_struct_member(fdef.classdef,'FPCORDINAL');
  827. if not assigned(psym) or
  828. (psym.typ<>procsym) then
  829. internalerror(2011062602);
  830. result:=ccallnode.create(nil,tprocsym(psym),psym.owner,left,[],nil);
  831. { convert the result to the result type of this type conversion node }
  832. inserttypeconv_explicit(result,resultdef);
  833. { left is reused }
  834. left:=nil;
  835. end;
  836. function from_set_explicit_typecast: tnode;
  837. var
  838. helpername: string;
  839. setconvdef: tdef;
  840. begin
  841. if tsetdef(left.resultdef).elementdef.typ=enumdef then
  842. begin
  843. setconvdef:=java_juenumset;
  844. helpername:='fpc_enumset_to_'
  845. end
  846. else
  847. begin
  848. setconvdef:=java_jubitset;
  849. helpername:='fpc_bitset_to_'
  850. end;
  851. if left.resultdef.size<=4 then
  852. helpername:=helpername+'int'
  853. else
  854. helpername:=helpername+'long';
  855. result:=ccallnode.createintern(helpername,ccallparanode.create(
  856. genintconstnode(left.resultdef.size),ccallparanode.create(genintconstnode(tsetdef(left.resultdef).setbase),
  857. ccallparanode.create(ctypeconvnode.create_explicit(left,setconvdef),nil))));
  858. left:=nil;
  859. end;
  860. function to_set_explicit_typecast: tnode;
  861. var
  862. enumclassdef: tobjectdef;
  863. mp: tnode;
  864. helpername: string;
  865. begin
  866. if tsetdef(resultdef).elementdef.typ=enumdef then
  867. begin
  868. inserttypeconv_explicit(left,s64inttype);
  869. enumclassdef:=tcpuenumdef(tenumdef(tsetdef(resultdef).elementdef).getbasedef).classdef;
  870. mp:=cloadvmtaddrnode.create(ctypenode.create(enumclassdef));
  871. helpername:='fpcLongToEnumSet';
  872. { enumclass.fpcLongToEnumSet(left,setbase,setsize) }
  873. result:=ccallnode.createinternmethod(mp,helpername,
  874. ccallparanode.create(genintconstnode(resultdef.size),
  875. ccallparanode.create(genintconstnode(tsetdef(resultdef).setbase),
  876. ccallparanode.create(left,nil))));
  877. end
  878. else
  879. begin
  880. if left.resultdef.size<=4 then
  881. begin
  882. helpername:='fpc_int_to_bitset';
  883. inserttypeconv_explicit(left,s32inttype);
  884. end
  885. else
  886. begin
  887. helpername:='fpc_long_to_bitset';
  888. inserttypeconv_explicit(left,s64inttype);
  889. end;
  890. result:=ccallnode.createintern(helpername,
  891. ccallparanode.create(genintconstnode(resultdef.size),
  892. ccallparanode.create(genintconstnode(tsetdef(resultdef).setbase),
  893. ccallparanode.create(left,nil))));
  894. end;
  895. end;
  896. function procvar_to_procvar(fromdef, todef: tdef): tnode;
  897. var
  898. fsym: tsym;
  899. begin
  900. result:=nil;
  901. if fromdef=todef then
  902. exit;
  903. fsym:=tfieldvarsym(search_struct_member(tcpuprocvardef(fromdef).classdef,'METHOD'));
  904. if not assigned(fsym) or
  905. (fsym.typ<>fieldvarsym) then
  906. internalerror(2011072414);
  907. { can either be a procvar or a procvarclass }
  908. if fromdef.typ=procvardef then
  909. begin
  910. left:=ctypeconvnode.create_explicit(left,tcpuprocvardef(fromdef).classdef);
  911. include(left.flags,nf_load_procvar);
  912. typecheckpass(left);
  913. end;
  914. result:=csubscriptnode.create(fsym,left);
  915. { create destination procvartype with info from source }
  916. result:=ccallnode.createinternmethod(
  917. cloadvmtaddrnode.create(ctypenode.create(tcpuprocvardef(todef).classdef)),
  918. 'CREATE',ccallparanode.create(result,nil));
  919. left:=nil;
  920. end;
  921. function procvar_to_tmethod(fromdef, todef: tdef): tnode;
  922. var
  923. fsym: tsym;
  924. begin
  925. { must be procedure-of-object -> implicit pointer type -> get address
  926. before typecasting to corresponding classdef }
  927. left:=caddrnode.create_internal(left);
  928. inserttypeconv_explicit(left,tcpuprocvardef(fromdef).classdef);
  929. fsym:=tfieldvarsym(search_struct_member(tcpuprocvardef(fromdef).classdef,'METHOD'));
  930. if not assigned(fsym) or
  931. (fsym.typ<>fieldvarsym) then
  932. internalerror(2011072414);
  933. result:=csubscriptnode.create(fsym,left);
  934. left:=nil;
  935. end;
  936. function tmethod_to_procvar(fromdef, todef: tdef): tnode;
  937. var
  938. fsym: tsym;
  939. begin
  940. fsym:=tfieldvarsym(search_struct_member(tcpuprocvardef(todef).classdef,'METHOD'));
  941. if not assigned(fsym) or
  942. (fsym.typ<>fieldvarsym) then
  943. internalerror(2011072415);
  944. result:=ccallnode.createinternmethod(cloadvmtaddrnode.create(ctypenode.create(tcpuprocvardef(todef).classdef)),
  945. 'CREATE',ccallparanode.create(left,nil));
  946. left:=nil;
  947. end;
  948. function ptr_no_typecheck_required(fromdef, todef: tdef): boolean;
  949. function check_type_equality(def1,def2: tdef): boolean;
  950. begin
  951. result:=true;
  952. if is_ansistring(def1) and
  953. (def2=java_ansistring) then
  954. exit;
  955. if is_wide_or_unicode_string(def1) and
  956. (def2=java_jlstring) then
  957. exit;
  958. if def1.typ=pointerdef then
  959. begin
  960. if is_shortstring(tpointerdef(def1).pointeddef) and
  961. (def2=java_shortstring) then
  962. exit;
  963. { pointer-to-set to JUEnumSet/JUBitSet }
  964. if (tpointerdef(def1).pointeddef.typ=setdef) then
  965. begin
  966. if not assigned(tsetdef(tpointerdef(def1).pointeddef).elementdef) then
  967. begin
  968. if (def2=java_jubitset) or
  969. (def2=java_juenumset) then
  970. exit;
  971. end
  972. else if tsetdef(tpointerdef(def1).pointeddef).elementdef.typ=enumdef then
  973. begin
  974. if def2=java_juenumset then
  975. exit;
  976. end
  977. else if def2=java_jubitset then
  978. exit;
  979. end;
  980. end;
  981. result:=false;
  982. end;
  983. function check_array_type_equality(def1,def2: tdef): boolean;
  984. begin
  985. result:=true;
  986. if is_shortstring(def1) and
  987. (def2=java_shortstring) then
  988. exit;
  989. result:=false;
  990. end;
  991. begin
  992. result:=true;
  993. { check procvar conversion compatibility via their classes }
  994. if fromdef.typ=procvardef then
  995. fromdef:=tcpuprocvardef(fromdef).classdef;
  996. if todef.typ=procvardef then
  997. todef:=tcpuprocvardef(todef).classdef;
  998. if (todef=java_jlobject) or
  999. (todef=voidpointertype) then
  1000. exit;
  1001. if compare_defs(fromdef,todef,nothingn)>=te_equal then
  1002. exit;
  1003. { trecorddef.is_related() must work for inheritance/method checking,
  1004. but do not allow records to be directly typecasted into class/
  1005. pointer types (you have to use FpcBaseRecordType(@rec) instead) }
  1006. if not is_record(fromdef) and
  1007. def_is_related(fromdef,todef) then
  1008. exit;
  1009. if check_type_equality(fromdef,todef) then
  1010. exit;
  1011. if check_type_equality(todef,fromdef) then
  1012. exit;
  1013. if (fromdef.typ=pointerdef) and
  1014. (tpointerdef(fromdef).pointeddef.typ=recorddef) and
  1015. (todef=java_fpcbaserecordtype) then
  1016. exit;
  1017. { all classrefs are currently java.lang.Class at the bytecode level }
  1018. if (fromdef.typ=classrefdef) and
  1019. (todef.typ=objectdef) and
  1020. (todef=search_system_type('JLCLASS').typedef) then
  1021. exit;
  1022. if (fromdef.typ=classrefdef) and
  1023. (todef.typ=classrefdef) and
  1024. def_is_related(tclassrefdef(fromdef).pointeddef,tclassrefdef(todef).pointeddef) then
  1025. exit;
  1026. { special case: "array of shortstring" to "array of ShortstringClass"
  1027. and "array of <record>" to "array of FpcRecordBaseType" (normally
  1028. you have to use ShortstringClass(@shortstrvar) etc, but that's not
  1029. possible in case of passing arrays to e.g. setlength) }
  1030. if is_dynamic_array(left.resultdef) and
  1031. is_dynamic_array(resultdef) then
  1032. begin
  1033. if check_array_type_equality(fromdef,todef) or
  1034. check_array_type_equality(todef,fromdef) then
  1035. exit;
  1036. if is_record(fromdef) and
  1037. (todef=java_fpcbaserecordtype) then
  1038. exit;
  1039. end;
  1040. result:=false;
  1041. end;
  1042. function compatible_file_conversion(def1, def2: tdef): boolean;
  1043. begin
  1044. if def1.typ=filedef then
  1045. case tfiledef(def1).filetyp of
  1046. ft_text:
  1047. result:=def2=search_system_type('TEXTREC').typedef;
  1048. ft_typed,
  1049. ft_untyped:
  1050. result:=def2=search_system_type('FILEREC').typedef;
  1051. else
  1052. internalerror(2015091401);
  1053. end
  1054. else
  1055. result:=false;
  1056. end;
  1057. var
  1058. fromclasscompatible,
  1059. toclasscompatible: boolean;
  1060. fromdef,
  1061. todef: tdef;
  1062. fromarrtype,
  1063. toarrtype: char;
  1064. begin
  1065. resnode:=nil;
  1066. if not(convtype in [tc_equal,tc_int_2_int,tc_int_2_bool,tc_bool_2_int,tc_class_2_intf]) or
  1067. ((convtype in [tc_equal,tc_int_2_int,tc_bool_2_int,tc_int_2_bool]) and
  1068. ((left.resultdef.typ=orddef) and
  1069. (resultdef.typ=orddef))) then
  1070. begin
  1071. result:=false;
  1072. exit
  1073. end;
  1074. { This routine is only called for explicit typeconversions of same-sized
  1075. entities that aren't handled by normal type conversions -> bit pattern
  1076. reinterpretations. In the JVM, many of these also need special
  1077. handling because of the type safety. }
  1078. { don't allow conversions between object-based and non-object-based
  1079. types }
  1080. fromclasscompatible:=
  1081. (left.resultdef.typ=formaldef) or
  1082. (left.resultdef.typ=pointerdef) or
  1083. is_java_class_or_interface(left.resultdef) or
  1084. is_dynamic_array(left.resultdef) or
  1085. ((left.resultdef.typ in [stringdef,classrefdef]) and
  1086. not is_shortstring(left.resultdef)) or
  1087. (left.resultdef.typ=enumdef) or
  1088. { procvar2procvar needs special handling }
  1089. ((left.resultdef.typ=procvardef) and
  1090. tprocvardef(left.resultdef).is_addressonly and
  1091. (resultdef.typ<>procvardef));
  1092. toclasscompatible:=
  1093. (resultdef.typ=pointerdef) or
  1094. is_java_class_or_interface(resultdef) or
  1095. is_dynamic_array(resultdef) or
  1096. ((resultdef.typ in [stringdef,classrefdef]) and
  1097. not is_shortstring(resultdef)) or
  1098. (resultdef.typ=enumdef) or
  1099. ((resultdef.typ=procvardef) and
  1100. tprocvardef(resultdef).is_addressonly);
  1101. { typescasts from void (the result of untyped_ptr^) to an implicit
  1102. pointertype (record, array, ...) also needs a typecheck }
  1103. if is_void(left.resultdef) and
  1104. jvmimplicitpointertype(resultdef) then
  1105. begin
  1106. fromclasscompatible:=true;
  1107. toclasscompatible:=true;
  1108. end;
  1109. if fromclasscompatible and toclasscompatible then
  1110. begin
  1111. { we need an as-node to check the validity of the conversion (since
  1112. it wasn't handled by another type conversion, we know it can't
  1113. have been valid normally)
  1114. Exceptions: (most nested) destination is
  1115. * java.lang.Object, since everything is compatible with that type
  1116. * related to source
  1117. * a primitive that are represented by the same type in Java
  1118. (e.g., byte and shortint) }
  1119. { in case of arrays, check the compatibility of the innermost types }
  1120. fromdef:=left.resultdef;
  1121. todef:=resultdef;
  1122. get_most_nested_types(fromdef,todef);
  1123. { in case of enums, get the equivalent class definitions }
  1124. if (fromdef.typ=enumdef) then
  1125. fromdef:=tenumdef(fromdef).getbasedef;
  1126. if (todef.typ=enumdef) then
  1127. todef:=tenumdef(todef).getbasedef;
  1128. fromarrtype:=jvmarrtype_setlength(fromdef);
  1129. toarrtype:=jvmarrtype_setlength(todef);
  1130. if not ptr_no_typecheck_required(fromdef,todef) then
  1131. begin
  1132. if (fromarrtype in ['A','R','T','E','L','P']) or
  1133. (fromarrtype<>toarrtype) then
  1134. begin
  1135. if not check_only and
  1136. not assignment_side then
  1137. begin
  1138. resnode:=ctypenode.create(resultdef);
  1139. if resultdef.typ=objectdef then
  1140. resnode:=cloadvmtaddrnode.create(resnode);
  1141. resnode:=casnode.create_internal(left,resnode);
  1142. if resultdef.typ=classrefdef then
  1143. tjvmasnode(resnode).classreftypecast:=true;
  1144. left:=nil;
  1145. end
  1146. end
  1147. { typecasting from a child to a parent type on the assignment side
  1148. will (rightly) mess up the type safety verification of the JVM }
  1149. else if assignment_side then
  1150. CGMessage(type_e_no_managed_assign_generic_typecast);
  1151. end;
  1152. result:=true;
  1153. exit;
  1154. end;
  1155. { a formaldef can be converted to anything, but not on the assignment
  1156. side }
  1157. if (left.resultdef.typ=formaldef) and
  1158. not assignment_side then
  1159. begin
  1160. if resultdef.typ in [orddef,floatdef] then
  1161. begin
  1162. if not check_only then
  1163. begin
  1164. resnode:=cinlinenode.create(in_unbox_x_y,false,
  1165. ccallparanode.create(ctypenode.create(resultdef),
  1166. ccallparanode.create(left,nil)));
  1167. left:=nil;
  1168. end;
  1169. result:=true;
  1170. exit;
  1171. end
  1172. else if jvmimplicitpointertype(resultdef) then
  1173. begin
  1174. { typecast formaldef to pointer to the type, then deref, so that
  1175. a proper checkcast is inserted }
  1176. if not check_only then
  1177. begin
  1178. resnode:=ctypeconvnode.create_explicit(left,cpointerdef.getreusable(resultdef));
  1179. resnode:=cderefnode.create(resnode);
  1180. left:=nil;
  1181. end;
  1182. result:=true;
  1183. exit;
  1184. end;
  1185. result:=false;
  1186. exit;
  1187. end;
  1188. { procvar to tmethod and vice versa, and procvar to procvar }
  1189. if isvalidprocvartypeconv(left.resultdef,resultdef) then
  1190. begin
  1191. if not check_only then
  1192. begin
  1193. if (left.resultdef.typ=procvardef) and
  1194. (resultdef.typ=procvardef) then
  1195. resnode:=procvar_to_procvar(left.resultdef,resultdef)
  1196. else if left.resultdef.typ=procvardef then
  1197. resnode:=procvar_to_tmethod(left.resultdef,resultdef)
  1198. else
  1199. resnode:=tmethod_to_procvar(left.resultdef,resultdef);
  1200. end;
  1201. result:=true;
  1202. exit;
  1203. end;
  1204. { don't allow conversions between different classes of primitive types,
  1205. except for a few special cases }
  1206. { float to int/enum explicit type conversion: get the bits }
  1207. if (left.resultdef.typ=floatdef) and
  1208. (is_integer(resultdef) or
  1209. (resultdef.typ=enumdef)) then
  1210. begin
  1211. if not check_only then
  1212. resnode:=int_real_explicit_typecast(tfloatdef(left.resultdef),'FLOATTORAWINTBITS','DOUBLETORAWLONGBITS');
  1213. result:=true;
  1214. exit;
  1215. end;
  1216. { int to float explicit type conversion: also use the bits }
  1217. if (is_integer(left.resultdef) or
  1218. (left.resultdef.typ=enumdef)) and
  1219. (resultdef.typ=floatdef) then
  1220. begin
  1221. if not check_only then
  1222. begin
  1223. if (left.resultdef.typ=enumdef) then
  1224. inserttypeconv_explicit(left,s32inttype);
  1225. resnode:=int_real_explicit_typecast(tfloatdef(resultdef),'INTBITSTOFLOAT','LONGBITSTODOUBLE');
  1226. end;
  1227. result:=true;
  1228. exit;
  1229. end;
  1230. { enums }
  1231. if (left.resultdef.typ=enumdef) or
  1232. (resultdef.typ=enumdef) then
  1233. begin
  1234. { both enum? }
  1235. if (resultdef.typ=left.resultdef.typ) then
  1236. begin
  1237. { same base type -> nothing special }
  1238. fromdef:=tenumdef(left.resultdef).getbasedef;
  1239. todef:=tenumdef(resultdef).getbasedef;
  1240. if fromdef=todef then
  1241. begin
  1242. result:=false;
  1243. exit;
  1244. end;
  1245. { convert via ordinal intermediate }
  1246. if not check_only then
  1247. begin;
  1248. inserttypeconv_explicit(left,s32inttype);
  1249. inserttypeconv_explicit(left,resultdef);
  1250. resnode:=left;
  1251. left:=nil
  1252. end;
  1253. result:=true;
  1254. exit;
  1255. end;
  1256. { enum to orddef & vice versa }
  1257. if left.resultdef.typ=orddef then
  1258. begin
  1259. if not check_only then
  1260. resnode:=ord_enum_explicit_typecast(torddef(left.resultdef),tcpuenumdef(resultdef));
  1261. result:=true;
  1262. exit;
  1263. end
  1264. else if resultdef.typ=orddef then
  1265. begin
  1266. if not check_only then
  1267. resnode:=enum_ord_explicit_typecast(tcpuenumdef(left.resultdef),torddef(resultdef));
  1268. result:=true;
  1269. exit;
  1270. end
  1271. end;
  1272. { sets }
  1273. if (left.resultdef.typ=setdef) or
  1274. (resultdef.typ=setdef) then
  1275. begin
  1276. { set -> ord/enum/other-set-type }
  1277. if (resultdef.typ in [orddef,enumdef]) then
  1278. begin
  1279. if not check_only then
  1280. begin
  1281. resnode:=from_set_explicit_typecast;
  1282. { convert to desired result }
  1283. inserttypeconv_explicit(resnode,resultdef);
  1284. end;
  1285. result:=true;
  1286. exit;
  1287. end
  1288. { ord/enum -> set }
  1289. else if (left.resultdef.typ in [orddef,enumdef]) then
  1290. begin
  1291. if not check_only then
  1292. begin
  1293. resnode:=to_set_explicit_typecast;
  1294. { convert to desired result }
  1295. inserttypeconv_explicit(resnode,cpointerdef.getreusable(resultdef));
  1296. resnode:=cderefnode.create(resnode);
  1297. end;
  1298. result:=true;
  1299. exit;
  1300. end;
  1301. { if someone needs it, float->set and set->float explicit typecasts
  1302. could also be added (cannot be handled by the above, because
  1303. float(intvalue) will convert rather than re-interpret the value) }
  1304. end;
  1305. { files }
  1306. if compatible_file_conversion(left.resultdef,resultdef) or
  1307. compatible_file_conversion(resultdef,left.resultdef) then
  1308. begin
  1309. result:=true;
  1310. exit;
  1311. end;
  1312. { anything not explicitly handled is a problem }
  1313. result:=true;
  1314. CGMessage2(type_e_illegal_type_conversion,left.resultdef.typename,resultdef.typename);
  1315. end;
  1316. function tjvmtypeconvnode.target_specific_explicit_typeconv: boolean;
  1317. var
  1318. dummyres: tnode;
  1319. begin
  1320. result:=do_target_specific_explicit_typeconv(true,dummyres);
  1321. end;
  1322. function tjvmtypeconvnode.target_specific_general_typeconv: boolean;
  1323. begin
  1324. result:=false;
  1325. { on the JVM platform, enums can always be converted to class instances,
  1326. because enums /are/ class instances there. To prevent the
  1327. typechecking/conversion code from assuming it can treat it like any
  1328. ordinal constant, firstpass() it so that the ordinal constant gets
  1329. replaced with a load of a staticvarsym. This is not done in
  1330. pass_typecheck, because that would prevent many optimizations }
  1331. if (left.nodetype=ordconstn) and
  1332. (left.resultdef.typ=enumdef) and
  1333. (resultdef.typ=objectdef) then
  1334. firstpass(left);
  1335. end;
  1336. {*****************************************************************************
  1337. AsNode and IsNode common helpers
  1338. *****************************************************************************}
  1339. function asis_target_specific_typecheck(node: tasisnode): boolean;
  1340. var
  1341. realtodef: tdef;
  1342. temp: tnode;
  1343. begin
  1344. { the JVM supports loadvmtaddrnodes for interface types, but the generic
  1345. as/is code doesn't -> convert such loadvmtaddrnodes back to plain
  1346. type nodes here (they only make sense in the context of treating them
  1347. as entities loaded to store into e.g. a JLClass) }
  1348. if (node.right.resultdef.typ=classrefdef) and
  1349. is_javainterface(tclassrefdef(node.right.resultdef).pointeddef) and
  1350. (node.right.nodetype=loadvmtaddrn) and
  1351. (tloadvmtaddrnode(node.right).left.nodetype=typen) then
  1352. begin
  1353. temp:=tloadvmtaddrnode(node.right).left;
  1354. tloadvmtaddrnode(node.right).left:=nil;
  1355. node.right.free;
  1356. node.right:=temp;
  1357. end;
  1358. if not(nf_internal in node.flags) then
  1359. begin
  1360. { handle using normal code }
  1361. result:=false;
  1362. exit;
  1363. end;
  1364. result:=true;
  1365. { these are converted type conversion nodes, to insert the checkcast
  1366. operations }
  1367. realtodef:=node.right.resultdef;
  1368. if (realtodef.typ=classrefdef) and
  1369. ((node.nodetype<>asn) or
  1370. not tjvmasnode(node).classreftypecast) then
  1371. realtodef:=tclassrefdef(realtodef).pointeddef;
  1372. realtodef:=maybe_find_real_class_definition(realtodef,false);
  1373. if result then
  1374. if node.nodetype=asn then
  1375. node.resultdef:=realtodef
  1376. else
  1377. node.resultdef:=pasbool8type;
  1378. end;
  1379. function asis_pass_1(node: tasisnode; const methodname: string): tnode;
  1380. var
  1381. ps: tsym;
  1382. call: tnode;
  1383. jlclass: tobjectdef;
  1384. begin
  1385. result:=nil;
  1386. firstpass(node.left);
  1387. if not(node.right.nodetype in [typen,loadvmtaddrn]) then
  1388. begin
  1389. if (node.nodetype=isn) or
  1390. not assigned(tasnode(node).call) then
  1391. begin
  1392. if not is_javaclassref(node.right.resultdef) then
  1393. internalerror(2011041920);
  1394. firstpass(node.right);
  1395. jlclass:=tobjectdef(search_system_type('JLCLASS').typedef);
  1396. ps:=search_struct_member(jlclass,methodname);
  1397. if not assigned(ps) or
  1398. (ps.typ<>procsym) then
  1399. internalerror(2011041910);
  1400. call:=ccallnode.create(ccallparanode.create(node.left,nil),tprocsym(ps),ps.owner,ctypeconvnode.create_explicit(node.right,jlclass),[],nil);
  1401. node.left:=nil;
  1402. node.right:=nil;
  1403. firstpass(call);
  1404. if codegenerror then
  1405. exit;
  1406. if node.nodetype=isn then
  1407. result:=call
  1408. else
  1409. begin
  1410. tasnode(node).call:=call;
  1411. node.expectloc:=call.expectloc;
  1412. end;
  1413. end;
  1414. end
  1415. else
  1416. begin
  1417. node.expectloc:=LOC_REGISTER;
  1418. result:=nil;
  1419. end;
  1420. end;
  1421. function asis_generate_code(node: tasisnode; opcode: tasmop): boolean;
  1422. var
  1423. checkdef: tdef;
  1424. begin
  1425. if (node.nodetype=asn) and
  1426. assigned(tasnode(node).call) then
  1427. begin
  1428. result:=false;
  1429. exit;
  1430. end;
  1431. result:=true;
  1432. secondpass(node.left);
  1433. thlcgjvm(hlcg).a_load_loc_stack(current_asmdata.CurrAsmList,node.left.resultdef,node.left.location);
  1434. location_freetemp(current_asmdata.CurrAsmList,node.left.location);
  1435. { Perform a checkcast instruction, which will raise an exception in case
  1436. the actual type does not match/inherit from the expected type.
  1437. Object types need the full type name (package+class name), arrays only
  1438. the array definition }
  1439. if node.nodetype=asn then
  1440. checkdef:=node.resultdef
  1441. else if node.right.resultdef.typ=classrefdef then
  1442. checkdef:=tclassrefdef(node.right.resultdef).pointeddef
  1443. else
  1444. checkdef:=node.right.resultdef;
  1445. thlcgjvm(hlcg).gen_typecheck(current_asmdata.CurrAsmList,opcode,checkdef);
  1446. location_reset(node.location,LOC_REGISTER,OS_ADDR);
  1447. node.location.register:=hlcg.getaddressregister(current_asmdata.CurrAsmList,node.resultdef);
  1448. thlcgjvm(hlcg).a_load_stack_reg(current_asmdata.CurrAsmList,node.resultdef,node.location.register);
  1449. end;
  1450. {*****************************************************************************
  1451. TJVMAsNode
  1452. *****************************************************************************}
  1453. function tjvmasnode.target_specific_typecheck: boolean;
  1454. begin
  1455. result:=asis_target_specific_typecheck(self);
  1456. end;
  1457. function tjvmasnode.pass_1: tnode;
  1458. begin
  1459. result:=asis_pass_1(self,'CAST');
  1460. end;
  1461. procedure tjvmasnode.pass_generate_code;
  1462. begin
  1463. if not asis_generate_code(self,a_checkcast) then
  1464. inherited;
  1465. end;
  1466. function tjvmasnode.dogetcopy: tnode;
  1467. begin
  1468. result:=inherited dogetcopy;
  1469. tjvmasnode(result).classreftypecast:=classreftypecast;
  1470. end;
  1471. function tjvmasnode.docompare(p: tnode): boolean;
  1472. begin
  1473. result:=
  1474. inherited docompare(p) and
  1475. (tjvmasnode(p).classreftypecast=classreftypecast);
  1476. end;
  1477. constructor tjvmasnode.ppuload(t: tnodetype; ppufile: tcompilerppufile);
  1478. begin
  1479. inherited;
  1480. classreftypecast:=boolean(ppufile.getbyte);
  1481. end;
  1482. procedure tjvmasnode.ppuwrite(ppufile: tcompilerppufile);
  1483. begin
  1484. inherited ppuwrite(ppufile);
  1485. ppufile.putbyte(byte(classreftypecast));
  1486. end;
  1487. {*****************************************************************************
  1488. TJVMIsNode
  1489. *****************************************************************************}
  1490. function tjvmisnode.target_specific_typecheck: boolean;
  1491. begin
  1492. result:=asis_target_specific_typecheck(self);
  1493. end;
  1494. function tjvmisnode.pass_1: tnode;
  1495. begin
  1496. result:=asis_pass_1(self,'ISINSTANCE');
  1497. end;
  1498. procedure tjvmisnode.pass_generate_code;
  1499. begin
  1500. if not asis_generate_code(self,a_instanceof) then
  1501. inherited;
  1502. end;
  1503. begin
  1504. ctypeconvnode:=tjvmtypeconvnode;
  1505. casnode:=tjvmasnode;
  1506. cisnode:=tjvmisnode;
  1507. end.