njvmcnv.pas 60 KB

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