njvmcnv.pas 64 KB

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