njvmcnv.pas 64 KB

12345678910111213141516171819202122232425262728293031323334353637383940414243444546474849505152535455565758596061626364656667686970717273747576777879808182838485868788899091929394959697989910010110210310410510610710810911011111211311411511611711811912012112212312412512612712812913013113213313413513613713813914014114214314414514614714814915015115215315415515615715815916016116216316416516616716816917017117217317417517617717817918018118218318418518618718818919019119219319419519619719819920020120220320420520620720820921021121221321421521621721821922022122222322422522622722822923023123223323423523623723823924024124224324424524624724824925025125225325425525625725825926026126226326426526626726826927027127227327427527627727827928028128228328428528628728828929029129229329429529629729829930030130230330430530630730830931031131231331431531631731831932032132232332432532632732832933033133233333433533633733833934034134234334434534634734834935035135235335435535635735835936036136236336436536636736836937037137237337437537637737837938038138238338438538638738838939039139239339439539639739839940040140240340440540640740840941041141241341441541641741841942042142242342442542642742842943043143243343443543643743843944044144244344444544644744844945045145245345445545645745845946046146246346446546646746846947047147247347447547647747847948048148248348448548648748848949049149249349449549649749849950050150250350450550650750850951051151251351451551651751851952052152252352452552652752852953053153253353453553653753853954054154254354454554654754854955055155255355455555655755855956056156256356456556656756856957057157257357457557657757857958058158258358458558658758858959059159259359459559659759859960060160260360460560660760860961061161261361461561661761861962062162262362462562662762862963063163263363463563663763863964064164264364464564664764864965065165265365465565665765865966066166266366466566666766866967067167267367467567667767867968068168268368468568668768868969069169269369469569669769869970070170270370470570670770870971071171271371471571671771871972072172272372472572672772872973073173273373473573673773873974074174274374474574674774874975075175275375475575675775875976076176276376476576676776876977077177277377477577677777877978078178278378478578678778878979079179279379479579679779879980080180280380480580680780880981081181281381481581681781881982082182282382482582682782882983083183283383483583683783883984084184284384484584684784884985085185285385485585685785885986086186286386486586686786886987087187287387487587687787887988088188288388488588688788888989089189289389489589689789889990090190290390490590690790890991091191291391491591691791891992092192292392492592692792892993093193293393493593693793893994094194294394494594694794894995095195295395495595695795895996096196296396496596696796896997097197297397497597697797897998098198298398498598698798898999099199299399499599699799899910001001100210031004100510061007100810091010101110121013101410151016101710181019102010211022102310241025102610271028102910301031103210331034103510361037103810391040104110421043104410451046104710481049105010511052105310541055105610571058105910601061106210631064106510661067106810691070107110721073107410751076107710781079108010811082108310841085108610871088108910901091109210931094109510961097109810991100110111021103110411051106110711081109111011111112111311141115111611171118111911201121112211231124112511261127112811291130113111321133113411351136113711381139114011411142114311441145114611471148114911501151115211531154115511561157115811591160116111621163116411651166116711681169117011711172117311741175117611771178117911801181118211831184118511861187118811891190119111921193119411951196119711981199120012011202120312041205120612071208120912101211121212131214121512161217121812191220122112221223122412251226122712281229123012311232123312341235123612371238123912401241124212431244124512461247124812491250125112521253125412551256125712581259126012611262126312641265126612671268126912701271127212731274127512761277127812791280128112821283128412851286128712881289129012911292129312941295129612971298129913001301130213031304130513061307130813091310131113121313131413151316131713181319132013211322132313241325132613271328132913301331133213331334133513361337133813391340134113421343134413451346134713481349135013511352135313541355135613571358135913601361136213631364136513661367136813691370137113721373137413751376137713781379138013811382138313841385138613871388138913901391139213931394139513961397139813991400140114021403140414051406140714081409141014111412141314141415141614171418141914201421142214231424142514261427142814291430143114321433143414351436143714381439144014411442144314441445144614471448144914501451145214531454145514561457145814591460146114621463146414651466146714681469147014711472147314741475147614771478147914801481148214831484148514861487148814891490149114921493149414951496149714981499150015011502150315041505150615071508150915101511151215131514151515161517151815191520152115221523152415251526152715281529153015311532153315341535153615371538153915401541154215431544154515461547154815491550155115521553155415551556155715581559156015611562156315641565156615671568156915701571157215731574157515761577157815791580158115821583158415851586158715881589159015911592159315941595159615971598159916001601160216031604160516061607160816091610161116121613161416151616161716181619162016211622162316241625162616271628162916301631163216331634163516361637163816391640164116421643164416451646164716481649165016511652165316541655165616571658165916601661
  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,compinnr,
  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(taddrnode(left).addrnodeflags,anf_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,cpointerdef.getreusable(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,cpointerdef.getreusable(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. procdefparas.allow_array_constructor:=true;
  458. constrparas:=ccallparanode.create(procdefparas,constrparas);
  459. result:=ccallnode.createinternmethod(cloadvmtaddrnode.create(ctypenode.create(tcpuprocvardef(resultdef).classdef)),'CREATE',constrparas);
  460. { typecast to the procvar type }
  461. if tprocvardef(resultdef).is_addressonly then
  462. result:=ctypeconvnode.create_explicit(result,resultdef)
  463. else
  464. begin
  465. result:=ctypeconvnode.create_explicit(result,cpointerdef.getreusable(resultdef));
  466. result:=cderefnode.create(result)
  467. end;
  468. { reused }
  469. tloadnode(left).left:=nil;
  470. end;
  471. function tjvmtypeconvnode.first_ansistring_to_pchar: tnode;
  472. var
  473. ps: tsym;
  474. begin
  475. { also called for unicodestring->pwidechar, not supported since we can't
  476. directly access the characters in java.lang.String }
  477. if not is_ansistring(left.resultdef) or
  478. not is_pchar(resultdef) then
  479. begin
  480. CGMessage2(type_e_illegal_type_conversion,left.resultdef.typename,resultdef.typename);
  481. result:=nil;
  482. exit;
  483. end;
  484. ps:=search_struct_member(java_ansistring,'INTERNCHARS');
  485. if not assigned(ps) or
  486. (ps.typ<>procsym) then
  487. internalerror(2011081401);
  488. { AnsistringClass.internChars is a static class method that will either
  489. return the internal fdata ansichar array of the string, or an array
  490. with a single #0 }
  491. result:=ccallnode.create(ccallparanode.create(left,nil),tprocsym(ps),
  492. ps.owner,
  493. cloadvmtaddrnode.create(ctypenode.create(java_ansistring)),[],nil);
  494. include(result.flags,nf_isproperty);
  495. result:=ctypeconvnode.create_explicit(result,resultdef);
  496. { reused }
  497. left:=nil;
  498. end;
  499. {*****************************************************************************
  500. SecondTypeConv
  501. *****************************************************************************}
  502. procedure tjvmtypeconvnode.second_int_to_int;
  503. var
  504. ressize,
  505. leftsize : longint;
  506. begin
  507. { insert range check if not explicit conversion }
  508. if not(nf_explicit in flags) then
  509. hlcg.g_rangecheck(current_asmdata.CurrAsmList,left.location,left.resultdef,resultdef);
  510. { is the result size smaller? when typecasting from void
  511. we always reuse the current location, because there is
  512. nothing that we can load in a register }
  513. ressize:=resultdef.size;
  514. leftsize :=left.resultdef.size;
  515. if ((ressize<>leftsize) or
  516. ((left.location.loc in [LOC_REFERENCE,LOC_CREFERENCE]) and
  517. (left.location.reference.arrayreftype<>art_none) and
  518. (is_widechar(left.resultdef)<>is_widechar(resultdef))) or
  519. is_bitpacked_access(left)) and
  520. not is_void(left.resultdef) then
  521. begin
  522. location_copy(location,left.location);
  523. { reuse a loc_reference when the newsize is larger than
  524. than the original and 4 bytes, because all <= 4 byte loads will
  525. result in a stack slot that occupies 4 bytes.
  526. Except
  527. a) for arrays (they use different load instructions for
  528. differently sized data types) or symbols (idem)
  529. b) when going from 4 to 8 bytes, because these are different
  530. data types
  531. }
  532. if (location.loc in [LOC_REFERENCE,LOC_CREFERENCE]) and
  533. not assigned(location.reference.symbol) and
  534. (location.reference.arrayreftype=art_none) and
  535. (ressize>leftsize) and
  536. (ressize=4) then
  537. begin
  538. location.size:=def_cgsize(resultdef);
  539. { no adjustment of the offset even though Java is big endian,
  540. because the load instruction will remain the same }
  541. end
  542. else
  543. hlcg.location_force_reg(current_asmdata.CurrAsmList,location,left.resultdef,resultdef,false);
  544. end
  545. else
  546. begin
  547. if ((ressize < sizeof(aint)) and
  548. (def_cgsize(left.resultdef)<>def_cgsize(resultdef))) or
  549. (is_widechar(left.resultdef)<>is_widechar(resultdef)) then
  550. begin
  551. location_reset(location,LOC_REGISTER,def_cgsize(resultdef));
  552. location.register:=hlcg.getintregister(current_asmdata.CurrAsmList,resultdef);
  553. hlcg.a_load_loc_reg(current_asmdata.CurrAsmList,left.resultdef,resultdef,left.location,location.register);
  554. end
  555. else
  556. location_copy(location,left.location);
  557. end;
  558. end;
  559. procedure tjvmtypeconvnode.second_cstring_to_pchar;
  560. begin
  561. location_copy(location,left.location);
  562. end;
  563. procedure tjvmtypeconvnode.second_pointer_to_array;
  564. begin
  565. { arrays are implicit pointers in Java -> same location }
  566. location_copy(location,left.location);
  567. end;
  568. procedure tjvmtypeconvnode.second_int_to_real;
  569. var
  570. srcsize, ressize: longint;
  571. procedure convertsignedstackloc;
  572. begin
  573. case srcsize of
  574. 4:
  575. case ressize of
  576. 4:
  577. current_asmdata.CurrAsmList.concat(taicpu.op_none(a_i2f));
  578. 8:
  579. begin
  580. current_asmdata.CurrAsmList.concat(taicpu.op_none(a_i2d));
  581. thlcgjvm(hlcg).incstack(current_asmdata.CurrAsmList,1);
  582. end;
  583. else
  584. internalerror(2011010601);
  585. end;
  586. 8:
  587. case ressize of
  588. 4:
  589. begin
  590. current_asmdata.CurrAsmList.concat(taicpu.op_none(a_l2f));
  591. thlcgjvm(hlcg).decstack(current_asmdata.CurrAsmList,1);
  592. end;
  593. 8:
  594. current_asmdata.CurrAsmList.concat(taicpu.op_none(a_l2d));
  595. else
  596. internalerror(2011010602);
  597. end;
  598. else
  599. internalerror(2011010603);
  600. end;
  601. end;
  602. var
  603. signeddef : tdef;
  604. l1 : tasmlabel;
  605. begin
  606. srcsize:=left.resultdef.size;
  607. ressize:=resultdef.size;
  608. location_reset(location,LOC_FPUREGISTER,def_cgsize(resultdef));
  609. location.register:=hlcg.getfpuregister(current_asmdata.CurrAsmList,resultdef);
  610. { first always convert as if it's a signed number }
  611. thlcgjvm(hlcg).a_load_loc_stack(current_asmdata.CurrAsmList,left.resultdef,left.location);
  612. convertsignedstackloc;
  613. if not is_signed(left.resultdef) then
  614. begin
  615. { if it was unsigned, add high(cardinal)+1/high(qword)+1 in case
  616. the signed interpretation is < 0 }
  617. current_asmdata.getjumplabel(l1);
  618. if srcsize=4 then
  619. signeddef:=s32inttype
  620. else
  621. signeddef:=s64inttype;
  622. hlcg.a_cmp_const_loc_label(current_asmdata.CurrAsmList,signeddef,OC_GTE,0,left.location,l1);
  623. if srcsize=4 then
  624. thlcgjvm(hlcg).a_loadfpu_const_stack(current_asmdata.CurrAsmList,resultdef,4294967296.0)
  625. else
  626. thlcgjvm(hlcg).a_loadfpu_const_stack(current_asmdata.CurrAsmList,resultdef,18446744073709551616.0);
  627. if ressize=4 then
  628. current_asmdata.CurrAsmList.concat(taicpu.op_none(a_fadd))
  629. else
  630. current_asmdata.CurrAsmList.concat(taicpu.op_none(a_dadd));
  631. hlcg.a_label(current_asmdata.CurrAsmList,l1);
  632. end;
  633. thlcgjvm(hlcg).a_load_stack_reg(current_asmdata.CurrAsmList,resultdef,location.register);
  634. end;
  635. procedure tjvmtypeconvnode.second_proc_to_procvar;
  636. begin
  637. internalerror(2011072506);
  638. end;
  639. procedure tjvmtypeconvnode.second_nil_to_methodprocvar;
  640. var
  641. r: Treference;
  642. begin
  643. tg.gethltemp(current_asmdata.currasmlist,java_jlobject,java_jlobject.size,tt_normal,r);
  644. hlcg.a_load_const_ref(current_asmdata.CurrAsmList,java_jlobject,0,r);
  645. location_reset_ref(location,LOC_REFERENCE,def_cgsize(resultdef),1,[]);
  646. location.reference:=r;
  647. end;
  648. procedure tjvmtypeconvnode.second_bool_to_int;
  649. var
  650. newsize: tcgsize;
  651. begin
  652. secondpass(left);
  653. location_copy(location,left.location);
  654. newsize:=def_cgsize(resultdef);
  655. { byte(bytebool) or word(wordbool) or longint(longbool) must be }
  656. { accepted for var parameters and assignments, and must not }
  657. { change the ordinal value or value location. }
  658. { htypechk.valid_for_assign ensures that such locations with a }
  659. { size<sizeof(register) cannot be LOC_CREGISTER (they otherwise }
  660. { could be in case of a plain assignment), and LOC_REGISTER can }
  661. { never be an assignment target. The remaining LOC_REGISTER/ }
  662. { LOC_CREGISTER locations do have to be sign/zero-extended. }
  663. { -- Note: this does not work for Java and 2/4 byte sized
  664. values, because bytebool/wordbool are signed and
  665. are stored in 4 byte locations -> will result in
  666. "byte" with the value high(cardinal); see remark
  667. in second_int_to_int above regarding consequences }
  668. if not(nf_explicit in flags) or
  669. (location.loc in [LOC_FLAGS,LOC_JUMP]) or
  670. ((newsize<>left.location.size) and
  671. ((left.resultdef.size<>resultdef.size) or
  672. not(left.resultdef.size in [4,8]))
  673. ) then
  674. hlcg.location_force_reg(current_asmdata.CurrAsmList,location,left.resultdef,resultdef,true)
  675. else
  676. { may differ in sign, e.g. bytebool -> byte }
  677. location.size:=newsize;
  678. end;
  679. procedure tjvmtypeconvnode.second_int_to_bool;
  680. var
  681. hlabel1,hlabel2: tasmlabel;
  682. newsize : tcgsize;
  683. begin
  684. secondpass(left);
  685. if codegenerror then
  686. exit;
  687. { Explicit typecasts from any ordinal type to a boolean type }
  688. { must not change the ordinal value }
  689. { Exception: Android verifier... }
  690. if (nf_explicit in flags) and
  691. not(left.location.loc in [LOC_FLAGS,LOC_JUMP]) and
  692. not(current_settings.cputype=cpu_dalvik) then
  693. begin
  694. location_copy(location,left.location);
  695. newsize:=def_cgsize(resultdef);
  696. { change of size? change sign only if location is LOC_(C)REGISTER? Then we have to sign/zero-extend }
  697. if (tcgsize2size[newsize]<>tcgsize2size[left.location.size]) or
  698. ((newsize<>left.location.size) and (location.loc in [LOC_REGISTER,LOC_CREGISTER])) then
  699. hlcg.location_force_reg(current_asmdata.CurrAsmList,location,left.resultdef,resultdef,true)
  700. else
  701. location.size:=newsize;
  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:=left.location.falselabel;
  716. hlcg.a_label(current_asmdata.CurrAsmList,left.location.truelabel);
  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. end;
  734. procedure tjvmtypeconvnode.second_elem_to_openarray;
  735. var
  736. primitivetype: boolean;
  737. opc: tasmop;
  738. mangledname: string;
  739. basereg: tregister;
  740. arrayref: treference;
  741. begin
  742. { create an array with one element of the required type }
  743. thlcgjvm(hlcg).a_load_const_stack(current_asmdata.CurrAsmList,s32inttype,1,R_INTREGISTER);
  744. mangledname:=jvmarrtype(left.resultdef,primitivetype);
  745. if primitivetype then
  746. opc:=a_newarray
  747. else
  748. opc:=a_anewarray;
  749. { doesn't change stack height: one int replaced by one reference }
  750. current_asmdata.CurrAsmList.concat(taicpu.op_sym(opc,current_asmdata.RefAsmSymbol(mangledname,AT_METADATA)));
  751. { store the data in the newly created array }
  752. basereg:=hlcg.getaddressregister(current_asmdata.CurrAsmList,java_jlobject);
  753. thlcgjvm(hlcg).a_load_stack_reg(current_asmdata.CurrAsmList,java_jlobject,basereg);
  754. reference_reset_base(arrayref,basereg,0,ctempposinvalid,4,[]);
  755. arrayref.arrayreftype:=art_indexconst;
  756. arrayref.indexoffset:=0;
  757. hlcg.a_load_loc_ref(current_asmdata.CurrAsmList,left.resultdef,left.resultdef,left.location,arrayref);
  758. location_reset_ref(location,LOC_REFERENCE,OS_ADDR,4,[]);
  759. tg.gethltemp(current_asmdata.CurrAsmList,java_jlobject,4,tt_normal,location.reference);
  760. hlcg.a_load_reg_ref(current_asmdata.CurrAsmList,java_jlobject,java_jlobject,basereg,location.reference);
  761. end;
  762. procedure get_most_nested_types(var fromdef, todef: tdef);
  763. begin
  764. while is_dynamic_array(fromdef) and
  765. is_dynamic_array(todef) do
  766. begin
  767. fromdef:=tarraydef(fromdef).elementdef;
  768. todef:=tarraydef(todef).elementdef;
  769. end;
  770. fromdef:=maybe_find_real_class_definition(fromdef,false);
  771. todef:=maybe_find_real_class_definition(todef,false);
  772. end;
  773. function tjvmtypeconvnode.do_target_specific_explicit_typeconv(check_only: boolean; out resnode: tnode): boolean;
  774. { handle explicit typecast from int to to real or vice versa }
  775. function int_real_explicit_typecast(fdef: tfloatdef; const singlemethod, doublemethod: string): tnode;
  776. var
  777. csym: ttypesym;
  778. psym: tsym;
  779. begin
  780. { use the float/double to raw bits methods to get the bit pattern }
  781. if fdef.floattype=s32real then
  782. begin
  783. csym:=search_system_type('JLFLOAT');
  784. psym:=search_struct_member(tobjectdef(csym.typedef),singlemethod);
  785. end
  786. else
  787. begin
  788. csym:=search_system_type('JLDOUBLE');
  789. psym:=search_struct_member(tobjectdef(csym.typedef),doublemethod);
  790. end;
  791. if not assigned(psym) or
  792. (psym.typ<>procsym) then
  793. internalerror(2011012901);
  794. { call the (static class) method to get the raw bits }
  795. result:=ccallnode.create(ccallparanode.create(left,nil),
  796. tprocsym(psym),psym.owner,
  797. cloadvmtaddrnode.create(ctypenode.create(csym.typedef)),[],nil);
  798. { convert the result to the result type of this type conversion node }
  799. inserttypeconv_explicit(result,resultdef);
  800. { left is reused }
  801. left:=nil;
  802. end;
  803. function ord_enum_explicit_typecast(fdef: torddef; todef: tcpuenumdef): tnode;
  804. var
  805. psym: tsym;
  806. begin
  807. { we only create a class for the basedefs }
  808. todef:=tcpuenumdef(todef.getbasedef);
  809. psym:=search_struct_member(todef.classdef,'FPCVALUEOF');
  810. if not assigned(psym) or
  811. (psym.typ<>procsym) then
  812. internalerror(2011062601);
  813. result:=ccallnode.create(ccallparanode.create(left,nil),
  814. tprocsym(psym),psym.owner,
  815. cloadvmtaddrnode.create(ctypenode.create(todef.classdef)),[],nil);
  816. { convert the result to the result type of this type conversion node }
  817. inserttypeconv_explicit(result,resultdef);
  818. { left is reused }
  819. left:=nil;
  820. end;
  821. function enum_ord_explicit_typecast(fdef: tcpuenumdef; todef: torddef): tnode;
  822. var
  823. psym: tsym;
  824. begin
  825. { we only create a class for the basedef }
  826. fdef:=tcpuenumdef(fdef.getbasedef);
  827. psym:=search_struct_member(fdef.classdef,'FPCORDINAL');
  828. if not assigned(psym) or
  829. (psym.typ<>procsym) then
  830. internalerror(2011062602);
  831. result:=ccallnode.create(nil,tprocsym(psym),psym.owner,left,[],nil);
  832. { convert the result to the result type of this type conversion node }
  833. inserttypeconv_explicit(result,resultdef);
  834. { left is reused }
  835. left:=nil;
  836. end;
  837. function from_set_explicit_typecast: tnode;
  838. var
  839. helpername: string;
  840. setconvdef: tdef;
  841. begin
  842. if tsetdef(left.resultdef).elementdef.typ=enumdef then
  843. begin
  844. setconvdef:=java_juenumset;
  845. helpername:='fpc_enumset_to_'
  846. end
  847. else
  848. begin
  849. setconvdef:=java_jubitset;
  850. helpername:='fpc_bitset_to_'
  851. end;
  852. if left.resultdef.size<=4 then
  853. helpername:=helpername+'int'
  854. else
  855. helpername:=helpername+'long';
  856. result:=ccallnode.createintern(helpername,ccallparanode.create(
  857. genintconstnode(left.resultdef.size),ccallparanode.create(genintconstnode(tsetdef(left.resultdef).setbase),
  858. ccallparanode.create(ctypeconvnode.create_explicit(left,setconvdef),nil))));
  859. left:=nil;
  860. end;
  861. function to_set_explicit_typecast: tnode;
  862. var
  863. enumclassdef: tobjectdef;
  864. mp: tnode;
  865. helpername: string;
  866. begin
  867. if tsetdef(resultdef).elementdef.typ=enumdef then
  868. begin
  869. inserttypeconv_explicit(left,s64inttype);
  870. enumclassdef:=tcpuenumdef(tenumdef(tsetdef(resultdef).elementdef).getbasedef).classdef;
  871. mp:=cloadvmtaddrnode.create(ctypenode.create(enumclassdef));
  872. helpername:='fpcLongToEnumSet';
  873. { enumclass.fpcLongToEnumSet(left,setbase,setsize) }
  874. result:=ccallnode.createinternmethod(mp,helpername,
  875. ccallparanode.create(genintconstnode(resultdef.size),
  876. ccallparanode.create(genintconstnode(tsetdef(resultdef).setbase),
  877. ccallparanode.create(left,nil))));
  878. end
  879. else
  880. begin
  881. if left.resultdef.size<=4 then
  882. begin
  883. helpername:='fpc_int_to_bitset';
  884. inserttypeconv_explicit(left,s32inttype);
  885. end
  886. else
  887. begin
  888. helpername:='fpc_long_to_bitset';
  889. inserttypeconv_explicit(left,s64inttype);
  890. end;
  891. result:=ccallnode.createintern(helpername,
  892. ccallparanode.create(genintconstnode(resultdef.size),
  893. ccallparanode.create(genintconstnode(tsetdef(resultdef).setbase),
  894. ccallparanode.create(left,nil))));
  895. end;
  896. end;
  897. function procvar_to_procvar(fromdef, todef: tdef): tnode;
  898. var
  899. fsym: tsym;
  900. begin
  901. result:=nil;
  902. if fromdef=todef then
  903. exit;
  904. fsym:=tfieldvarsym(search_struct_member(tcpuprocvardef(fromdef).classdef,'METHOD'));
  905. if not assigned(fsym) or
  906. (fsym.typ<>fieldvarsym) then
  907. internalerror(2011072414);
  908. { can either be a procvar or a procvarclass }
  909. if fromdef.typ=procvardef then
  910. begin
  911. left:=ctypeconvnode.create_explicit(left,tcpuprocvardef(fromdef).classdef);
  912. include(left.flags,nf_load_procvar);
  913. typecheckpass(left);
  914. end;
  915. result:=csubscriptnode.create(fsym,left);
  916. { create destination procvartype with info from source }
  917. result:=ccallnode.createinternmethod(
  918. cloadvmtaddrnode.create(ctypenode.create(tcpuprocvardef(todef).classdef)),
  919. 'CREATE',ccallparanode.create(result,nil));
  920. left:=nil;
  921. end;
  922. function procvar_to_tmethod(fromdef, todef: tdef): tnode;
  923. var
  924. fsym: tsym;
  925. begin
  926. { must be procedure-of-object -> implicit pointer type -> get address
  927. before typecasting to corresponding classdef }
  928. left:=caddrnode.create_internal(left);
  929. inserttypeconv_explicit(left,tcpuprocvardef(fromdef).classdef);
  930. fsym:=tfieldvarsym(search_struct_member(tcpuprocvardef(fromdef).classdef,'METHOD'));
  931. if not assigned(fsym) or
  932. (fsym.typ<>fieldvarsym) then
  933. internalerror(2011072414);
  934. result:=csubscriptnode.create(fsym,left);
  935. left:=nil;
  936. end;
  937. function tmethod_to_procvar(fromdef, todef: tdef): tnode;
  938. var
  939. fsym: tsym;
  940. begin
  941. fsym:=tfieldvarsym(search_struct_member(tcpuprocvardef(todef).classdef,'METHOD'));
  942. if not assigned(fsym) or
  943. (fsym.typ<>fieldvarsym) then
  944. internalerror(2011072415);
  945. result:=ccallnode.createinternmethod(cloadvmtaddrnode.create(ctypenode.create(tcpuprocvardef(todef).classdef)),
  946. 'CREATE',ccallparanode.create(left,nil));
  947. left:=nil;
  948. end;
  949. function ptr_no_typecheck_required(fromdef, todef: tdef): boolean;
  950. function check_type_equality(def1,def2: tdef): boolean;
  951. begin
  952. result:=true;
  953. if is_ansistring(def1) and
  954. (def2=java_ansistring) then
  955. exit;
  956. if is_wide_or_unicode_string(def1) and
  957. (def2=java_jlstring) then
  958. exit;
  959. if def1.typ=pointerdef then
  960. begin
  961. if is_shortstring(tpointerdef(def1).pointeddef) and
  962. (def2=java_shortstring) then
  963. exit;
  964. { pointer-to-set to JUEnumSet/JUBitSet }
  965. if (tpointerdef(def1).pointeddef.typ=setdef) then
  966. begin
  967. if not assigned(tsetdef(tpointerdef(def1).pointeddef).elementdef) then
  968. begin
  969. if (def2=java_jubitset) or
  970. (def2=java_juenumset) then
  971. exit;
  972. end
  973. else if tsetdef(tpointerdef(def1).pointeddef).elementdef.typ=enumdef then
  974. begin
  975. if def2=java_juenumset then
  976. exit;
  977. end
  978. else if def2=java_jubitset then
  979. exit;
  980. end;
  981. end;
  982. result:=false;
  983. end;
  984. function check_array_type_equality(def1,def2: tdef): boolean;
  985. begin
  986. result:=true;
  987. if is_shortstring(def1) and
  988. (def2=java_shortstring) then
  989. exit;
  990. result:=false;
  991. end;
  992. begin
  993. result:=true;
  994. { check procvar conversion compatibility via their classes }
  995. if fromdef.typ=procvardef then
  996. fromdef:=tcpuprocvardef(fromdef).classdef;
  997. if todef.typ=procvardef then
  998. todef:=tcpuprocvardef(todef).classdef;
  999. if (todef=java_jlobject) or
  1000. (todef=voidpointertype) then
  1001. exit;
  1002. if compare_defs(fromdef,todef,nothingn)>=te_equal then
  1003. exit;
  1004. { trecorddef.is_related() must work for inheritance/method checking,
  1005. but do not allow records to be directly typecasted into class/
  1006. pointer types (you have to use FpcBaseRecordType(@rec) instead) }
  1007. if not is_record(fromdef) and
  1008. def_is_related(fromdef,todef) then
  1009. exit;
  1010. if check_type_equality(fromdef,todef) then
  1011. exit;
  1012. if check_type_equality(todef,fromdef) then
  1013. exit;
  1014. if (fromdef.typ=pointerdef) and
  1015. (tpointerdef(fromdef).pointeddef.typ=recorddef) and
  1016. (todef=java_fpcbaserecordtype) then
  1017. exit;
  1018. { all classrefs are currently java.lang.Class at the bytecode level }
  1019. if (fromdef.typ=classrefdef) and
  1020. (todef.typ=objectdef) and
  1021. (todef=search_system_type('JLCLASS').typedef) then
  1022. exit;
  1023. if (fromdef.typ=classrefdef) and
  1024. (todef.typ=classrefdef) and
  1025. def_is_related(tclassrefdef(fromdef).pointeddef,tclassrefdef(todef).pointeddef) then
  1026. exit;
  1027. { special case: "array of shortstring" to "array of ShortstringClass"
  1028. and "array of <record>" to "array of FpcRecordBaseType" (normally
  1029. you have to use ShortstringClass(@shortstrvar) etc, but that's not
  1030. possible in case of passing arrays to e.g. setlength) }
  1031. if is_dynamic_array(left.resultdef) and
  1032. is_dynamic_array(resultdef) then
  1033. begin
  1034. if check_array_type_equality(fromdef,todef) or
  1035. check_array_type_equality(todef,fromdef) then
  1036. exit;
  1037. if is_record(fromdef) and
  1038. (todef=java_fpcbaserecordtype) then
  1039. exit;
  1040. end;
  1041. result:=false;
  1042. end;
  1043. function compatible_file_conversion(def1, def2: tdef): boolean;
  1044. begin
  1045. if def1.typ=filedef then
  1046. case tfiledef(def1).filetyp of
  1047. ft_text:
  1048. result:=def2=search_system_type('TEXTREC').typedef;
  1049. ft_typed,
  1050. ft_untyped:
  1051. result:=def2=search_system_type('FILEREC').typedef;
  1052. else
  1053. internalerror(2015091401);
  1054. end
  1055. else
  1056. result:=false;
  1057. end;
  1058. var
  1059. fromclasscompatible,
  1060. toclasscompatible: boolean;
  1061. fromdef,
  1062. todef: tdef;
  1063. fromarrtype,
  1064. toarrtype: char;
  1065. begin
  1066. resnode:=nil;
  1067. if not(convtype in [tc_equal,tc_int_2_int,tc_int_2_bool,tc_bool_2_int,tc_class_2_intf]) or
  1068. ((convtype in [tc_equal,tc_int_2_int,tc_bool_2_int,tc_int_2_bool]) and
  1069. ((left.resultdef.typ=orddef) and
  1070. (resultdef.typ=orddef))) then
  1071. begin
  1072. result:=false;
  1073. exit
  1074. end;
  1075. { This routine is only called for explicit typeconversions of same-sized
  1076. entities that aren't handled by normal type conversions -> bit pattern
  1077. reinterpretations. In the JVM, many of these also need special
  1078. handling because of the type safety. }
  1079. { don't allow conversions between object-based and non-object-based
  1080. types }
  1081. fromclasscompatible:=
  1082. (left.resultdef.typ=formaldef) or
  1083. (left.resultdef.typ=pointerdef) or
  1084. is_java_class_or_interface(left.resultdef) or
  1085. is_dynamic_array(left.resultdef) or
  1086. ((left.resultdef.typ in [stringdef,classrefdef]) and
  1087. not is_shortstring(left.resultdef)) or
  1088. (left.resultdef.typ=enumdef) or
  1089. { procvar2procvar needs special handling }
  1090. ((left.resultdef.typ=procvardef) and
  1091. tprocvardef(left.resultdef).is_addressonly and
  1092. (resultdef.typ<>procvardef));
  1093. toclasscompatible:=
  1094. (resultdef.typ=pointerdef) or
  1095. is_java_class_or_interface(resultdef) or
  1096. is_dynamic_array(resultdef) or
  1097. ((resultdef.typ in [stringdef,classrefdef]) and
  1098. not is_shortstring(resultdef)) or
  1099. (resultdef.typ=enumdef) or
  1100. ((resultdef.typ=procvardef) and
  1101. tprocvardef(resultdef).is_addressonly);
  1102. { typescasts from void (the result of untyped_ptr^) to an implicit
  1103. pointertype (record, array, ...) also needs a typecheck }
  1104. if is_void(left.resultdef) and
  1105. jvmimplicitpointertype(resultdef) then
  1106. begin
  1107. fromclasscompatible:=true;
  1108. toclasscompatible:=true;
  1109. end;
  1110. if fromclasscompatible and toclasscompatible then
  1111. begin
  1112. { we need an as-node to check the validity of the conversion (since
  1113. it wasn't handled by another type conversion, we know it can't
  1114. have been valid normally)
  1115. Exceptions: (most nested) destination is
  1116. * java.lang.Object, since everything is compatible with that type
  1117. * related to source
  1118. * a primitive that are represented by the same type in Java
  1119. (e.g., byte and shortint) }
  1120. { in case of arrays, check the compatibility of the innermost types }
  1121. fromdef:=left.resultdef;
  1122. todef:=resultdef;
  1123. get_most_nested_types(fromdef,todef);
  1124. { in case of enums, get the equivalent class definitions }
  1125. if (fromdef.typ=enumdef) then
  1126. fromdef:=tenumdef(fromdef).getbasedef;
  1127. if (todef.typ=enumdef) then
  1128. todef:=tenumdef(todef).getbasedef;
  1129. fromarrtype:=jvmarrtype_setlength(fromdef);
  1130. toarrtype:=jvmarrtype_setlength(todef);
  1131. if not ptr_no_typecheck_required(fromdef,todef) then
  1132. begin
  1133. if (fromarrtype in ['A','R','T','E','L','P']) or
  1134. (fromarrtype<>toarrtype) then
  1135. begin
  1136. if not check_only and
  1137. not assignment_side then
  1138. begin
  1139. resnode:=ctypenode.create(resultdef);
  1140. if resultdef.typ=objectdef then
  1141. resnode:=cloadvmtaddrnode.create(resnode);
  1142. resnode:=casnode.create_internal(left,resnode);
  1143. if resultdef.typ=classrefdef then
  1144. tjvmasnode(resnode).classreftypecast:=true;
  1145. left:=nil;
  1146. end
  1147. end
  1148. { typecasting from a child to a parent type on the assignment side
  1149. will (rightly) mess up the type safety verification of the JVM }
  1150. else if assignment_side then
  1151. CGMessage(type_e_no_managed_assign_generic_typecast);
  1152. end;
  1153. result:=true;
  1154. exit;
  1155. end;
  1156. { a formaldef can be converted to anything, but not on the assignment
  1157. side }
  1158. if (left.resultdef.typ=formaldef) and
  1159. not assignment_side then
  1160. begin
  1161. if resultdef.typ in [orddef,floatdef] then
  1162. begin
  1163. if not check_only then
  1164. begin
  1165. resnode:=cinlinenode.create(in_unbox_x_y,false,
  1166. ccallparanode.create(ctypenode.create(resultdef),
  1167. ccallparanode.create(left,nil)));
  1168. left:=nil;
  1169. end;
  1170. result:=true;
  1171. exit;
  1172. end
  1173. else if jvmimplicitpointertype(resultdef) then
  1174. begin
  1175. { typecast formaldef to pointer to the type, then deref, so that
  1176. a proper checkcast is inserted }
  1177. if not check_only then
  1178. begin
  1179. resnode:=ctypeconvnode.create_explicit(left,cpointerdef.getreusable(resultdef));
  1180. resnode:=cderefnode.create(resnode);
  1181. left:=nil;
  1182. end;
  1183. result:=true;
  1184. exit;
  1185. end;
  1186. result:=false;
  1187. exit;
  1188. end;
  1189. { procvar to tmethod and vice versa, and procvar to procvar }
  1190. if isvalidprocvartypeconv(left.resultdef,resultdef) then
  1191. begin
  1192. if not check_only then
  1193. begin
  1194. if (left.resultdef.typ=procvardef) and
  1195. (resultdef.typ=procvardef) then
  1196. resnode:=procvar_to_procvar(left.resultdef,resultdef)
  1197. else if left.resultdef.typ=procvardef then
  1198. resnode:=procvar_to_tmethod(left.resultdef,resultdef)
  1199. else
  1200. resnode:=tmethod_to_procvar(left.resultdef,resultdef);
  1201. end;
  1202. result:=true;
  1203. exit;
  1204. end;
  1205. { don't allow conversions between different classes of primitive types,
  1206. except for a few special cases }
  1207. { float to int/enum explicit type conversion: get the bits }
  1208. if (left.resultdef.typ=floatdef) and
  1209. (is_integer(resultdef) or
  1210. (resultdef.typ=enumdef)) then
  1211. begin
  1212. if not check_only then
  1213. resnode:=int_real_explicit_typecast(tfloatdef(left.resultdef),'FLOATTORAWINTBITS','DOUBLETORAWLONGBITS');
  1214. result:=true;
  1215. exit;
  1216. end;
  1217. { int to float explicit type conversion: also use the bits }
  1218. if (is_integer(left.resultdef) or
  1219. (left.resultdef.typ=enumdef)) and
  1220. (resultdef.typ=floatdef) then
  1221. begin
  1222. if not check_only then
  1223. begin
  1224. if (left.resultdef.typ=enumdef) then
  1225. inserttypeconv_explicit(left,s32inttype);
  1226. resnode:=int_real_explicit_typecast(tfloatdef(resultdef),'INTBITSTOFLOAT','LONGBITSTODOUBLE');
  1227. end;
  1228. result:=true;
  1229. exit;
  1230. end;
  1231. { enums }
  1232. if (left.resultdef.typ=enumdef) or
  1233. (resultdef.typ=enumdef) then
  1234. begin
  1235. { both enum? }
  1236. if (resultdef.typ=left.resultdef.typ) then
  1237. begin
  1238. { same base type -> nothing special }
  1239. fromdef:=tenumdef(left.resultdef).getbasedef;
  1240. todef:=tenumdef(resultdef).getbasedef;
  1241. if fromdef=todef then
  1242. begin
  1243. result:=false;
  1244. exit;
  1245. end;
  1246. { convert via ordinal intermediate }
  1247. if not check_only then
  1248. begin;
  1249. inserttypeconv_explicit(left,s32inttype);
  1250. inserttypeconv_explicit(left,resultdef);
  1251. resnode:=left;
  1252. left:=nil
  1253. end;
  1254. result:=true;
  1255. exit;
  1256. end;
  1257. { enum to orddef & vice versa }
  1258. if left.resultdef.typ=orddef then
  1259. begin
  1260. if not check_only then
  1261. resnode:=ord_enum_explicit_typecast(torddef(left.resultdef),tcpuenumdef(resultdef));
  1262. result:=true;
  1263. exit;
  1264. end
  1265. else if resultdef.typ=orddef then
  1266. begin
  1267. if not check_only then
  1268. resnode:=enum_ord_explicit_typecast(tcpuenumdef(left.resultdef),torddef(resultdef));
  1269. result:=true;
  1270. exit;
  1271. end
  1272. end;
  1273. { sets }
  1274. if (left.resultdef.typ=setdef) or
  1275. (resultdef.typ=setdef) then
  1276. begin
  1277. { set -> ord/enum/other-set-type }
  1278. if (resultdef.typ in [orddef,enumdef]) then
  1279. begin
  1280. if not check_only then
  1281. begin
  1282. resnode:=from_set_explicit_typecast;
  1283. { convert to desired result }
  1284. inserttypeconv_explicit(resnode,resultdef);
  1285. end;
  1286. result:=true;
  1287. exit;
  1288. end
  1289. { ord/enum -> set }
  1290. else if (left.resultdef.typ in [orddef,enumdef]) then
  1291. begin
  1292. if not check_only then
  1293. begin
  1294. resnode:=to_set_explicit_typecast;
  1295. { convert to desired result }
  1296. inserttypeconv_explicit(resnode,cpointerdef.getreusable(resultdef));
  1297. resnode:=cderefnode.create(resnode);
  1298. end;
  1299. result:=true;
  1300. exit;
  1301. end;
  1302. { if someone needs it, float->set and set->float explicit typecasts
  1303. could also be added (cannot be handled by the above, because
  1304. float(intvalue) will convert rather than re-interpret the value) }
  1305. end;
  1306. { files }
  1307. if compatible_file_conversion(left.resultdef,resultdef) or
  1308. compatible_file_conversion(resultdef,left.resultdef) then
  1309. begin
  1310. result:=true;
  1311. exit;
  1312. end;
  1313. { anything not explicitly handled is a problem }
  1314. result:=true;
  1315. CGMessage2(type_e_illegal_type_conversion,left.resultdef.typename,resultdef.typename);
  1316. end;
  1317. function tjvmtypeconvnode.target_specific_explicit_typeconv: boolean;
  1318. var
  1319. dummyres: tnode;
  1320. begin
  1321. result:=do_target_specific_explicit_typeconv(true,dummyres);
  1322. end;
  1323. function tjvmtypeconvnode.target_specific_general_typeconv: boolean;
  1324. begin
  1325. result:=false;
  1326. { on the JVM platform, enums can always be converted to class instances,
  1327. because enums /are/ class instances there. To prevent the
  1328. typechecking/conversion code from assuming it can treat it like any
  1329. ordinal constant, firstpass() it so that the ordinal constant gets
  1330. replaced with a load of a staticvarsym. This is not done in
  1331. pass_typecheck, because that would prevent many optimizations }
  1332. if (left.nodetype=ordconstn) and
  1333. (left.resultdef.typ=enumdef) and
  1334. (resultdef.typ=objectdef) then
  1335. firstpass(left);
  1336. end;
  1337. {*****************************************************************************
  1338. AsNode and IsNode common helpers
  1339. *****************************************************************************}
  1340. function asis_target_specific_typecheck(node: tasisnode): boolean;
  1341. var
  1342. realtodef: tdef;
  1343. temp: tnode;
  1344. begin
  1345. { the JVM supports loadvmtaddrnodes for interface types, but the generic
  1346. as/is code doesn't -> convert such loadvmtaddrnodes back to plain
  1347. type nodes here (they only make sense in the context of treating them
  1348. as entities loaded to store into e.g. a JLClass) }
  1349. if (node.right.resultdef.typ=classrefdef) and
  1350. is_javainterface(tclassrefdef(node.right.resultdef).pointeddef) and
  1351. (node.right.nodetype=loadvmtaddrn) and
  1352. (tloadvmtaddrnode(node.right).left.nodetype=typen) then
  1353. begin
  1354. temp:=tloadvmtaddrnode(node.right).left;
  1355. tloadvmtaddrnode(node.right).left:=nil;
  1356. node.right.free;
  1357. node.right:=temp;
  1358. end;
  1359. if not(nf_internal in node.flags) then
  1360. begin
  1361. { handle using normal code }
  1362. result:=false;
  1363. exit;
  1364. end;
  1365. result:=true;
  1366. { these are converted type conversion nodes, to insert the checkcast
  1367. operations }
  1368. realtodef:=node.right.resultdef;
  1369. if (realtodef.typ=classrefdef) and
  1370. ((node.nodetype<>asn) or
  1371. not tjvmasnode(node).classreftypecast) then
  1372. realtodef:=tclassrefdef(realtodef).pointeddef;
  1373. realtodef:=maybe_find_real_class_definition(realtodef,false);
  1374. if result then
  1375. if node.nodetype=asn then
  1376. node.resultdef:=realtodef
  1377. else
  1378. node.resultdef:=pasbool1type;
  1379. end;
  1380. function asis_pass_1(node: tasisnode; const methodname: string): tnode;
  1381. var
  1382. ps: tsym;
  1383. call: tnode;
  1384. jlclass: tobjectdef;
  1385. begin
  1386. result:=nil;
  1387. firstpass(node.left);
  1388. if not(node.right.nodetype in [typen,loadvmtaddrn]) then
  1389. begin
  1390. if (node.nodetype=isn) or
  1391. not assigned(tasnode(node).call) then
  1392. begin
  1393. if not is_javaclassref(node.right.resultdef) then
  1394. internalerror(2011041920);
  1395. firstpass(node.right);
  1396. jlclass:=tobjectdef(search_system_type('JLCLASS').typedef);
  1397. ps:=search_struct_member(jlclass,methodname);
  1398. if not assigned(ps) or
  1399. (ps.typ<>procsym) then
  1400. internalerror(2011041910);
  1401. call:=ccallnode.create(ccallparanode.create(node.left,nil),tprocsym(ps),ps.owner,ctypeconvnode.create_explicit(node.right,jlclass),[],nil);
  1402. node.left:=nil;
  1403. node.right:=nil;
  1404. firstpass(call);
  1405. if codegenerror then
  1406. exit;
  1407. if node.nodetype=isn then
  1408. result:=call
  1409. else
  1410. begin
  1411. tasnode(node).call:=call;
  1412. node.expectloc:=call.expectloc;
  1413. end;
  1414. end;
  1415. end
  1416. else
  1417. begin
  1418. node.expectloc:=LOC_REGISTER;
  1419. result:=nil;
  1420. end;
  1421. end;
  1422. function asis_generate_code(node: tasisnode; opcode: tasmop): boolean;
  1423. var
  1424. checkdef: tdef;
  1425. begin
  1426. if (node.nodetype=asn) and
  1427. assigned(tasnode(node).call) then
  1428. begin
  1429. result:=false;
  1430. exit;
  1431. end;
  1432. result:=true;
  1433. secondpass(node.left);
  1434. thlcgjvm(hlcg).a_load_loc_stack(current_asmdata.CurrAsmList,node.left.resultdef,node.left.location);
  1435. location_freetemp(current_asmdata.CurrAsmList,node.left.location);
  1436. { Perform a checkcast instruction, which will raise an exception in case
  1437. the actual type does not match/inherit from the expected type.
  1438. Object types need the full type name (package+class name), arrays only
  1439. the array definition }
  1440. if node.nodetype=asn then
  1441. checkdef:=node.resultdef
  1442. else if node.right.resultdef.typ=classrefdef then
  1443. checkdef:=tclassrefdef(node.right.resultdef).pointeddef
  1444. else
  1445. checkdef:=node.right.resultdef;
  1446. thlcgjvm(hlcg).gen_typecheck(current_asmdata.CurrAsmList,opcode,checkdef);
  1447. location_reset(node.location,LOC_REGISTER,OS_ADDR);
  1448. node.location.register:=hlcg.getaddressregister(current_asmdata.CurrAsmList,node.resultdef);
  1449. thlcgjvm(hlcg).a_load_stack_reg(current_asmdata.CurrAsmList,node.resultdef,node.location.register);
  1450. end;
  1451. {*****************************************************************************
  1452. TJVMAsNode
  1453. *****************************************************************************}
  1454. function tjvmasnode.target_specific_typecheck: boolean;
  1455. begin
  1456. result:=asis_target_specific_typecheck(self);
  1457. end;
  1458. function tjvmasnode.pass_1: tnode;
  1459. begin
  1460. result:=asis_pass_1(self,'CAST');
  1461. end;
  1462. procedure tjvmasnode.pass_generate_code;
  1463. begin
  1464. if not asis_generate_code(self,a_checkcast) then
  1465. inherited;
  1466. end;
  1467. function tjvmasnode.dogetcopy: tnode;
  1468. begin
  1469. result:=inherited dogetcopy;
  1470. tjvmasnode(result).classreftypecast:=classreftypecast;
  1471. end;
  1472. function tjvmasnode.docompare(p: tnode): boolean;
  1473. begin
  1474. result:=
  1475. inherited docompare(p) and
  1476. (tjvmasnode(p).classreftypecast=classreftypecast);
  1477. end;
  1478. constructor tjvmasnode.ppuload(t: tnodetype; ppufile: tcompilerppufile);
  1479. begin
  1480. inherited;
  1481. classreftypecast:=ppufile.getboolean;
  1482. end;
  1483. procedure tjvmasnode.ppuwrite(ppufile: tcompilerppufile);
  1484. begin
  1485. inherited ppuwrite(ppufile);
  1486. ppufile.putboolean(classreftypecast);
  1487. end;
  1488. {*****************************************************************************
  1489. TJVMIsNode
  1490. *****************************************************************************}
  1491. function tjvmisnode.target_specific_typecheck: boolean;
  1492. begin
  1493. result:=asis_target_specific_typecheck(self);
  1494. end;
  1495. function tjvmisnode.pass_1: tnode;
  1496. begin
  1497. result:=asis_pass_1(self,'ISINSTANCE');
  1498. end;
  1499. procedure tjvmisnode.pass_generate_code;
  1500. begin
  1501. if not asis_generate_code(self,a_instanceof) then
  1502. inherited;
  1503. end;
  1504. begin
  1505. ctypeconvnode:=tjvmtypeconvnode;
  1506. casnode:=tjvmasnode;
  1507. cisnode:=tjvmisnode;
  1508. end.