njvmcal.pas 22 KB

123456789101112131415161718192021222324252627282930313233343536373839404142434445464748495051525354555657585960616263646566676869707172737475767778798081828384858687888990919293949596979899100101102103104105106107108109110111112113114115116117118119120121122123124125126127128129130131132133134135136137138139140141142143144145146147148149150151152153154155156157158159160161162163164165166167168169170171172173174175176177178179180181182183184185186187188189190191192193194195196197198199200201202203204205206207208209210211212213214215216217218219220221222223224225226227228229230231232233234235236237238239240241242243244245246247248249250251252253254255256257258259260261262263264265266267268269270271272273274275276277278279280281282283284285286287288289290291292293294295296297298299300301302303304305306307308309310311312313314315316317318319320321322323324325326327328329330331332333334335336337338339340341342343344345346347348349350351352353354355356357358359360361362363364365366367368369370371372373374375376377378379380381382383384385386387388389390391392393394395396397398399400401402403404405406407408409410411412413414415416417418419420421422423424425426427428429430431432433434435436437438439440441442443444445446447448449450451452453454455456457458459460461462463464465466467468469470471472473474475476477478479480481482483484485486487488489490491492493494495496497498499500501502503504505506507508509510511512513514515516517518519520521522523524525526527528529530531532533534535536537538539540541542543544545546
  1. {
  2. Copyright (c) 2011 by Jonas Maebe
  3. JVM-specific code for call 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. }
  17. unit njvmcal;
  18. {$i fpcdefs.inc}
  19. interface
  20. uses
  21. cgbase,
  22. symtype,symdef,
  23. node,ncgcal;
  24. type
  25. tjvmcallparanode = class(tcgcallparanode)
  26. protected
  27. outcopybasereg: tregister;
  28. procedure push_formal_para; override;
  29. procedure push_copyout_para; override;
  30. procedure handleformalcopyoutpara(orgparadef: tdef); override;
  31. procedure load_arrayref_para(useparadef: tdef);
  32. end;
  33. { tjvmcallnode }
  34. tjvmcallnode = class(tcgcallnode)
  35. protected
  36. procedure extra_pre_call_code; override;
  37. procedure set_result_location(realresdef: tstoreddef); override;
  38. procedure do_release_unused_return_value;override;
  39. procedure extra_post_call_code; override;
  40. function dispatch_procvar: tnode;
  41. public
  42. function pass_1: tnode; override;
  43. end;
  44. implementation
  45. uses
  46. verbose,globtype,constexp,
  47. symconst,defutil,ncal,
  48. cgutils,tgobj,procinfo,
  49. cpubase,aasmdata,aasmcpu,
  50. hlcgobj,hlcgcpu,
  51. pass_1,nutils,nbas,ncnv,ncon,ninl,nld,nmem,
  52. jvmdef;
  53. {*****************************************************************************
  54. TJVMCALLPARANODE
  55. *****************************************************************************}
  56. procedure tjvmcallparanode.load_arrayref_para(useparadef: tdef);
  57. var
  58. arrayloc: tlocation;
  59. arrayref: treference;
  60. begin
  61. { cannot be a regular array or record, because those are passed by
  62. plain reference (since they are reference types at the Java level,
  63. but not at the Pascal level) -> no special initialisation necessary }
  64. outcopybasereg:=hlcg.getaddressregister(current_asmdata.CurrAsmList,java_jlobject);
  65. thlcgjvm(hlcg).a_load_stack_reg(current_asmdata.CurrAsmList,java_jlobject,outcopybasereg);
  66. reference_reset_base(arrayref,outcopybasereg,0,4);
  67. arrayref.arrayreftype:=art_indexconst;
  68. arrayref.indexoffset:=0;
  69. { load the current parameter value into the array in case it's not an
  70. out-parameter; if it's an out-parameter the contents must be nil
  71. but that's already ok, since the anewarray opcode takes care of that }
  72. if (parasym.varspez<>vs_out) then
  73. hlcg.a_load_loc_ref(current_asmdata.CurrAsmList,useparadef,useparadef,left.location,arrayref);
  74. { store the array reference into the parameter location (don't change
  75. left.location, we may need it for copy-back after the call) }
  76. location_reset(arrayloc,LOC_REGISTER,OS_ADDR);
  77. arrayloc.register:=outcopybasereg;
  78. hlcg.gen_load_loc_cgpara(current_asmdata.CurrAsmList,java_jlobject,arrayloc,tempcgpara)
  79. end;
  80. procedure tjvmcallparanode.push_formal_para;
  81. begin
  82. { primitive values are boxed, so in all cases this is a pointer to
  83. something and since it cannot be changed (or is not supposed to be
  84. changed anyway), we don't have to create a temporary array to hold a
  85. pointer to this value and can just pass the pointer to this value
  86. directly.
  87. In case the value can be changed (formal var/out), then we have
  88. already created a temporary array of one element that holds the boxed
  89. (or in case of a non-primitive type: original) value. The reason is
  90. that copying it back out may be a complex operation which we don't
  91. want to handle at the code generator level.
  92. -> always push a value parameter (which is either an array of one
  93. element, or an object) }
  94. push_value_para
  95. end;
  96. procedure tjvmcallparanode.push_copyout_para;
  97. var
  98. mangledname: string;
  99. primitivetype: boolean;
  100. opc: tasmop;
  101. begin
  102. { create an array with one element of the parameter type }
  103. thlcgjvm(hlcg).a_load_const_stack(current_asmdata.CurrAsmList,s32inttype,1,R_INTREGISTER);
  104. mangledname:=jvmarrtype(left.resultdef,primitivetype);
  105. if primitivetype then
  106. opc:=a_newarray
  107. else
  108. opc:=a_anewarray;
  109. { doesn't change stack height: one int replaced by one reference }
  110. current_asmdata.CurrAsmList.concat(taicpu.op_sym(opc,current_asmdata.RefAsmSymbol(mangledname)));
  111. load_arrayref_para(left.resultdef);
  112. end;
  113. procedure getparabasenodes(p: tnode; out basenode: tnode; out parent: tunarynode);
  114. begin
  115. parent:=nil;
  116. while assigned(p) do
  117. begin
  118. case p.nodetype of
  119. inlinen:
  120. begin
  121. if tinlinenode(p).inlinenumber=in_box_x then
  122. begin
  123. parent:=tunarynode(p);
  124. p:=parent.left;
  125. end
  126. else
  127. break;
  128. end;
  129. subscriptn,
  130. vecn:
  131. begin
  132. break;
  133. end;
  134. typeconvn:
  135. begin
  136. parent:=tunarynode(p);
  137. { skip typeconversions that don't change the node type }
  138. p:=p.actualtargetnode;
  139. end;
  140. derefn:
  141. begin
  142. parent:=tunarynode(p);
  143. p:=tunarynode(p).left;
  144. end
  145. else
  146. break;
  147. end;
  148. end;
  149. basenode:=p;
  150. end;
  151. function replacewithtemps(var orgnode, copiednode: tnode): ttempcreatenode;
  152. begin
  153. result:=ctempcreatenode.create_value(
  154. orgnode.resultdef,orgnode.resultdef.size,
  155. tt_persistent,true,orgnode);
  156. { this right is reused while constructing the temp }
  157. orgnode:=ctemprefnode.create(result);
  158. typecheckpass(orgnode);
  159. { this right is not reused }
  160. copiednode.free;
  161. copiednode:=ctemprefnode.create(result);
  162. typecheckpass(copiednode);
  163. end;
  164. procedure tjvmcallparanode.handleformalcopyoutpara(orgparadef: tdef);
  165. var
  166. paravaltemp,
  167. arraytemp,
  168. indextemp: ttempcreatenode;
  169. arrdef: tarraydef;
  170. initstat,
  171. finistat: tstatementnode;
  172. leftcopy: tnode;
  173. realpara, copyrealpara, tempn, assignmenttempn: tnode;
  174. realparaparent,copyrealparaparent: tunarynode;
  175. derefbasedef: tdef;
  176. deref: boolean;
  177. begin
  178. fparainit:=internalstatements(initstat);
  179. { In general, we now create a temp array of one element, assign left
  180. (or its address in case of a jvmimplicitpointertype) to it, replace
  181. the parameter with this array, and add code to paracopyback that
  182. extracts the value from the array again and assigns it to the original
  183. variable.
  184. Complications
  185. a) in case the parameter involves calling a function, it must not
  186. be called twice, so take the address of the location (since this
  187. is a var/out parameter, taking the address is conceptually
  188. always possible)
  189. b) in case this is an element of a string, we can't take the address
  190. in JVM code, so we then have to take the address of the string
  191. (which conceptually may not be possible since it can be a
  192. property or so) and store the index value into a temp, and
  193. reconstruct the vecn in te paracopyback code from this data
  194. (it's similar for normal var/out parameters)
  195. }
  196. { we'll replace a bunch of stuff in the parameter with temprefnodes,
  197. but we can't take a getcopy for the assignment afterwards of this
  198. result since a getcopy will always assume that we are copying the
  199. init/deletenodes too and that the temprefnodes have to point to the
  200. new temps -> get a copy of the parameter in advance, and then replace
  201. the nodes in the copy with temps just like in the original para }
  202. leftcopy:=left.getcopy;
  203. { get the real parameter source in case of type conversions. This is
  204. the same logic as for set_unique(). The parent is where we have to
  205. replace realpara with the temp that replaces it. }
  206. getparabasenodes(left,realpara,realparaparent);
  207. getparabasenodes(leftcopy,copyrealpara,copyrealparaparent);
  208. { assign either the parameter's address (in case it's an implicit
  209. pointer type) or the parameter itself (in case it's a primitive or
  210. actual pointer/object type) to the temp }
  211. deref:=false;
  212. if jvmimplicitpointertype(realpara.resultdef) then
  213. begin
  214. derefbasedef:=realpara.resultdef;
  215. realpara:=caddrnode.create_internal(realpara);
  216. include(realpara.flags,nf_typedaddr);
  217. typecheckpass(realpara);
  218. { we'll have to reference the parameter again in the expression }
  219. deref:=true;
  220. end;
  221. paravaltemp:=nil;
  222. { make sure we don't replace simple loadnodes with a temp, because
  223. in case of passing e.g. stringvar[3] to a formal var/out parameter,
  224. we add "stringvar[3]:=<result>" afterwards. Because Java strings are
  225. immutable, this is translated into "stringvar:=stringvar.setChar(3,
  226. <result>)". So if we replace stringvar with a temp, this will change
  227. the temp rather than stringvar. }
  228. indextemp:=nil;
  229. if (realpara.nodetype=vecn) then
  230. begin
  231. if node_complexity(tvecnode(realpara).left)>1 then
  232. begin
  233. paravaltemp:=replacewithtemps(tvecnode(realpara).left,
  234. tvecnode(copyrealpara).left);
  235. addstatement(initstat,paravaltemp);
  236. end;
  237. { in case of an array index, also replace the index with a temp if
  238. necessary/useful }
  239. if (node_complexity(tvecnode(realpara).right)>1) then
  240. begin
  241. indextemp:=replacewithtemps(tvecnode(realpara).right,
  242. tvecnode(copyrealpara).right);
  243. addstatement(initstat,indextemp);
  244. end;
  245. end
  246. else
  247. begin
  248. paravaltemp:=ctempcreatenode.create_value(
  249. realpara.resultdef,java_jlobject.size,tt_persistent,true,realpara);
  250. addstatement(initstat,paravaltemp);
  251. { replace the parameter in the parameter expression with this temp }
  252. tempn:=ctemprefnode.create(paravaltemp);
  253. assignmenttempn:=ctemprefnode.create(paravaltemp);
  254. { will be spliced in the middle of a tree that has already been
  255. typecheckpassed }
  256. typecheckpass(tempn);
  257. typecheckpass(assignmenttempn);
  258. if assigned(realparaparent) then
  259. begin
  260. { left has been reused in paravaltemp (it's realpara itself) ->
  261. don't free }
  262. realparaparent.left:=tempn;
  263. { the left's copy is not reused }
  264. copyrealparaparent.left.free;
  265. copyrealparaparent.left:=assignmenttempn;
  266. end
  267. else
  268. begin
  269. { left has been reused in paravaltemp (it's realpara itself) ->
  270. don't free }
  271. left:=tempn;
  272. { leftcopy can remain the same }
  273. assignmenttempn.free;
  274. end;
  275. end;
  276. { create the array temp that and assign the parameter value (typecasted
  277. to java_jlobject) }
  278. arrdef:=tarraydef.create(0,1,s32inttype);
  279. arrdef.elementdef:=java_jlobject;
  280. arraytemp:=ctempcreatenode.create(arrdef,java_jlobject.size,
  281. tt_persistent,true);
  282. addstatement(initstat,arraytemp);
  283. { wrap the primitive type in an object container
  284. if required }
  285. if (left.resultdef.typ in [orddef,floatdef]) then
  286. begin
  287. left:=cinlinenode.create(in_box_x,false,ccallparanode.create(left,nil));
  288. typecheckpass(left);
  289. end;
  290. addstatement(initstat,cassignmentnode.create(
  291. cvecnode.create(ctemprefnode.create(arraytemp),genintconstnode(0)),
  292. ctypeconvnode.create_explicit(left,java_jlobject)));
  293. { replace the parameter with the array }
  294. left:=ctemprefnode.create(arraytemp);
  295. { add the extraction of the parameter and assign it back to the
  296. original location }
  297. fparacopyback:=internalstatements(finistat);
  298. tempn:=cvecnode.create(ctemprefnode.create(arraytemp),genintconstnode(0));
  299. { unbox if necessary }
  300. if orgparadef.typ in [orddef,floatdef] then
  301. tempn:=cinlinenode.create(in_unbox_x_y,false,ccallparanode.create(
  302. ctypenode.create(orgparadef),ccallparanode.create(tempn,nil)));
  303. if (deref) then
  304. begin
  305. inserttypeconv_explicit(tempn,getpointerdef(derefbasedef));
  306. tempn:=cderefnode.create(tempn);
  307. end;
  308. addstatement(finistat,cassignmentnode.create(leftcopy,
  309. ctypeconvnode.create_explicit(tempn,orgparadef)));
  310. if assigned(indextemp) then
  311. addstatement(finistat,ctempdeletenode.create(indextemp));
  312. addstatement(finistat,ctempdeletenode.create(arraytemp));
  313. if assigned(paravaltemp) then
  314. addstatement(finistat,ctempdeletenode.create(paravaltemp));
  315. typecheckpass(fparainit);
  316. typecheckpass(left);
  317. typecheckpass(fparacopyback);
  318. end;
  319. {*****************************************************************************
  320. TJVMCALLNODE
  321. *****************************************************************************}
  322. procedure tjvmcallnode.extra_pre_call_code;
  323. begin
  324. { when calling a constructor, first create a new instance, except
  325. when calling it from another constructor (because then this has
  326. already been done before calling the current constructor) }
  327. if procdefinition.typ<>procdef then
  328. exit;
  329. if tabstractprocdef(procdefinition).proctypeoption<>potype_constructor then
  330. exit;
  331. if not(methodpointer.resultdef.typ in [classrefdef,recorddef]) then
  332. exit;
  333. current_asmdata.CurrAsmList.concat(taicpu.op_sym(a_new,current_asmdata.RefAsmSymbol(tabstractrecorddef(tabstractprocdef(procdefinition).owner.defowner).jvm_full_typename(true))));
  334. { the constructor doesn't return anything, so put a duplicate of the
  335. self pointer on the evaluation stack for use as function result
  336. after the constructor has run }
  337. current_asmdata.CurrAsmList.concat(taicpu.op_none(a_dup));
  338. thlcgjvm(hlcg).incstack(current_asmdata.CurrAsmList,2);
  339. end;
  340. procedure tjvmcallnode.set_result_location(realresdef: tstoreddef);
  341. begin
  342. location_reset_ref(location,LOC_REFERENCE,def_cgsize(realresdef),1);
  343. { in case of jvmimplicitpointertype(), the function will have allocated
  344. it already and we don't have to allocate it again here }
  345. if not jvmimplicitpointertype(realresdef) then
  346. tg.gethltemp(current_asmdata.CurrAsmList,realresdef,realresdef.size,tt_normal,location.reference)
  347. else
  348. tg.gethltemp(current_asmdata.CurrAsmList,java_jlobject,java_jlobject.size,tt_normal,location.reference);
  349. end;
  350. procedure tjvmcallnode.do_release_unused_return_value;
  351. begin
  352. if (tabstractprocdef(procdefinition).proctypeoption=potype_constructor) and
  353. (current_procinfo.procdef.proctypeoption=potype_constructor) then
  354. exit;
  355. if (location.loc=LOC_REFERENCE) then
  356. tg.ungetiftemp(current_asmdata.CurrAsmList,location.reference);
  357. if assigned(funcretnode) then
  358. exit;
  359. case resultdef.size of
  360. 0:
  361. ;
  362. 1..4:
  363. begin
  364. current_asmdata.CurrAsmList.concat(taicpu.op_none(a_pop));
  365. thlcgjvm(hlcg).decstack(current_asmdata.CurrAsmList,1);
  366. end;
  367. 8:
  368. begin
  369. current_asmdata.CurrAsmList.concat(taicpu.op_none(a_pop2));
  370. thlcgjvm(hlcg).decstack(current_asmdata.CurrAsmList,2);
  371. end
  372. else
  373. internalerror(2011010305);
  374. end;
  375. end;
  376. procedure tjvmcallnode.extra_post_call_code;
  377. var
  378. totalremovesize: longint;
  379. realresdef: tdef;
  380. ppn: tjvmcallparanode;
  381. pararef: treference;
  382. begin
  383. if not assigned(typedef) then
  384. realresdef:=tstoreddef(resultdef)
  385. else
  386. realresdef:=tstoreddef(typedef);
  387. { a constructor doesn't actually return a value in the jvm }
  388. if (tabstractprocdef(procdefinition).proctypeoption=potype_constructor) then
  389. totalremovesize:=pushedparasize
  390. else
  391. { even a byte takes up a full stackslot -> align size to multiple of 4 }
  392. totalremovesize:=pushedparasize-(align(realresdef.size,4) shr 2);
  393. { remove parameters from internal evaluation stack counter (in case of
  394. e.g. no parameters and a result, it can also increase) }
  395. if totalremovesize>0 then
  396. thlcgjvm(hlcg).decstack(current_asmdata.CurrAsmList,totalremovesize)
  397. else if totalremovesize<0 then
  398. thlcgjvm(hlcg).incstack(current_asmdata.CurrAsmList,-totalremovesize);
  399. { if this was an inherited constructor call, initialise all fields that
  400. are wrapped types following it }
  401. if (tabstractprocdef(procdefinition).proctypeoption=potype_constructor) and
  402. (cnf_inherited in callnodeflags) then
  403. thlcgjvm(hlcg).gen_initialize_fields_code(current_asmdata.CurrAsmList);
  404. { copy back the copyout parameter values, if any }
  405. { Release temps from parameters }
  406. ppn:=tjvmcallparanode(left);
  407. while assigned(ppn) do
  408. begin
  409. if assigned(ppn.left) then
  410. begin
  411. if (ppn.outcopybasereg<>NR_NO) then
  412. begin
  413. reference_reset_base(pararef,NR_NO,0,4);
  414. pararef.arrayreftype:=art_indexconst;
  415. pararef.base:=ppn.outcopybasereg;
  416. pararef.indexoffset:=0;
  417. { the value has to be copied back into persistent storage }
  418. if (ppn.parasym.vardef.typ<>formaldef) then
  419. begin
  420. case ppn.left.location.loc of
  421. LOC_REFERENCE:
  422. hlcg.a_load_ref_ref(current_asmdata.CurrAsmList,ppn.left.resultdef,ppn.left.resultdef,pararef,ppn.left.location.reference);
  423. LOC_CREGISTER:
  424. hlcg.a_load_ref_reg(current_asmdata.CurrAsmList,ppn.left.resultdef,ppn.left.resultdef,pararef,ppn.left.location.register);
  425. else
  426. internalerror(2011051201);
  427. end;
  428. end
  429. else
  430. begin
  431. { extracting values from foramldef parameters is done
  432. by the generic code }
  433. end;
  434. end;
  435. end;
  436. ppn:=tjvmcallparanode(ppn.right);
  437. end;
  438. end;
  439. function tjvmcallnode.dispatch_procvar: tnode;
  440. var
  441. pdclass: tobjectdef;
  442. prevpara, para, nextpara: tcallparanode;
  443. begin
  444. pdclass:=tprocvardef(right.resultdef).classdef;
  445. { convert procvar type into corresponding class }
  446. if not tprocvardef(right.resultdef).is_addressonly then
  447. begin
  448. right:=caddrnode.create_internal(right);
  449. include(right.flags,nf_typedaddr);
  450. end;
  451. right:=ctypeconvnode.create_explicit(right,pdclass);
  452. include(right.flags,nf_load_procvar);
  453. typecheckpass(right);
  454. { call the invoke method with these parameters. It will take care of the
  455. wrapping and typeconversions; first filter out the automatically added
  456. hidden parameters though }
  457. prevpara:=nil;
  458. para:=tcallparanode(left);
  459. while assigned(para) do
  460. begin
  461. nextpara:=tcallparanode(para.right);
  462. if vo_is_hidden_para in para.parasym.varoptions then
  463. begin
  464. if assigned(prevpara) then
  465. prevpara.right:=nextpara
  466. else
  467. left:=nextpara;
  468. para.right:=nil;
  469. para.free;
  470. end
  471. else
  472. prevpara:=para;
  473. para:=nextpara;
  474. end;
  475. result:=ccallnode.createinternmethod(right,'INVOKE',left);
  476. { reused }
  477. left:=nil;
  478. right:=nil;
  479. end;
  480. function tjvmcallnode.pass_1: tnode;
  481. begin
  482. { transform procvar calls }
  483. if assigned(right) then
  484. result:=dispatch_procvar
  485. else
  486. begin
  487. result:=inherited pass_1;
  488. if assigned(result) then
  489. exit;
  490. end;
  491. end;
  492. begin
  493. ccallnode:=tjvmcallnode;
  494. ccallparanode:=tjvmcallparanode;
  495. end.