njvmcnv.pas 63 KB

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