2
0

njvmcnv.pas 63 KB

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