njvminl.pas 27 KB

123456789101112131415161718192021222324252627282930313233343536373839404142434445464748495051525354555657585960616263646566676869707172737475767778798081828384858687888990919293949596979899100101102103104105106107108109110111112113114115116117118119120121122123124125126127128129130131132133134135136137138139140141142143144145146147148149150151152153154155156157158159160161162163164165166167168169170171172173174175176177178179180181182183184185186187188189190191192193194195196197198199200201202203204205206207208209210211212213214215216217218219220221222223224225226227228229230231232233234235236237238239240241242243244245246247248249250251252253254255256257258259260261262263264265266267268269270271272273274275276277278279280281282283284285286287288289290291292293294295296297298299300301302303304305306307308309310311312313314315316317318319320321322323324325326327328329330331332333334335336337338339340341342343344345346347348349350351352353354355356357358359360361362363364365366367368369370371372373374375376377378379380381382383384385386387388389390391392393394395396397398399400401402403404405406407408409410411412413414415416417418419420421422423424425426427428429430431432433434435436437438439440441442443444445446447448449450451452453454455456457458459460461462463464465466467468469470471472473474475476477478479480481482483484485486487488489490491492493494495496497498499500501502503504505506507508509510511512513514515516517518519520521522523524525526527528529530531532533534535536537538539540541542543544545546547548549550551552553554555556557558559560561562563564565566567568569570571572573574575576577578579580581582583584585586587588589590591592593594595596597598599600601602603604605606607608609610611612613614615616617618619620621622623624625626627628629630631632633634635636637638639640641642643644645646647648649650651652653654655656657658659660661662663664665666667668669670671672673674675676677678679680681682683684685686687688689690691692693694695696697698699700701702703704705706707708709710711712713714715716717718719720721722723724725726727728729730731732733734735736737738739740741742743744745746747748749750751752753754755756757758759760761762763764765766767768769770771772773774775
  1. {
  2. Copyright (c) 1998-2011 by Florian Klaempfl and Jonas Maebe
  3. Generate JVM inline 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 njvminl;
  18. {$i fpcdefs.inc}
  19. interface
  20. uses
  21. cpubase,
  22. node,ninl,ncginl;
  23. type
  24. tjvminlinenode = class(tcginlinenode)
  25. protected
  26. function typecheck_length(var handled: boolean): tnode;
  27. function typecheck_high(var handled: boolean): tnode;
  28. function typecheck_new(var handled: boolean): tnode;
  29. function first_copy: tnode; override;
  30. function handle_box: tnode; override;
  31. function first_box: tnode; override;
  32. function first_setlength_array: tnode;
  33. function first_setlength_string: tnode;
  34. public
  35. { typecheck override to intercept handling }
  36. function pass_typecheck: tnode; override;
  37. { first pass override
  38. so that the code generator will actually generate
  39. these nodes.
  40. }
  41. (*
  42. function first_sqrt_real: tnode; override;
  43. *)
  44. function first_sqr_real: tnode; override;
  45. function first_trunc_real: tnode; override;
  46. (*
  47. function first_round_real: tnode; override;
  48. *)
  49. function first_new: tnode; override;
  50. function first_setlength: tnode; override;
  51. function first_length: tnode; override;
  52. procedure second_length; override;
  53. (*
  54. procedure second_sqrt_real; override;
  55. procedure second_abs_real; override;
  56. *)
  57. procedure second_sqr_real; override;
  58. procedure second_trunc_real; override;
  59. (*
  60. procedure second_round_real; override;
  61. *)
  62. procedure second_new; override;
  63. procedure second_setlength; override;
  64. procedure second_box; override;
  65. protected
  66. procedure load_fpu_location;
  67. end;
  68. implementation
  69. uses
  70. cutils,globals,verbose,globtype,constexp,
  71. aasmbase,aasmtai,aasmdata,aasmcpu,
  72. symtype,symconst,symdef,symsym,symtable,jvmdef,
  73. defutil,
  74. nbas,ncon,ncnv,nmem,ncal,nld,nflw,nutils,
  75. cgbase,pass_1,pass_2,
  76. cpuinfo,ncgutil,
  77. cgutils,hlcgobj,hlcgcpu;
  78. {*****************************************************************************
  79. tjvminlinenode
  80. *****************************************************************************}
  81. function tjvminlinenode.typecheck_length(var handled: boolean): tnode;
  82. begin
  83. typecheckpass(left);
  84. if is_open_array(left.resultdef) or
  85. is_dynamic_array(left.resultdef) then
  86. begin
  87. resultdef:=s32inttype;
  88. result:=nil;
  89. handled:=true;
  90. end;
  91. end;
  92. function tjvminlinenode.typecheck_high(var handled: boolean): tnode;
  93. begin
  94. typecheckpass(left);
  95. if is_dynamic_array(left.resultdef) or
  96. is_open_array(left.resultdef) then
  97. begin
  98. { replace with pred(length(arr)) }
  99. result:=cinlinenode.create(in_pred_x,false,
  100. cinlinenode.create(in_length_x,false,left));
  101. left:=nil;
  102. handled:=true;
  103. end;
  104. end;
  105. function tjvminlinenode.typecheck_new(var handled: boolean): tnode;
  106. var
  107. para: tcallparanode;
  108. elemdef: tdef;
  109. begin
  110. { normally never exists; used by the JVM backend to create new
  111. arrays because it requires special opcodes }
  112. tcallparanode(left).get_paratype;
  113. if is_dynamic_array(left.resultdef) then
  114. begin
  115. para:=tcallparanode(left);
  116. { need at least one extra parameter in addition to the
  117. array }
  118. if not assigned(para.right) then
  119. internalerror(2011012206);
  120. elemdef:=tarraydef(left.resultdef).elementdef;
  121. while elemdef.typ=arraydef do
  122. begin
  123. { if we have less length specifiers than dimensions, make
  124. the last array an array of length 0 }
  125. if not assigned(para.right) then
  126. begin
  127. para.right:=ccallparanode.create(
  128. cordconstnode.create(0,s32inttype,false),nil);
  129. tcallparanode(para.right).get_paratype;
  130. break;
  131. end
  132. else
  133. begin
  134. inserttypeconv(tcallparanode(para.right).left,s32inttype);
  135. tcallparanode(para.right).get_paratype;
  136. end;
  137. para:=tcallparanode(para.right);
  138. elemdef:=tarraydef(elemdef).elementdef;
  139. end;
  140. result:=nil;
  141. resultdef:=left.resultdef;
  142. handled:=true;
  143. end;
  144. end;
  145. function tjvminlinenode.first_copy: tnode;
  146. var
  147. ppn: tcallparanode;
  148. arr, len, start, kind: tnode;
  149. eledef: tdef;
  150. counter, ndims: longint;
  151. finaltype: char;
  152. begin
  153. if is_dynamic_array(resultdef) then
  154. begin
  155. ppn:=tcallparanode(left);
  156. counter:=1;
  157. while assigned(ppn.right) do
  158. begin
  159. inc(counter);
  160. ppn:=tcallparanode(ppn.right);
  161. end;
  162. if (counter=3) then
  163. begin
  164. len:=tcallparanode(left).left;
  165. tcallparanode(left).left:=nil;
  166. start:=tcallparanode(tcallparanode(left).right).left;
  167. tcallparanode(tcallparanode(left).right).left:=nil;
  168. { free the original start/len paras and remove them }
  169. ppn:=tcallparanode(left);
  170. left:=tcallparanode(tcallparanode(left).right).right;
  171. tcallparanode(ppn.right).right:=nil;
  172. ppn.free;
  173. end
  174. else
  175. begin
  176. { use special -1,-1 argument to copy the whole array }
  177. len:=genintconstnode(-1);
  178. start:=genintconstnode(-1);
  179. end;
  180. { currently there is one parameter left: the array itself }
  181. arr:=tcallparanode(left).left;
  182. tcallparanode(left).left:=nil;
  183. { in case it's a dynamic array of static arrays, get the dimensions
  184. of the static array components }
  185. eledef:=tarraydef(resultdef).elementdef;
  186. ndims:=1;
  187. while (eledef.typ=arraydef) and
  188. not is_dynamic_array(eledef) do
  189. begin
  190. inc(ndims);
  191. eledef:=tarraydef(eledef).elementdef;
  192. end;
  193. { get the final element kind }
  194. finaltype:=jvmarrtype_setlength(eledef);
  195. { construct the call to
  196. fpc_dynarray_copy(src: JLObject; start, len: longint; ndim: longint; eletype: jchar) }
  197. result:=ccallnode.createintern('FPC_DYNARRAY_COPY',
  198. ccallparanode.create(cordconstnode.create(ord(finaltype),cwidechartype,false),
  199. ccallparanode.create(genintconstnode(ndims),
  200. ccallparanode.create(len,
  201. ccallparanode.create(start,
  202. ccallparanode.create(ctypeconvnode.create_explicit(arr,java_jlobject),nil)
  203. )
  204. )
  205. )
  206. )
  207. );
  208. inserttypeconv_explicit(result,resultdef);
  209. end
  210. else
  211. result:=inherited first_copy;
  212. end;
  213. function tjvminlinenode.handle_box: tnode;
  214. begin
  215. Result:=inherited;
  216. resultdef:=java_jlobject;
  217. end;
  218. function tjvminlinenode.first_box: tnode;
  219. begin
  220. result:=nil;
  221. expectloc:=LOC_REGISTER;
  222. {$ifdef nounsupported}
  223. internalerror(2011042603);
  224. {$endif}
  225. end;
  226. function tjvminlinenode.pass_typecheck: tnode;
  227. var
  228. handled: boolean;
  229. begin
  230. handled:=false;
  231. case inlinenumber of
  232. in_length_x:
  233. begin
  234. result:=typecheck_length(handled);
  235. end;
  236. in_high_x:
  237. begin
  238. result:=typecheck_high(handled);
  239. end;
  240. in_new_x:
  241. begin
  242. result:=typecheck_new(handled);
  243. end;
  244. end;
  245. if not handled then
  246. result:=inherited pass_typecheck;
  247. end;
  248. (*
  249. function tjvminlinenode.first_sqrt_real : tnode;
  250. begin
  251. if (current_settings.cputype >= cpu_PPC970) then
  252. begin
  253. expectloc:=LOC_FPUREGISTER;
  254. first_sqrt_real := nil;
  255. end
  256. else
  257. result:=inherited first_sqrt_real;
  258. end;
  259. *)
  260. function tjvminlinenode.first_sqr_real : tnode;
  261. begin
  262. expectloc:=LOC_FPUREGISTER;
  263. first_sqr_real:=nil;
  264. end;
  265. function tjvminlinenode.first_trunc_real : tnode;
  266. begin
  267. expectloc:=LOC_REGISTER;
  268. first_trunc_real:=nil;
  269. end;
  270. function tjvminlinenode.first_new: tnode;
  271. begin
  272. { skip the array; it's a type node }
  273. tcallparanode(tcallparanode(left).right).firstcallparan;
  274. expectloc:=LOC_REGISTER;
  275. result:=nil;
  276. end;
  277. function tjvminlinenode.first_setlength_array: tnode;
  278. var
  279. assignmenttarget,
  280. ppn,
  281. newparas: tnode;
  282. newnode: tnode;
  283. eledef,
  284. objarraydef: tdef;
  285. ndims: longint;
  286. finaltype: char;
  287. setlenroutine: string;
  288. lefttemp: ttempcreatenode;
  289. newblock: tblocknode;
  290. newstatement: tstatementnode;
  291. primitive: boolean;
  292. begin
  293. { first parameter is the array, the rest are the dimensions }
  294. newparas:=tcallparanode(left).right;
  295. tcallparanode(left).right:=nil;
  296. { count the number of specified dimensions, and determine the type of
  297. the final one }
  298. ppn:=newparas;
  299. eledef:=tarraydef(left.resultdef).elementdef;
  300. { ppn already points to the first dimension }
  301. ndims:=1;
  302. while assigned(tcallparanode(ppn).right) do
  303. begin
  304. inc(ndims);
  305. eledef:=tarraydef(eledef).elementdef;
  306. ppn:=tcallparanode(ppn).right;
  307. end;
  308. { in case it's a dynamic array of static arrays, we must also allocate
  309. the static arrays! }
  310. while (eledef.typ=arraydef) and
  311. not is_dynamic_array(eledef) do
  312. begin
  313. inc(ndims);
  314. tcallparanode(ppn).right:=
  315. ccallparanode.create(
  316. genintconstnode(tarraydef(eledef).elecount),nil);
  317. ppn:=tcallparanode(ppn).right;
  318. eledef:=tarraydef(eledef).elementdef;
  319. end;
  320. { prepend type parameter for the array }
  321. newparas:=ccallparanode.create(ctypenode.create(left.resultdef),newparas);
  322. ttypenode(tcallparanode(newparas).left).allowed:=true;
  323. { node to create the new array }
  324. newnode:=cinlinenode.create(in_new_x,false,newparas);
  325. { Common parameters for setlength helper }
  326. { start with org (save assignmenttarget itself to assign the result back to) }
  327. { store left into a temp in case it may contain a function call
  328. (which must not be evaluated twice) }
  329. newblock:=nil;
  330. newstatement:=nil;
  331. lefttemp:=maybereplacewithtempref(tcallparanode(left).left,newblock,newstatement,tcallparanode(left).left.resultdef.size,false);
  332. if assigned(lefttemp) then
  333. begin
  334. assignmenttarget:=ctemprefnode.create(lefttemp);
  335. typecheckpass(tnode(assignmenttarget));
  336. end
  337. else
  338. assignmenttarget:=tcallparanode(left).left.getcopy;
  339. newparas:=left;
  340. left:=nil;
  341. finaltype:=jvmarrtype_setlength(eledef);
  342. { since the setlength prototypes require certain types, insert
  343. explicit type conversions where necessary }
  344. objarraydef:=nil;
  345. if (ndims>1) then
  346. begin
  347. { expects array of JLObject }
  348. setlenroutine:='FPC_SETLENGTH_DYNARR_MULTIDIM';
  349. objarraydef:=search_system_type('TJOBJECTARRAY').typedef
  350. end
  351. else
  352. begin
  353. case finaltype of
  354. 'R':
  355. begin
  356. { expects array of FpcBaseRecord}
  357. setlenroutine:='FPC_SETLENGTH_DYNARR_JRECORD';
  358. objarraydef:=search_system_type('TJRECORDARRAY').typedef;
  359. end;
  360. 'T':
  361. begin
  362. { expects array of ShortstringClass}
  363. setlenroutine:='FPC_SETLENGTH_DYNARR_JSHORTSTRING';
  364. objarraydef:=search_system_type('TSHORTSTRINGARRAY').typedef;
  365. end;
  366. else
  367. begin
  368. { expects JLObject }
  369. setlenroutine:='FPC_SETLENGTH_DYNARR_GENERIC';
  370. objarraydef:=java_jlobject;
  371. end
  372. end;
  373. end;
  374. tcallparanode(newparas).left:=ctypeconvnode.create_explicit(tcallparanode(newparas).left,objarraydef);
  375. newnode:=ctypeconvnode.create_explicit(newnode,objarraydef);
  376. { prepend new }
  377. newparas:=ccallparanode.create(newnode,newparas);
  378. { prepend deepcopy }
  379. newparas:=ccallparanode.create(cordconstnode.create(0,pasbool8type,false),newparas);
  380. { call the right setlenght helper }
  381. if ndims>1 then
  382. begin
  383. { create proper parameters, from right to left:
  384. eletype=finaltype, ndim=ndims, deepcopy=false, new=newnode,
  385. assignmenttarget=tcallparanode(left).left }
  386. { prepend ndim }
  387. newparas:=ccallparanode.create(cordconstnode.create(ndims,s32inttype,false),newparas);
  388. { prepend eletype }
  389. newparas:=ccallparanode.create(cordconstnode.create(ord(finaltype),cwidechartype,false),newparas);
  390. end
  391. else
  392. begin
  393. { create proper parameters, from right to left:
  394. deepcopy=false, new=newnode, assignmenttarget=tcallparnode(left).left
  395. -> already done in common part above }
  396. end;
  397. result:=ccallnode.createintern(setlenroutine,newparas);
  398. { assign result back to org (no call-by-reference for Java) }
  399. result:=cassignmentnode.create(assignmenttarget,
  400. ctypeconvnode.create_explicit(result,assignmenttarget.resultdef));
  401. if assigned(lefttemp) then
  402. begin
  403. addstatement(newstatement,result);
  404. addstatement(newstatement,ctempdeletenode.create(lefttemp));
  405. result:=newblock;
  406. end;
  407. end;
  408. function tjvminlinenode.first_setlength_string: tnode;
  409. var
  410. newblock: tblocknode;
  411. newstatement: tstatementnode;
  412. lefttemp: ttempcreatenode;
  413. assignmenttarget: tnode;
  414. stringtype: tstringdef;
  415. begin
  416. if is_wide_or_unicode_string(left.resultdef) or
  417. is_ansistring(left.resultdef) then
  418. begin
  419. stringtype:=tstringdef(left.resultdef);
  420. { store left into a temp in case it may contain a function call
  421. (which must not be evaluated twice) }
  422. newblock:=nil;
  423. newstatement:=nil;
  424. lefttemp:=maybereplacewithtempref(tcallparanode(left).left,newblock,newstatement,stringtype.size,false);
  425. if assigned(lefttemp) then
  426. begin
  427. assignmenttarget:=ctemprefnode.create(lefttemp);
  428. typecheckpass(tnode(assignmenttarget));
  429. end
  430. else
  431. assignmenttarget:=tcallparanode(left).left.getcopy;
  432. { back to original order for the call }
  433. left:=reverseparameters(tcallparanode(left));
  434. result:=cassignmentnode.create(assignmenttarget,
  435. ccallnode.createintern('fpc_'+stringtype.stringtypname+'_setlength',left));
  436. if assigned(lefttemp) then
  437. begin
  438. addstatement(newstatement,result);
  439. addstatement(newstatement,ctempdeletenode.create(lefttemp));
  440. result:=newblock;
  441. end;
  442. left:=nil;
  443. end
  444. else
  445. internalerror(2011031405);
  446. end;
  447. function tjvminlinenode.first_setlength: tnode;
  448. begin
  449. { reverse the parameter order so we can process them more easily }
  450. left:=reverseparameters(tcallparanode(left));
  451. if is_shortstring(left.resultdef) then
  452. begin
  453. left:=reverseparameters(tcallparanode(left));
  454. result:=inherited first_setlength;
  455. exit;
  456. end;
  457. { treat setlength(x,0) specially: used to init uninitialised locations }
  458. if not assigned(tcallparanode(tcallparanode(left).right).right) and
  459. is_constintnode(tcallparanode(tcallparanode(left).right).left) and
  460. (tordconstnode(tcallparanode(tcallparanode(left).right).left).value=0) then
  461. begin
  462. result:=nil;
  463. expectloc:=LOC_VOID;
  464. exit;
  465. end;
  466. case left.resultdef.typ of
  467. arraydef:
  468. result:=first_setlength_array;
  469. stringdef:
  470. result:=first_setlength_string;
  471. else
  472. internalerror(2011031204);
  473. end;
  474. end;
  475. function tjvminlinenode.first_length: tnode;
  476. var
  477. newblock: tblocknode;
  478. newstatement: tstatementnode;
  479. lentemp: ttempcreatenode;
  480. ifcond,
  481. stringnonnull,
  482. stringnull: tnode;
  483. psym: tsym;
  484. stringclass: tdef;
  485. begin
  486. if is_wide_or_unicode_string(left.resultdef) or
  487. is_ansistring(left.resultdef) then
  488. begin
  489. { if assigned(stringclass(left)) then
  490. lentemp:=stringclass(left).length()
  491. else
  492. lentemp:=0;
  493. --> return lentemp
  494. }
  495. if is_ansistring(left.resultdef) then
  496. stringclass:=java_ansistring
  497. else
  498. stringclass:=java_jlstring;
  499. newblock:=internalstatements(newstatement);
  500. lentemp:=ctempcreatenode.create(s32inttype,s32inttype.size,tt_persistent,true);
  501. addstatement(newstatement,lentemp);
  502. { if-condition }
  503. ifcond:=cinlinenode.create(in_assigned_x,false,
  504. ccallparanode.create(ctypeconvnode.create_explicit(left.getcopy,stringclass),nil));
  505. { then-path (reuse left, since last use) }
  506. psym:=search_struct_member(tabstractrecorddef(stringclass),'LENGTH');
  507. if not assigned(psym) or
  508. (psym.typ<>procsym) then
  509. internalerror(2011031403);
  510. stringnonnull:=cassignmentnode.create(
  511. ctemprefnode.create(lentemp),
  512. ccallnode.create(nil,tprocsym(psym),psym.owner,
  513. ctypeconvnode.create_explicit(left,stringclass),[]));
  514. left:=nil;
  515. { else-path}
  516. stringnull:=cassignmentnode.create(
  517. ctemprefnode.create(lentemp),
  518. genintconstnode(0));
  519. { complete if-statement }
  520. addstatement(newstatement,cifnode.create(ifcond,stringnonnull,stringnull));
  521. { return temp }
  522. addstatement(newstatement,ctempdeletenode.create_normal_temp(lentemp));
  523. addstatement(newstatement,ctemprefnode.create(lentemp));
  524. result:=newblock;
  525. end
  526. else if is_shortstring(left.resultdef) then
  527. begin
  528. psym:=search_struct_member(tabstractrecorddef(java_shortstring),'LENGTH');
  529. if not assigned(psym) or
  530. (psym.typ<>procsym) then
  531. internalerror(2011052402);
  532. result:=
  533. ccallnode.create(nil,tprocsym(psym),psym.owner,
  534. ctypeconvnode.create_explicit(caddrnode.create_internal(left),java_shortstring),[]);
  535. { reused }
  536. left:=nil;
  537. end
  538. { should be no other string types }
  539. else if left.resultdef.typ=stringdef then
  540. internalerror(2011052403)
  541. else
  542. result:=inherited first_length;
  543. end;
  544. procedure tjvminlinenode.second_length;
  545. begin
  546. if is_dynamic_array(left.resultdef) or
  547. is_open_array(left.resultdef) then
  548. begin
  549. location_reset(location,LOC_REGISTER,OS_S32);
  550. location.register:=hlcg.getintregister(current_asmdata.CurrAsmList,s32inttype);
  551. secondpass(left);
  552. thlcgjvm(hlcg).g_getarraylen(current_asmdata.CurrAsmList,left.location);
  553. thlcgjvm(hlcg).a_load_stack_reg(current_asmdata.CurrAsmList,resultdef,location.register);
  554. end
  555. else
  556. internalerror(2011012004);
  557. end;
  558. (*
  559. function tjvminlinenode.first_round_real : tnode;
  560. begin
  561. if (current_settings.cputype >= cpu_PPC970) then
  562. begin
  563. expectloc:=LOC_REFERENCE;
  564. first_round_real := nil;
  565. end
  566. else
  567. result:=inherited first_round_real;
  568. end;
  569. *)
  570. { load the FPU value on the evaluation stack }
  571. procedure tjvminlinenode.load_fpu_location;
  572. begin
  573. secondpass(left);
  574. thlcgjvm(hlcg).a_load_loc_stack(current_asmdata.CurrAsmList,left.resultdef,left.location);
  575. end;
  576. (*
  577. procedure tjvminlinenode.second_sqrt_real;
  578. begin
  579. if (current_settings.cputype < cpu_PPC970) then
  580. internalerror(2007020910);
  581. location.loc:=LOC_FPUREGISTER;
  582. load_fpu_location;
  583. case left.location.size of
  584. OS_F32:
  585. current_asmdata.CurrAsmList.concat(taicpu.op_reg_reg(A_FSQRTS,location.register,
  586. left.location.register));
  587. OS_F64:
  588. current_asmdata.CurrAsmList.concat(taicpu.op_reg_reg(A_FSQRT,location.register,
  589. left.location.register));
  590. else
  591. inherited;
  592. end;
  593. end;
  594. *)
  595. procedure tjvminlinenode.second_sqr_real;
  596. begin
  597. load_fpu_location;
  598. location_reset(location,LOC_FPUREGISTER,location.size);
  599. location.register:=hlcg.getfpuregister(current_asmdata.CurrAsmList,resultdef);
  600. case left.location.size of
  601. OS_F32:
  602. begin
  603. current_asmdata.CurrAsmList.concat(taicpu.op_none(a_dup));
  604. thlcgjvm(hlcg).incstack(current_asmdata.CurrAsmList,1);
  605. current_asmdata.CurrAsmList.concat(taicpu.op_none(a_fmul));
  606. thlcgjvm(hlcg).decstack(current_asmdata.CurrAsmList,1);
  607. end;
  608. OS_F64:
  609. begin
  610. current_asmdata.CurrAsmList.concat(taicpu.op_none(a_dup2));
  611. thlcgjvm(hlcg).incstack(current_asmdata.CurrAsmList,2);
  612. current_asmdata.CurrAsmList.concat(taicpu.op_none(a_dmul));
  613. thlcgjvm(hlcg).decstack(current_asmdata.CurrAsmList,2);
  614. end;
  615. else
  616. internalerror(2011010804);
  617. end;
  618. thlcgjvm(hlcg).a_load_stack_reg(current_asmdata.CurrAsmList,resultdef,location.register);
  619. end;
  620. procedure tjvminlinenode.second_trunc_real;
  621. begin
  622. load_fpu_location;
  623. location_reset(location,LOC_REGISTER,left.location.size);
  624. location.register:=hlcg.getintregister(current_asmdata.CurrAsmList,resultdef);
  625. case left.location.size of
  626. OS_F32:
  627. begin
  628. current_asmdata.CurrAsmList.concat(taicpu.op_none(a_f2l));
  629. { 32 bit float -> 64 bit int: +1 stack slot }
  630. thlcgjvm(hlcg).incstack(current_asmdata.CurrAsmList,1);
  631. end;
  632. OS_F64:
  633. begin
  634. { 64 bit float -> 64 bit int: same number of stack slots }
  635. current_asmdata.CurrAsmList.concat(taicpu.op_none(a_d2l));
  636. end;
  637. else
  638. internalerror(2011010805);
  639. end;
  640. thlcgjvm(hlcg).a_load_stack_reg(current_asmdata.CurrAsmList,resultdef,location.register);
  641. end;
  642. procedure tjvminlinenode.second_new;
  643. var
  644. arr: tnode;
  645. hp: tcallparanode;
  646. paracount: longint;
  647. begin
  648. hp:=tcallparanode(left);
  649. { we don't second pass this one, it's only a type node }
  650. arr:=hp.left;
  651. if not is_dynamic_array(arr.resultdef) then
  652. internalerror(2011012204);
  653. hp:=tcallparanode(hp.right);
  654. if not assigned(hp) then
  655. internalerror(2011012205);
  656. paracount:=0;
  657. { put all the dimensions on the stack }
  658. repeat
  659. inc(paracount);
  660. secondpass(hp.left);
  661. thlcgjvm(hlcg).a_load_loc_stack(current_asmdata.CurrAsmList,hp.left.resultdef,hp.left.location);
  662. hp:=tcallparanode(hp.right);
  663. until not assigned(hp);
  664. { create the array }
  665. thlcgjvm(hlcg).g_newarray(current_asmdata.CurrAsmList,arr.resultdef,paracount);
  666. location_reset(location,LOC_REGISTER,OS_ADDR);
  667. location.register:=hlcg.getaddressregister(current_asmdata.CurrAsmList,resultdef);
  668. thlcgjvm(hlcg).a_load_stack_reg(current_asmdata.CurrAsmList,arr.resultdef,location.register);
  669. end;
  670. procedure tjvminlinenode.second_setlength;
  671. var
  672. target: tnode;
  673. lenpara: tnode;
  674. emptystr: ansichar;
  675. begin
  676. target:=tcallparanode(left).left;
  677. lenpara:=tcallparanode(tcallparanode(left).right).left;
  678. if assigned(tcallparanode(tcallparanode(left).right).right) or
  679. not is_constintnode(lenpara) or
  680. (tordconstnode(lenpara).value<>0) then
  681. internalerror(2011031801);
  682. secondpass(target);
  683. if is_wide_or_unicode_string(target.resultdef) then
  684. begin
  685. emptystr:=#0;
  686. current_asmdata.CurrAsmList.concat(taicpu.op_string(a_ldc,0,@emptystr));
  687. thlcgjvm(hlcg).incstack(current_asmdata.CurrAsmList,1);
  688. end
  689. else if is_ansistring(target.resultdef) then
  690. thlcgjvm(hlcg).a_load_const_stack(current_asmdata.CurrAsmList,java_jlobject,0,R_ADDRESSREGISTER)
  691. else if is_dynamic_array(target.resultdef) then
  692. begin
  693. thlcgjvm(hlcg).a_load_const_stack(current_asmdata.CurrAsmList,s32inttype,0,R_INTREGISTER);
  694. thlcgjvm(hlcg).g_newarray(current_asmdata.CurrAsmList,target.resultdef,1);
  695. end
  696. else
  697. internalerror(2011031401);
  698. thlcgjvm(hlcg).a_load_stack_loc(current_asmdata.CurrAsmList,target.resultdef,target.location);
  699. end;
  700. procedure tjvminlinenode.second_box;
  701. begin
  702. {$ifndef nounsupported}
  703. secondpass(tcallparanode(left).left);
  704. location_reset(location,LOC_REGISTER,OS_ADDR);
  705. location.register:=hlcg.getaddressregister(current_asmdata.CurrAsmList,java_jlobject);
  706. hlcg.a_load_const_reg(current_asmdata.CurrAsmList,java_jlobject,0,location.register);
  707. {$else}
  708. internalerror(2011042606);
  709. {$endif}
  710. end;
  711. begin
  712. cinlinenode:=tjvminlinenode;
  713. end.