njvmcnv.pas 64 KB

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