njvmcnv.pas 62 KB

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