njvmcnv.pas 62 KB

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