njvmcnv.pas 62 KB

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