njvmcnv.pas 63 KB

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