njvmcnv.pas 62 KB

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