ncgcal.pas 59 KB

123456789101112131415161718192021222324252627282930313233343536373839404142434445464748495051525354555657585960616263646566676869707172737475767778798081828384858687888990919293949596979899100101102103104105106107108109110111112113114115116117118119120121122123124125126127128129130131132133134135136137138139140141142143144145146147148149150151152153154155156157158159160161162163164165166167168169170171172173174175176177178179180181182183184185186187188189190191192193194195196197198199200201202203204205206207208209210211212213214215216217218219220221222223224225226227228229230231232233234235236237238239240241242243244245246247248249250251252253254255256257258259260261262263264265266267268269270271272273274275276277278279280281282283284285286287288289290291292293294295296297298299300301302303304305306307308309310311312313314315316317318319320321322323324325326327328329330331332333334335336337338339340341342343344345346347348349350351352353354355356357358359360361362363364365366367368369370371372373374375376377378379380381382383384385386387388389390391392393394395396397398399400401402403404405406407408409410411412413414415416417418419420421422423424425426427428429430431432433434435436437438439440441442443444445446447448449450451452453454455456457458459460461462463464465466467468469470471472473474475476477478479480481482483484485486487488489490491492493494495496497498499500501502503504505506507508509510511512513514515516517518519520521522523524525526527528529530531532533534535536537538539540541542543544545546547548549550551552553554555556557558559560561562563564565566567568569570571572573574575576577578579580581582583584585586587588589590591592593594595596597598599600601602603604605606607608609610611612613614615616617618619620621622623624625626627628629630631632633634635636637638639640641642643644645646647648649650651652653654655656657658659660661662663664665666667668669670671672673674675676677678679680681682683684685686687688689690691692693694695696697698699700701702703704705706707708709710711712713714715716717718719720721722723724725726727728729730731732733734735736737738739740741742743744745746747748749750751752753754755756757758759760761762763764765766767768769770771772773774775776777778779780781782783784785786787788789790791792793794795796797798799800801802803804805806807808809810811812813814815816817818819820821822823824825826827828829830831832833834835836837838839840841842843844845846847848849850851852853854855856857858859860861862863864865866867868869870871872873874875876877878879880881882883884885886887888889890891892893894895896897898899900901902903904905906907908909910911912913914915916917918919920921922923924925926927928929930931932933934935936937938939940941942943944945946947948949950951952953954955956957958959960961962963964965966967968969970971972973974975976977978979980981982983984985986987988989990991992993994995996997998999100010011002100310041005100610071008100910101011101210131014101510161017101810191020102110221023102410251026102710281029103010311032103310341035103610371038103910401041104210431044104510461047104810491050105110521053105410551056105710581059106010611062106310641065106610671068106910701071107210731074107510761077107810791080108110821083108410851086108710881089109010911092109310941095109610971098109911001101110211031104110511061107110811091110111111121113111411151116111711181119112011211122112311241125112611271128112911301131113211331134113511361137113811391140114111421143114411451146114711481149115011511152115311541155115611571158115911601161116211631164116511661167116811691170117111721173117411751176117711781179118011811182118311841185118611871188118911901191119211931194119511961197119811991200120112021203120412051206120712081209121012111212121312141215121612171218121912201221122212231224122512261227122812291230123112321233123412351236123712381239124012411242124312441245124612471248124912501251125212531254125512561257125812591260126112621263126412651266126712681269127012711272127312741275127612771278127912801281128212831284128512861287128812891290129112921293129412951296129712981299130013011302130313041305130613071308130913101311131213131314131513161317131813191320132113221323132413251326132713281329133013311332133313341335133613371338133913401341134213431344134513461347134813491350135113521353135413551356135713581359136013611362136313641365136613671368136913701371137213731374137513761377
  1. {
  2. Copyright (c) 1998-2002 by Florian Klaempfl
  3. Generate assembler 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 ncgcal;
  18. {$i fpcdefs.inc}
  19. interface
  20. uses
  21. cpubase,
  22. globtype,
  23. parabase,cgutils,
  24. aasmdata,cgbase,
  25. symdef,node,ncal;
  26. type
  27. tcgcallparanode = class(tcallparanode)
  28. protected
  29. procedure push_addr_para;
  30. procedure push_value_para;virtual;
  31. procedure push_formal_para;virtual;
  32. procedure push_copyout_para;virtual;abstract;
  33. function maybe_push_unused_para:boolean;virtual;
  34. public
  35. tempcgpara : tcgpara;
  36. constructor create(expr,next : tnode);override;
  37. destructor destroy;override;
  38. procedure secondcallparan;override;
  39. end;
  40. { tcgcallnode }
  41. tcgcallnode = class(tcallnode)
  42. private
  43. procedure handle_return_value;
  44. procedure release_unused_return_value;
  45. procedure copy_back_paras;
  46. procedure release_para_temps;
  47. procedure reorder_parameters;
  48. procedure freeparas;
  49. function is_parentfp_pushed:boolean;
  50. protected
  51. retloc: tcgpara;
  52. paralocs: array of pcgpara;
  53. framepointer_paraloc : tcgpara;
  54. {# This routine is used to push the current frame pointer
  55. on the stack. This is used in nested routines where the
  56. value of the frame pointer is always pushed as an extra
  57. parameter.
  58. The default handling is the standard handling used on
  59. most stack based machines, where the frame pointer is
  60. the first invisible parameter.
  61. }
  62. procedure pop_parasize(pop_size:longint);virtual;
  63. procedure extra_interrupt_code;virtual;
  64. procedure extra_pre_call_code;virtual;
  65. procedure extra_call_code;virtual;
  66. procedure extra_post_call_code;virtual;
  67. function get_syscall_libbase_paraloc: pcgparalocation;virtual;
  68. procedure get_syscall_call_ref(out tmpref: treference; reg: tregister);virtual;
  69. procedure do_syscall;virtual;abstract;
  70. { The function result is returned in a tcgpara. This tcgpara has to
  71. be translated into a tlocation so the rest of the code generator
  72. can work with it. This routine decides what the most appropriate
  73. tlocation is and sets self.location based on that. }
  74. procedure set_result_location(realresdef: tstoreddef);virtual;
  75. { if an unused return value is in another location than a
  76. LOC_REFERENCE, this method will be called to perform the necessary
  77. cleanups. By default it does not do anything }
  78. procedure do_release_unused_return_value;virtual;
  79. { Override the following three methods to support calls to address in
  80. 'ref' without loading it into register (only x86 targets probably).
  81. If can_call_ref returns true, it should do required simplification
  82. on ref. }
  83. function can_call_ref(var ref: treference):boolean;virtual;
  84. procedure extra_call_ref_code(var ref: treference);virtual;
  85. function do_call_ref(ref: treference): tcgpara;virtual;
  86. { store all the parameters in the temporary paralocs in their final
  87. location, and create the paralocs array that will be passed to
  88. hlcg.a_call_* }
  89. procedure pushparas;virtual;
  90. { loads the code pointer of a complex procvar (one with a self/
  91. parentfp/... and a procedure address) into a register and returns it }
  92. procedure load_complex_procvar_codeptr(out reg: tregister; out callprocdef: tabstractprocdef); virtual;
  93. { loads the procvar code pointer into a register with type def }
  94. procedure load_procvar_codeptr(out reg: tregister; out callprocdef: tabstractprocdef);
  95. procedure load_block_invoke(out toreg: tregister; out callprocdef: tabstractprocdef);
  96. function get_call_reg(list: TAsmList): tregister; virtual;
  97. procedure unget_call_reg(list: TAsmList; reg: tregister); virtual;
  98. public
  99. procedure pass_generate_code;override;
  100. destructor destroy;override;
  101. end;
  102. implementation
  103. uses
  104. systems,
  105. verbose,globals,
  106. symconst,symtable,symtype,symsym,defutil,paramgr,
  107. pass_2,
  108. nld,ncnv,
  109. ncgutil,blockutl,
  110. cgobj,tgobj,hlcgobj,
  111. procinfo,
  112. wpobase;
  113. function can_skip_para_push(parasym: tparavarsym): boolean;
  114. begin
  115. { We can skip passing the parameter when:
  116. the parameter can be optimized as unused
  117. and the target does not strictly require all parameters (has_strict_proc_signature = false)
  118. and fixed stack is used
  119. or the parameter is in a register
  120. or the parameter is $parentfp. }
  121. result:=paramanager.can_opt_unused_para(parasym) and
  122. not paramanager.has_strict_proc_signature and
  123. (paramanager.use_fixed_stack or
  124. (vo_is_parentfp in parasym.varoptions) or
  125. (parasym.paraloc[callerside].Location^.Loc in [LOC_REGISTER,LOC_CREGISTER]));
  126. end;
  127. {*****************************************************************************
  128. TCGCALLPARANODE
  129. *****************************************************************************}
  130. constructor tcgcallparanode.create(expr,next : tnode);
  131. begin
  132. inherited create(expr,next);
  133. tempcgpara.init;
  134. end;
  135. destructor tcgcallparanode.destroy;
  136. begin
  137. tempcgpara.done;
  138. inherited destroy;
  139. end;
  140. procedure tcgcallparanode.push_addr_para;
  141. var
  142. valuedef: tdef;
  143. begin
  144. if not(left.location.loc in [LOC_CREFERENCE,LOC_REFERENCE]) then
  145. internalerror(200304235);
  146. if maybe_push_unused_para then
  147. exit;
  148. { see the call to keep_para_array_range in ncal: if that call returned
  149. true, we overwrite the resultdef of left with its original resultdef
  150. (to keep track of the range of the original array); we inserted a type
  151. conversion to parasym.vardef, so that is the type this value actually
  152. has }
  153. if is_dynamic_array(left.resultdef) and
  154. is_open_array(parasym.vardef) then
  155. valuedef:=parasym.vardef
  156. else
  157. valuedef:=left.resultdef;
  158. hlcg.a_loadaddr_ref_cgpara(current_asmdata.CurrAsmList,valuedef,left.location.reference,tempcgpara);
  159. end;
  160. procedure tcgcallnode.reorder_parameters;
  161. var
  162. hpcurr,hpprev,hpnext,hpreversestart : tcgcallparanode;
  163. begin
  164. { All parameters are now in temporary locations. If we move them to
  165. their regular locations in the same order, then we get the
  166. following pattern for register parameters:
  167. mov para1, tempreg1
  168. mov para2, tempreg2
  169. mov para3, tempreg3
  170. mov tempreg1, parareg1
  171. mov tempreg2, parareg2
  172. mov tempreg3, parareg3
  173. The result is that all tempregs conflict with all pararegs.
  174. A better solution is to use:
  175. mov para1, tempreg1
  176. mov para2, tempreg2
  177. mov para3, tempreg3
  178. mov tempreg3, parareg3
  179. mov tempreg2, parareg2
  180. mov tempreg1, parareg1
  181. This way, tempreg2 can be the same as parareg1 etc.
  182. To achieve this, we invert the order of all LOC_XREGISTER
  183. paras (JM).
  184. }
  185. hpcurr:=tcgcallparanode(left);
  186. { assume all LOC_REFERENCE parameters come first
  187. (see tcallnode.order_parameters)
  188. }
  189. hpreversestart:=nil;
  190. while assigned(hpcurr) do
  191. begin
  192. if not(hpcurr.parasym.paraloc[callerside].location^.loc in [LOC_REFERENCE,LOC_CREFERENCE]) then
  193. hpreversestart:=hpcurr;
  194. hpcurr:=tcgcallparanode(hpcurr.right);
  195. end;
  196. { since all register tempparalocs have basically a complexity of 1,
  197. (unless there are large stack offsets that require a temp register on
  198. some architectures, but that's minor), we don't have to care about
  199. the internal relative order of different register type parameters
  200. }
  201. hpprev:=nil;
  202. hpcurr:=tcgcallparanode(left);
  203. while (hpcurr<>hpreversestart) do
  204. begin
  205. hpnext:=tcgcallparanode(hpcurr.right);
  206. if not(hpcurr.parasym.paraloc[callerside].location^.loc in [LOC_REFERENCE,LOC_CREFERENCE]) then
  207. begin
  208. { remove hpcurr from chain }
  209. if assigned(hpprev) then
  210. hpprev.right:=hpnext
  211. else
  212. left:=hpnext;
  213. { insert right after hpreversestart, so every element will
  214. be inserted right before the previously moved one ->
  215. reverse order; hpreversestart itself is the last register
  216. parameter }
  217. hpcurr.right:=hpreversestart.right;
  218. hpreversestart.right:=hpcurr;
  219. end
  220. else
  221. hpprev:=hpcurr;
  222. hpcurr:=hpnext;
  223. end;
  224. end;
  225. procedure tcgcallparanode.push_value_para;
  226. begin
  227. { we've nothing to push when the size of the parameter is 0
  228. -- except on platforms where the parameters are part of the signature
  229. and checked by the runtime/backend compiler (e.g. JVM, LLVM) }
  230. if (left.resultdef.size=0) and
  231. not paramanager.has_strict_proc_signature then
  232. exit;
  233. if maybe_push_unused_para then
  234. exit;
  235. { Move flags and jump in register to make it less complex }
  236. if left.location.loc in [LOC_FLAGS,LOC_JUMP,LOC_SUBSETREG,LOC_CSUBSETREG,LOC_SUBSETREF,LOC_CSUBSETREF] then
  237. hlcg.location_force_reg(current_asmdata.CurrAsmList,left.location,left.resultdef,left.resultdef,false);
  238. { load the parameter's tlocation into its cgpara }
  239. hlcg.gen_load_loc_cgpara(current_asmdata.CurrAsmList,left.resultdef,left.location,tempcgpara)
  240. end;
  241. procedure tcgcallparanode.push_formal_para;
  242. begin
  243. if maybe_push_unused_para then
  244. exit;
  245. { allow passing of a constant to a const formaldef }
  246. if (parasym.varspez=vs_const) and
  247. not(left.location.loc in [LOC_CREFERENCE,LOC_REFERENCE]) then
  248. hlcg.location_force_mem(current_asmdata.CurrAsmList,left.location,left.resultdef);
  249. push_addr_para;
  250. end;
  251. function tcgcallparanode.maybe_push_unused_para: boolean;
  252. begin
  253. { Check if the parameter is unused and can be optimized }
  254. result:=paramanager.can_opt_unused_para(parasym);
  255. if not result then
  256. exit;
  257. { If we can't skip loading of the parameter, load an undefined dummy value. }
  258. if not can_skip_para_push(parasym) then
  259. hlcg.a_load_undefined_cgpara(current_asmdata.CurrAsmList,left.resultdef,tempcgpara);
  260. end;
  261. procedure tcgcallparanode.secondcallparan;
  262. var
  263. pushaddr: boolean;
  264. begin
  265. if not(assigned(parasym)) then
  266. internalerror(200304242);
  267. { Skip nothingn nodes which are used after disabling
  268. a parameter }
  269. if (left.nodetype<>nothingn) then
  270. begin
  271. if assigned(fparainit) then
  272. secondpass(fparainit);
  273. secondpass(left);
  274. hlcg.maybe_change_load_node_reg(current_asmdata.CurrAsmList,left,true);
  275. paramanager.createtempparaloc(current_asmdata.CurrAsmList,aktcallnode.procdefinition.proccalloption,parasym,not followed_by_stack_tainting_call_cached,tempcgpara);
  276. { handle varargs first, because parasym is not valid }
  277. if (cpf_varargs_para in callparaflags) then
  278. begin
  279. if paramanager.push_addr_param(vs_value,left.resultdef,
  280. aktcallnode.procdefinition.proccalloption) then
  281. push_addr_para
  282. else
  283. push_value_para;
  284. end
  285. { hidden parameters }
  286. else if (vo_is_hidden_para in parasym.varoptions) then
  287. begin
  288. { don't push a node that already generated a pointer type
  289. by address for implicit hidden parameters }
  290. pushaddr:=(vo_is_funcret in parasym.varoptions) or
  291. { pass "this" in C++ classes explicitly as pointer
  292. because push_addr_param might not be true for them }
  293. (is_cppclass(parasym.vardef) and (vo_is_self in parasym.varoptions)) or
  294. (
  295. (
  296. not(left.resultdef.typ in [pointerdef,classrefdef]) or
  297. (
  298. { allow pointerdefs (as self) to be passed as addr
  299. param if the method is part of a type helper which
  300. extends a pointer type }
  301. (vo_is_self in parasym.varoptions) and
  302. (aktcallnode.procdefinition.owner.symtabletype=objectsymtable) and
  303. (is_objectpascal_helper(tdef(aktcallnode.procdefinition.owner.defowner))) and
  304. (tobjectdef(aktcallnode.procdefinition.owner.defowner).extendeddef.typ=pointerdef)
  305. )
  306. ) and
  307. paramanager.push_addr_param(parasym.varspez,parasym.vardef,
  308. aktcallnode.procdefinition.proccalloption));
  309. if pushaddr then
  310. begin
  311. { objects or advanced records could be located in registers if they are the result of a type case, see e.g. webtbs\tw26075.pp }
  312. if not(left.location.loc in [LOC_CREFERENCE,LOC_REFERENCE]) then
  313. hlcg.location_force_mem(current_asmdata.CurrAsmList,left.location,left.resultdef);
  314. push_addr_para
  315. end
  316. else
  317. push_value_para;
  318. end
  319. { formal def }
  320. else if (parasym.vardef.typ=formaldef) then
  321. push_formal_para
  322. { Normal parameter }
  323. else if paramanager.push_copyout_param(parasym.varspez,parasym.vardef,
  324. aktcallnode.procdefinition.proccalloption) then
  325. push_copyout_para
  326. else
  327. begin
  328. { don't push a node that already generated a pointer type
  329. by address for implicit hidden parameters }
  330. if (not(
  331. (vo_is_hidden_para in parasym.varoptions) and
  332. (left.resultdef.typ in [pointerdef,classrefdef])
  333. ) and
  334. paramanager.push_addr_param(parasym.varspez,parasym.vardef,
  335. aktcallnode.procdefinition.proccalloption)) and
  336. { dyn. arrays passed to an array of const must be passed by value, see tests/webtbs/tw4219.pp }
  337. not(
  338. is_array_of_const(parasym.vardef) and
  339. is_dynamic_array(left.resultdef)
  340. ) then
  341. begin
  342. { Passing a var parameter to a var parameter, we can
  343. just push the address transparently }
  344. if (left.nodetype=loadn) and
  345. (tloadnode(left).is_addr_param_load) then
  346. begin
  347. if (left.location.reference.index<>NR_NO) or
  348. (left.location.reference.offset<>0) then
  349. internalerror(200410107);
  350. hlcg.a_load_reg_cgpara(current_asmdata.CurrAsmList,cpointerdef.getreusable(left.resultdef),left.location.reference.base,tempcgpara)
  351. end
  352. else
  353. begin
  354. { Force to be in memory }
  355. if not(left.location.loc in [LOC_CREFERENCE,LOC_REFERENCE]) then
  356. hlcg.location_force_mem(current_asmdata.CurrAsmList,left.location,left.resultdef);
  357. push_addr_para;
  358. end;
  359. end
  360. else
  361. push_value_para;
  362. end;
  363. { update return location in callnode when this is the function
  364. result }
  365. if assigned(parasym) and
  366. (
  367. { for type helper/record constructor check that it is self parameter }
  368. (
  369. (vo_is_self in parasym.varoptions) and
  370. (aktcallnode.procdefinition.proctypeoption=potype_constructor) and
  371. (parasym.vardef.typ<>objectdef)
  372. ) or
  373. (vo_is_funcret in parasym.varoptions)
  374. ) then
  375. location_copy(aktcallnode.location,left.location);
  376. end;
  377. { next parameter }
  378. if assigned(right) then
  379. tcallparanode(right).secondcallparan;
  380. end;
  381. {*****************************************************************************
  382. TCGCALLNODE
  383. *****************************************************************************}
  384. {$if first_mm_imreg = 0}
  385. {$WARN 4044 OFF} { Comparison might be always false ... }
  386. {$endif}
  387. procedure tcgcallnode.extra_interrupt_code;
  388. begin
  389. end;
  390. procedure tcgcallnode.extra_pre_call_code;
  391. begin
  392. end;
  393. procedure tcgcallnode.extra_call_code;
  394. begin
  395. end;
  396. procedure tcgcallnode.extra_post_call_code;
  397. begin
  398. end;
  399. function tcgcallnode.get_syscall_libbase_paraloc: pcgparalocation;
  400. var
  401. hsym: tsym;
  402. begin
  403. hsym:=tsym(procdefinition.parast.Find('syscalllib'));
  404. if not assigned(hsym) then
  405. internalerror(2016110605);
  406. result:=tparavarsym(hsym).paraloc[callerside].location;
  407. if not assigned(result) then
  408. internalerror(2016110604);
  409. end;
  410. procedure tcgcallnode.get_syscall_call_ref(out tmpref: treference; reg: tregister);
  411. var
  412. libparaloc: pcgparalocation;
  413. begin
  414. libparaloc:=get_syscall_libbase_paraloc;
  415. case libparaloc^.loc of
  416. LOC_REGISTER:
  417. reference_reset_base(tmpref,libparaloc^.register,-tprocdef(procdefinition).extnumber,ctempposinvalid,sizeof(pint),[]);
  418. LOC_REFERENCE:
  419. begin
  420. reference_reset_base(tmpref,libparaloc^.reference.index,libparaloc^.reference.offset,ctempposinvalid,sizeof(pint),[]);
  421. cg.a_load_ref_reg(current_asmdata.CurrAsmList,OS_ADDR,OS_ADDR,tmpref,reg);
  422. reference_reset_base(tmpref,reg,-tprocdef(procdefinition).extnumber,ctempposinvalid,sizeof(pint),[]);
  423. end;
  424. else
  425. begin
  426. reference_reset(tmpref,0,[]);
  427. internalerror(2016090202);
  428. end;
  429. end;
  430. end;
  431. function tcgcallnode.can_call_ref(var ref: treference): boolean;
  432. begin
  433. result:=false;
  434. end;
  435. procedure tcgcallnode.extra_call_ref_code(var ref: treference);
  436. begin
  437. { no action by default }
  438. end;
  439. function tcgcallnode.do_call_ref(ref: treference): tcgpara;
  440. begin
  441. InternalError(2014012901);
  442. { silence warning }
  443. result.init;
  444. end;
  445. procedure tcgcallnode.load_block_invoke(out toreg: tregister; out callprocdef: tabstractprocdef);
  446. var
  447. href: treference;
  448. literaldef: trecorddef;
  449. begin
  450. literaldef:=get_block_literal_type_for_proc(tabstractprocdef(right.resultdef));
  451. hlcg.location_force_reg(current_asmdata.CurrAsmList,right.location,right.resultdef,cpointerdef.getreusable(literaldef),true);
  452. { load the invoke pointer }
  453. hlcg.reference_reset_base(href,right.resultdef,right.location.register,0,ctempposinvalid,right.resultdef.alignment,[]);
  454. callprocdef:=cprocvardef.getreusableprocaddr(procdefinition,pc_address_only);
  455. toreg:=hlcg.getaddressregister(current_asmdata.CurrAsmList,callprocdef);
  456. hlcg.g_load_field_reg_by_name(current_asmdata.CurrAsmList,literaldef,callprocdef,'INVOKE',href,toreg);
  457. end;
  458. function tcgcallnode.get_call_reg(list: TAsmList): tregister;
  459. begin
  460. result:=hlcg.getaddressregister(current_asmdata.CurrAsmList,procdefinition.address_type);
  461. end;
  462. procedure tcgcallnode.unget_call_reg(list: TAsmList; reg: tregister);
  463. begin
  464. { nothing to do by default }
  465. end;
  466. procedure tcgcallnode.set_result_location(realresdef: tstoreddef);
  467. begin
  468. if realresdef.is_intregable or
  469. realresdef.is_fpuregable or
  470. { avoid temporarily storing pointer-sized entities that can't be
  471. regvars, such as reference-counted pointers, to memory --
  472. no exception can occur right now (except in case of existing
  473. memory corruption), and we'd store them to a regular temp
  474. anyway and that is not safer than keeping them in a register }
  475. ((realresdef.size=sizeof(aint)) and
  476. (retloc.location^.loc=LOC_REGISTER) and
  477. not assigned(retloc.location^.next)) then
  478. location_allocate_register(current_asmdata.CurrAsmList,location,realresdef,false)
  479. else
  480. begin
  481. location_reset_ref(location,LOC_REFERENCE,def_cgsize(realresdef),0,[]);
  482. tg.gethltemp(current_asmdata.CurrAsmList,realresdef,retloc.intsize,tt_normal,location.reference);
  483. end;
  484. end;
  485. procedure tcgcallnode.do_release_unused_return_value;
  486. begin
  487. case location.loc of
  488. LOC_REFERENCE :
  489. begin
  490. if is_managed_type(resultdef) then
  491. hlcg.g_finalize(current_asmdata.CurrAsmList,resultdef,location.reference);
  492. tg.ungetiftemp(current_asmdata.CurrAsmList,location.reference);
  493. end;
  494. else
  495. ;
  496. end;
  497. end;
  498. procedure tcgcallnode.pop_parasize(pop_size:longint);
  499. begin
  500. end;
  501. procedure tcgcallnode.handle_return_value;
  502. var
  503. realresdef: tstoreddef;
  504. begin
  505. { Check that the return location is set when the result is passed in
  506. a parameter }
  507. if paramanager.ret_in_param(resultdef,procdefinition) then
  508. begin
  509. { self.location is set near the end of secondcallparan so it
  510. refers to the implicit result parameter }
  511. if location.loc<>LOC_REFERENCE then
  512. internalerror(200304241);
  513. exit;
  514. end;
  515. if not assigned(typedef) then
  516. realresdef:=tstoreddef(resultdef)
  517. else
  518. realresdef:=tstoreddef(typedef);
  519. { get a tlocation that can hold the return value that's currently in
  520. the return value's tcgpara }
  521. set_result_location(realresdef);
  522. { Do not move the physical register to a virtual one in case
  523. the return value is not used, because if the virtual one is
  524. then mapped to the same register as the physical one, we will
  525. end up with two deallocs of this register (one inserted here,
  526. one inserted by the register allocator), which unbalances the
  527. register allocation information. The return register(s) will
  528. be freed by location_free() in release_unused_return_value
  529. (mantis #13536). }
  530. if (cnf_return_value_used in callnodeflags) or
  531. assigned(funcretnode) then
  532. hlcg.gen_load_cgpara_loc(current_asmdata.CurrAsmList,realresdef,retloc,location,false);
  533. if ((location.loc=LOC_REGISTER) and
  534. not realresdef.is_intregable) or
  535. ((location.loc in [LOC_FPUREGISTER,LOC_MMREGISTER]) and
  536. (not realresdef.is_fpuregable or
  537. ((location.loc=LOC_MMREGISTER)<>use_vectorfpu(realresdef)))) then
  538. begin
  539. hlcg.location_force_mem(current_asmdata.CurrAsmList,location,realresdef);
  540. { may have been record returned in a floating point register (-> location.size
  541. will be the size of the fpuregister instead of the int size of the record) }
  542. location.size:=def_cgsize(realresdef);
  543. end;
  544. { copy value to the final location if this was already provided to the
  545. callnode. This must be done after the call node, because the location can
  546. also be used as parameter and may not be finalized yet }
  547. if assigned(funcretnode) then
  548. begin
  549. funcretnode.pass_generate_code;
  550. { Decrease refcount for refcounted types, this can be skipped when
  551. we have used a temp, because then it is already done from tempcreatenode.
  552. Also no finalize is needed, because there is no risk of exceptions from the
  553. function since this is code is only executed after the function call has returned }
  554. if is_managed_type(funcretnode.resultdef) and
  555. (funcretnode.nodetype<>temprefn) then
  556. hlcg.g_finalize(current_asmdata.CurrAsmList,funcretnode.resultdef,funcretnode.location.reference);
  557. case location.loc of
  558. LOC_REGISTER :
  559. begin
  560. {$if not defined(cpu64bitalu) and not defined(cpuhighleveltarget)}
  561. if location.size in [OS_64,OS_S64] then
  562. cg64.a_load64_reg_loc(current_asmdata.CurrAsmList,location.register64,funcretnode.location)
  563. else
  564. {$endif}
  565. hlcg.a_load_reg_loc(current_asmdata.CurrAsmList,resultdef,resultdef,location.register,funcretnode.location);
  566. location_free(current_asmdata.CurrAsmList,location);
  567. end;
  568. LOC_REFERENCE:
  569. begin
  570. case funcretnode.location.loc of
  571. LOC_REGISTER:
  572. hlcg.a_load_ref_reg(current_asmdata.CurrAsmList,resultdef,resultdef,location.reference,funcretnode.location.register);
  573. LOC_REFERENCE:
  574. hlcg.g_concatcopy(current_asmdata.CurrAsmList,resultdef,location.reference,funcretnode.location.reference);
  575. else
  576. internalerror(200802121);
  577. end;
  578. location_freetemp(current_asmdata.CurrAsmList,location);
  579. end;
  580. else
  581. internalerror(200709085);
  582. end;
  583. location := funcretnode.location;
  584. end;
  585. end;
  586. procedure tcgcallnode.release_unused_return_value;
  587. begin
  588. { When the result is not used we need to finalize the result and
  589. can release the temp. This need to be after the callcleanupblock
  590. tree is generated, because that converts the temp from persistent to normal }
  591. if not(cnf_return_value_used in callnodeflags) then
  592. begin
  593. do_release_unused_return_value;
  594. if (retloc.intsize<>0) then
  595. paramanager.freecgpara(current_asmdata.CurrAsmList,retloc);
  596. location_reset(location,LOC_VOID,OS_NO);
  597. end;
  598. end;
  599. procedure tcgcallnode.copy_back_paras;
  600. var
  601. ppn : tcallparanode;
  602. begin
  603. ppn:=tcallparanode(left);
  604. while assigned(ppn) do
  605. begin
  606. if assigned(ppn.paracopyback) then
  607. secondpass(ppn.paracopyback);
  608. ppn:=tcallparanode(ppn.right);
  609. end;
  610. end;
  611. procedure tcgcallnode.release_para_temps;
  612. var
  613. hp,
  614. hp2 : tnode;
  615. ppn : tcallparanode;
  616. begin
  617. { Release temps from parameters }
  618. ppn:=tcallparanode(left);
  619. while assigned(ppn) do
  620. begin
  621. if assigned(ppn.left) then
  622. begin
  623. { don't release the funcret temp }
  624. if not(assigned(ppn.parasym)) or
  625. not(
  626. (vo_is_funcret in ppn.parasym.varoptions) or
  627. (
  628. (vo_is_self in ppn.parasym.varoptions) and
  629. (procdefinition.proctypeoption=potype_constructor) and
  630. (ppn.parasym.vardef.typ<>objectdef)
  631. )
  632. )then
  633. location_freetemp(current_asmdata.CurrAsmList,ppn.left.location);
  634. { process also all nodes of an array of const }
  635. hp:=ppn.left;
  636. while (hp.nodetype=typeconvn) do
  637. hp:=ttypeconvnode(hp).left;
  638. if (hp.nodetype=arrayconstructorn) and
  639. assigned(tarrayconstructornode(hp).left) then
  640. begin
  641. while assigned(hp) do
  642. begin
  643. hp2:=tarrayconstructornode(hp).left;
  644. { ignore typeconvs and addrn inserted by arrayconstructn for
  645. passing a shortstring }
  646. if (hp2.nodetype=typeconvn) and
  647. (tunarynode(hp2).left.nodetype=addrn) then
  648. hp2:=tunarynode(tunarynode(hp2).left).left
  649. else if hp2.nodetype=addrn then
  650. hp2:=tunarynode(hp2).left;
  651. location_freetemp(current_asmdata.CurrAsmList,hp2.location);
  652. hp:=tarrayconstructornode(hp).right;
  653. end;
  654. end;
  655. end;
  656. ppn:=tcallparanode(ppn.right);
  657. end;
  658. setlength(paralocs,0);
  659. end;
  660. procedure tcgcallnode.pushparas;
  661. var
  662. ppn : tcgcallparanode;
  663. callerparaloc,
  664. tmpparaloc : pcgparalocation;
  665. sizeleft: aint;
  666. htempref,
  667. href : treference;
  668. calleralignment,
  669. tmpalignment, i: longint;
  670. skipiffinalloc: boolean;
  671. begin
  672. { copy all resources to the allocated registers }
  673. ppn:=tcgcallparanode(left);
  674. while assigned(ppn) do
  675. begin
  676. if (ppn.left.nodetype<>nothingn) and
  677. not can_skip_para_push(ppn.parasym) then
  678. begin
  679. { better check for the real location of the parameter here, when stack passed parameters
  680. are saved temporary in registers, checking for the tmpparaloc.loc is wrong
  681. }
  682. paramanager.freecgpara(current_asmdata.CurrAsmList,ppn.tempcgpara);
  683. tmpparaloc:=ppn.tempcgpara.location;
  684. sizeleft:=ppn.tempcgpara.intsize;
  685. calleralignment:=ppn.parasym.paraloc[callerside].alignment;
  686. tmpalignment:=ppn.tempcgpara.alignment;
  687. if (tmpalignment=0) or
  688. (calleralignment=0) then
  689. internalerror(2009020701);
  690. callerparaloc:=ppn.parasym.paraloc[callerside].location;
  691. skipiffinalloc:=
  692. not paramanager.use_fixed_stack or
  693. not(ppn.followed_by_stack_tainting_call_cached);
  694. while assigned(callerparaloc) do
  695. begin
  696. { Every paraloc must have a matching tmpparaloc }
  697. if not assigned(tmpparaloc) then
  698. internalerror(200408224);
  699. if callerparaloc^.size<>tmpparaloc^.size then
  700. internalerror(200408225);
  701. case callerparaloc^.loc of
  702. LOC_REGISTER:
  703. begin
  704. if tmpparaloc^.loc<>LOC_REGISTER then
  705. internalerror(200408221);
  706. if getsupreg(callerparaloc^.register)<first_int_imreg then
  707. cg.getcpuregister(current_asmdata.CurrAsmList,callerparaloc^.register);
  708. cg.a_load_reg_reg(current_asmdata.CurrAsmList,tmpparaloc^.size,tmpparaloc^.size,
  709. tmpparaloc^.register,callerparaloc^.register);
  710. end;
  711. LOC_FPUREGISTER:
  712. begin
  713. if tmpparaloc^.loc<>LOC_FPUREGISTER then
  714. internalerror(200408222);
  715. if getsupreg(callerparaloc^.register)<first_fpu_imreg then
  716. cg.getcpuregister(current_asmdata.CurrAsmList,callerparaloc^.register);
  717. cg.a_loadfpu_reg_reg(current_asmdata.CurrAsmList,tmpparaloc^.size,tmpparaloc^.size,tmpparaloc^.register,callerparaloc^.register);
  718. end;
  719. LOC_MMREGISTER:
  720. begin
  721. if tmpparaloc^.loc<>LOC_MMREGISTER then
  722. internalerror(200408223);
  723. if getsupreg(callerparaloc^.register)<first_mm_imreg then
  724. cg.getcpuregister(current_asmdata.CurrAsmList,callerparaloc^.register);
  725. cg.a_loadmm_reg_reg(current_asmdata.CurrAsmList,tmpparaloc^.size,tmpparaloc^.size,
  726. tmpparaloc^.register,callerparaloc^.register,mms_movescalar);
  727. end;
  728. LOC_REFERENCE:
  729. begin
  730. if not(skipiffinalloc and
  731. paramanager.is_stack_paraloc(callerparaloc)) then
  732. begin
  733. { Can't have a data copied to the stack, every location
  734. must contain a valid size field }
  735. if (tmpparaloc^.size=OS_NO) and
  736. ((tmpparaloc^.loc<>LOC_REFERENCE) or
  737. assigned(tmpparaloc^.next)) then
  738. internalerror(200501281);
  739. reference_reset_base(href,callerparaloc^.reference.index,callerparaloc^.reference.offset,ctempposinvalid,calleralignment,[]);
  740. { copy parameters in case they were moved to a temp. location because we've a fixed stack }
  741. case tmpparaloc^.loc of
  742. LOC_REFERENCE:
  743. begin
  744. reference_reset_base(htempref,tmpparaloc^.reference.index,tmpparaloc^.reference.offset,ctempposinvalid,tmpalignment,[]);
  745. { use concatcopy, because it can also be a float which fails when
  746. load_ref_ref is used }
  747. if (ppn.tempcgpara.size <> OS_NO) then
  748. cg.g_concatcopy(current_asmdata.CurrAsmList,htempref,href,tcgsize2size[tmpparaloc^.size])
  749. else
  750. cg.g_concatcopy(current_asmdata.CurrAsmList,htempref,href,sizeleft)
  751. end;
  752. LOC_REGISTER:
  753. cg.a_load_reg_ref(current_asmdata.CurrAsmList,tmpparaloc^.size,tmpparaloc^.size,tmpparaloc^.register,href);
  754. LOC_FPUREGISTER:
  755. cg.a_loadfpu_reg_ref(current_asmdata.CurrAsmList,tmpparaloc^.size,tmpparaloc^.size,tmpparaloc^.register,href);
  756. LOC_MMREGISTER:
  757. cg.a_loadmm_reg_ref(current_asmdata.CurrAsmList,tmpparaloc^.size,tmpparaloc^.size,tmpparaloc^.register,href,mms_movescalar);
  758. else
  759. internalerror(200402081);
  760. end;
  761. end;
  762. end;
  763. LOC_VOID:
  764. ;
  765. else
  766. internalerror(2019050707);
  767. end;
  768. dec(sizeleft,tcgsize2size[tmpparaloc^.size]);
  769. callerparaloc:=callerparaloc^.next;
  770. tmpparaloc:=tmpparaloc^.next;
  771. end;
  772. end;
  773. ppn:=tcgcallparanode(ppn.right);
  774. end;
  775. setlength(paralocs,procdefinition.paras.count);
  776. for i:=0 to procdefinition.paras.count-1 do
  777. paralocs[i]:=@tparavarsym(procdefinition.paras[i]).paraloc[callerside];
  778. end;
  779. procedure tcgcallnode.load_complex_procvar_codeptr(out reg: tregister; out callprocdef: tabstractprocdef);
  780. var
  781. srcreg: tregister;
  782. begin
  783. { this is safe even on i8086, because procvardef code pointers are
  784. always far there (so the current state of far calls vs the state
  785. of far calls where the procvardef was defined does not matter,
  786. even though the procvardef constructor called by getcopyas looks at
  787. it) }
  788. callprocdef:=cprocvardef.getreusableprocaddr(procdefinition,pc_address_only);
  789. reg:=hlcg.getaddressregister(current_asmdata.CurrAsmList,callprocdef);
  790. { in case we have a method pointer on a big endian target in registers,
  791. the method address is stored in registerhi (it's the first field
  792. in the tmethod record) }
  793. if (right.location.loc in [LOC_REGISTER,LOC_CREGISTER]) then
  794. begin
  795. if not(right.location.size in [OS_PAIR,OS_SPAIR]) then
  796. internalerror(2014081401);
  797. if (target_info.endian=endian_big) then
  798. srcreg:=right.location.registerhi
  799. else
  800. srcreg:=right.location.register;
  801. hlcg.a_load_reg_reg(current_asmdata.CurrAsmList,callprocdef,callprocdef,srcreg,reg)
  802. end
  803. else
  804. begin
  805. hlcg.location_force_mem(current_asmdata.CurrAsmList,right.location,procdefinition);
  806. hlcg.g_ptrtypecast_ref(current_asmdata.CurrAsmList,cpointerdef.getreusable(procdefinition),cpointerdef.getreusable(callprocdef),right.location.reference);
  807. hlcg.a_load_ref_reg(current_asmdata.CurrAsmList,callprocdef,callprocdef,right.location.reference,reg);
  808. end;
  809. end;
  810. procedure tcgcallnode.load_procvar_codeptr(out reg: tregister; out callprocdef: tabstractprocdef);
  811. begin
  812. if po_is_block in procdefinition.procoptions then
  813. load_block_invoke(reg,callprocdef)
  814. else if not(procdefinition.is_addressonly) then
  815. load_complex_procvar_codeptr(reg,callprocdef)
  816. else
  817. begin
  818. reg:=hlcg.getaddressregister(current_asmdata.CurrAsmList,procdefinition);
  819. hlcg.a_load_loc_reg(current_asmdata.CurrAsmList,procdefinition,procdefinition,right.location,reg);
  820. callprocdef:=procdefinition;
  821. end;
  822. callprocdef.init_paraloc_info(callerside);
  823. end;
  824. procedure tcgcallnode.freeparas;
  825. var
  826. ppn : tcgcallparanode;
  827. begin
  828. { free the resources allocated for the parameters }
  829. ppn:=tcgcallparanode(left);
  830. while assigned(ppn) do
  831. begin
  832. if (ppn.left.nodetype<>nothingn) then
  833. begin
  834. if (ppn.parasym.paraloc[callerside].location^.loc <> LOC_REFERENCE) then
  835. paramanager.freecgpara(current_asmdata.CurrAsmList,ppn.parasym.paraloc[callerside]);
  836. end;
  837. ppn:=tcgcallparanode(ppn.right);
  838. end;
  839. end;
  840. function tcgcallnode.is_parentfp_pushed: boolean;
  841. begin
  842. result:=(procdefinition.typ<>procdef) or
  843. not can_skip_para_push(tparavarsym(tprocdef(procdefinition).parentfpsym));
  844. end;
  845. procedure tcgcallnode.pass_generate_code;
  846. var
  847. name_to_call: TSymStr;
  848. regs_to_save_int,
  849. regs_to_save_address,
  850. regs_to_save_fpu,
  851. regs_to_save_mm : Tcpuregisterset;
  852. href : treference;
  853. pop_size : longint;
  854. pvreg : tregister;
  855. oldaktcallnode : tcallnode;
  856. retlocitem: pcgparalocation;
  857. callpvdef: tabstractprocdef;
  858. pd : tprocdef;
  859. callref: boolean;
  860. {$ifdef vtentry}
  861. sym : tasmsymbol;
  862. vmtoffset : aint;
  863. {$endif vtentry}
  864. cgpara : tcgpara;
  865. tmploc: tlocation;
  866. begin
  867. if not assigned(procdefinition) or
  868. not(procdefinition.has_paraloc_info in [callerside,callbothsides]) then
  869. internalerror(200305264);
  870. extra_pre_call_code;
  871. if assigned(callinitblock) then
  872. secondpass(tnode(callinitblock));
  873. regs_to_save_int:=paramanager.get_volatile_registers_int(procdefinition.proccalloption);
  874. regs_to_save_address:=paramanager.get_volatile_registers_address(procdefinition.proccalloption);
  875. regs_to_save_fpu:=paramanager.get_volatile_registers_fpu(procdefinition.proccalloption);
  876. regs_to_save_mm:=paramanager.get_volatile_registers_mm(procdefinition.proccalloption);
  877. { Include Function result registers }
  878. if (not is_void(resultdef)) then
  879. begin
  880. { The forced returntype may have a different size than the one
  881. declared for the procdef }
  882. retloc:=hlcg.get_call_result_cgpara(procdefinition,typedef);
  883. retlocitem:=retloc.location;
  884. while assigned(retlocitem) do
  885. begin
  886. case retlocitem^.loc of
  887. LOC_REGISTER:
  888. case getregtype(retlocitem^.register) of
  889. R_INTREGISTER:
  890. include(regs_to_save_int,getsupreg(retlocitem^.register));
  891. R_ADDRESSREGISTER:
  892. include(regs_to_save_address,getsupreg(retlocitem^.register));
  893. R_TEMPREGISTER:
  894. ;
  895. else
  896. internalerror(2014020102);
  897. end;
  898. LOC_FPUREGISTER:
  899. include(regs_to_save_fpu,getsupreg(retlocitem^.register));
  900. LOC_MMREGISTER:
  901. include(regs_to_save_mm,getsupreg(retlocitem^.register));
  902. LOC_REFERENCE,
  903. LOC_VOID:
  904. ;
  905. else
  906. internalerror(2004110213);
  907. end;
  908. retlocitem:=retlocitem^.next;
  909. end;
  910. end;
  911. { Process parameters, register parameters will be loaded
  912. in imaginary registers. The actual load to the correct
  913. register is done just before the call }
  914. oldaktcallnode:=aktcallnode;
  915. aktcallnode:=self;
  916. if assigned(left) then
  917. tcallparanode(left).secondcallparan;
  918. aktcallnode:=oldaktcallnode;
  919. { procedure variable or normal function call ? }
  920. if (right=nil) then
  921. begin
  922. { register call for WPO (must be done before wpo test below,
  923. otherwise optimised called methods are no longer registered)
  924. }
  925. if (po_virtualmethod in procdefinition.procoptions) and
  926. not is_objectpascal_helper(tprocdef(procdefinition).struct) and
  927. assigned(methodpointer) and
  928. (methodpointer.nodetype<>typen) and
  929. (not assigned(current_procinfo) or
  930. wpoinfomanager.symbol_live(current_procinfo.procdef.mangledname)) then
  931. tobjectdef(tprocdef(procdefinition).struct).register_vmt_call(tprocdef(procdefinition).extnumber);
  932. {$ifdef vtentry}
  933. if not is_interface(tprocdef(procdefinition)._class) then
  934. begin
  935. inc(current_asmdata.NextVTEntryNr);
  936. current_asmdata.CurrAsmList.Concat(tai_symbol.CreateName('VTREF'+tostr(current_asmdata.NextVTEntryNr)+'_'+tprocdef(procdefinition).struct.vmt_mangledname+'$$'+tostr(vmtoffset div sizeof(pint)),AT_FUNCTION,0,voidpointerdef));
  937. end;
  938. {$endif vtentry}
  939. name_to_call:=forcedprocname;
  940. { When methodpointer is typen we don't need (and can't) load
  941. a pointer. We can directly call the correct procdef (PFV) }
  942. if (name_to_call='') and
  943. (po_virtualmethod in procdefinition.procoptions) and
  944. not is_objectpascal_helper(tprocdef(procdefinition).struct) and
  945. assigned(methodpointer) and
  946. (methodpointer.nodetype<>typen) and
  947. not wpoinfomanager.can_be_devirtualized(methodpointer.resultdef,procdefinition,name_to_call) then
  948. begin
  949. { virtual methods require an index }
  950. if tprocdef(procdefinition).extnumber=$ffff then
  951. internalerror(200304021);
  952. { load the VMT entry (address of the virtual method) }
  953. secondpass(vmt_entry);
  954. { register call for WPO }
  955. if (not assigned(current_procinfo) or
  956. wpoinfomanager.symbol_live(current_procinfo.procdef.mangledname)) then
  957. tobjectdef(tprocdef(procdefinition).struct).register_vmt_call(tprocdef(procdefinition).extnumber);
  958. if not(vmt_entry.location.loc in [LOC_REFERENCE,LOC_CREFERENCE]) then
  959. internalerror(2015052502);
  960. href:=vmt_entry.location.reference;
  961. pvreg:=NR_NO;
  962. callref:=can_call_ref(href);
  963. if not callref then
  964. begin
  965. pvreg:=get_call_reg(current_asmdata.CurrAsmList);
  966. hlcg.a_load_ref_reg(current_asmdata.CurrAsmList,
  967. vmt_entry.resultdef,vmt_entry.resultdef,
  968. href,pvreg);
  969. end;
  970. { Load parameters that are in temporary registers in the
  971. correct parameter register }
  972. if assigned(left) then
  973. begin
  974. reorder_parameters;
  975. pushparas;
  976. end;
  977. if callref then
  978. extra_call_ref_code(href);
  979. cg.alloccpuregisters(current_asmdata.CurrAsmList,R_INTREGISTER,regs_to_save_int);
  980. if cg.uses_registers(R_ADDRESSREGISTER) then
  981. cg.alloccpuregisters(current_asmdata.CurrAsmList,R_ADDRESSREGISTER,regs_to_save_address);
  982. if cg.uses_registers(R_FPUREGISTER) then
  983. cg.alloccpuregisters(current_asmdata.CurrAsmList,R_FPUREGISTER,regs_to_save_fpu);
  984. if cg.uses_registers(R_MMREGISTER) then
  985. cg.alloccpuregisters(current_asmdata.CurrAsmList,R_MMREGISTER,regs_to_save_mm);
  986. { call method }
  987. extra_call_code;
  988. retloc.resetiftemp;
  989. if callref then
  990. retloc:=do_call_ref(href)
  991. else
  992. begin
  993. hlcg.g_ptrtypecast_reg(current_asmdata.CurrAsmList,vmt_entry.resultdef,cpointerdef.getreusable(procdefinition),pvreg);
  994. retloc:=hlcg.a_call_reg(current_asmdata.CurrAsmList,tabstractprocdef(procdefinition),pvreg,paralocs);
  995. unget_call_reg(current_asmdata.CurrAsmList,pvreg);
  996. end;
  997. extra_post_call_code;
  998. end
  999. else
  1000. begin
  1001. { Load parameters that are in temporary registers in the
  1002. correct parameter register }
  1003. if assigned(left) then
  1004. begin
  1005. reorder_parameters;
  1006. pushparas;
  1007. end;
  1008. cg.alloccpuregisters(current_asmdata.CurrAsmList,R_INTREGISTER,regs_to_save_int);
  1009. if cg.uses_registers(R_ADDRESSREGISTER) then
  1010. cg.alloccpuregisters(current_asmdata.CurrAsmList,R_ADDRESSREGISTER,regs_to_save_address);
  1011. if cg.uses_registers(R_FPUREGISTER) then
  1012. cg.alloccpuregisters(current_asmdata.CurrAsmList,R_FPUREGISTER,regs_to_save_fpu);
  1013. if cg.uses_registers(R_MMREGISTER) then
  1014. cg.alloccpuregisters(current_asmdata.CurrAsmList,R_MMREGISTER,regs_to_save_mm);
  1015. if procdefinition.proccalloption=pocall_syscall then
  1016. do_syscall
  1017. else
  1018. begin
  1019. { Calling interrupt from the same code requires some
  1020. extra code }
  1021. if (po_interrupt in procdefinition.procoptions) then
  1022. extra_interrupt_code;
  1023. extra_call_code;
  1024. retloc.resetiftemp;
  1025. if (name_to_call='') then
  1026. name_to_call:=tprocdef(procdefinition).mangledname;
  1027. if cnf_inherited in callnodeflags then
  1028. retloc:=hlcg.a_call_name_inherited(current_asmdata.CurrAsmList,tprocdef(procdefinition),name_to_call,paralocs)
  1029. { under certain conditions, a static call (i.e. without PIC) can be generated }
  1030. else if ((procdefinition.owner=current_procinfo.procdef.owner) or
  1031. (procdefinition.owner.symtabletype in [localsymtable,staticsymtable])
  1032. ) and ((procdefinition.procoptions*[po_weakexternal,po_external])=[]) then
  1033. retloc:=hlcg.a_call_name_static(current_asmdata.CurrAsmList,tprocdef(procdefinition),name_to_call,paralocs,typedef)
  1034. else
  1035. retloc:=hlcg.a_call_name(current_asmdata.CurrAsmList,tprocdef(procdefinition),name_to_call,paralocs,typedef,po_weakexternal in procdefinition.procoptions);
  1036. extra_post_call_code;
  1037. end;
  1038. end;
  1039. end
  1040. else
  1041. { now procedure variable case }
  1042. begin
  1043. secondpass(right);
  1044. { can we directly call the procvar in a memory location? }
  1045. callref:=false;
  1046. if not(po_is_block in procdefinition.procoptions) and
  1047. (right.location.loc in [LOC_REFERENCE,LOC_CREFERENCE]) then
  1048. begin
  1049. href:=right.location.reference;
  1050. callref:=can_call_ref(href);
  1051. end;
  1052. if not callref then
  1053. load_procvar_codeptr(pvreg,callpvdef)
  1054. else
  1055. begin
  1056. pvreg:=NR_INVALID;
  1057. callpvdef:=nil;
  1058. end;
  1059. location_freetemp(current_asmdata.CurrAsmList,right.location);
  1060. { Load parameters that are in temporary registers in the
  1061. correct parameter register }
  1062. if assigned(left) then
  1063. begin
  1064. reorder_parameters;
  1065. pushparas;
  1066. end;
  1067. if callref then
  1068. extra_call_ref_code(href);
  1069. cg.alloccpuregisters(current_asmdata.CurrAsmList,R_INTREGISTER,regs_to_save_int);
  1070. if cg.uses_registers(R_ADDRESSREGISTER) then
  1071. cg.alloccpuregisters(current_asmdata.CurrAsmList,R_ADDRESSREGISTER,regs_to_save_address);
  1072. if cg.uses_registers(R_FPUREGISTER) then
  1073. cg.alloccpuregisters(current_asmdata.CurrAsmList,R_FPUREGISTER,regs_to_save_fpu);
  1074. if cg.uses_registers(R_MMREGISTER) then
  1075. cg.alloccpuregisters(current_asmdata.CurrAsmList,R_MMREGISTER,regs_to_save_mm);
  1076. { Calling interrupt from the same code requires some
  1077. extra code }
  1078. if (po_interrupt in procdefinition.procoptions) then
  1079. extra_interrupt_code;
  1080. extra_call_code;
  1081. retloc.resetiftemp;
  1082. if callref then
  1083. retloc:=do_call_ref(href)
  1084. else
  1085. retloc:=hlcg.a_call_reg(current_asmdata.CurrAsmList,callpvdef,pvreg,paralocs);
  1086. extra_post_call_code;
  1087. end;
  1088. { free the resources allocated for the parameters }
  1089. if assigned(left) then
  1090. freeparas;
  1091. { Release registers, but not the registers that contain the
  1092. function result }
  1093. if (not is_void(resultdef)) then
  1094. begin
  1095. retlocitem:=retloc.location;
  1096. while assigned(retlocitem) do
  1097. begin
  1098. case retlocitem^.loc of
  1099. LOC_REGISTER:
  1100. case getregtype(retlocitem^.register) of
  1101. R_INTREGISTER:
  1102. exclude(regs_to_save_int,getsupreg(retlocitem^.register));
  1103. R_ADDRESSREGISTER:
  1104. exclude(regs_to_save_address,getsupreg(retlocitem^.register));
  1105. R_TEMPREGISTER:
  1106. ;
  1107. else
  1108. internalerror(2014020103);
  1109. end;
  1110. LOC_FPUREGISTER:
  1111. exclude(regs_to_save_fpu,getsupreg(retlocitem^.register));
  1112. LOC_MMREGISTER:
  1113. exclude(regs_to_save_mm,getsupreg(retlocitem^.register));
  1114. LOC_REFERENCE,
  1115. LOC_VOID:
  1116. ;
  1117. else
  1118. internalerror(2004110214);
  1119. end;
  1120. retlocitem:=retlocitem^.next;
  1121. end;
  1122. end;
  1123. if cg.uses_registers(R_MMREGISTER) then
  1124. cg.dealloccpuregisters(current_asmdata.CurrAsmList,R_MMREGISTER,regs_to_save_mm);
  1125. if cg.uses_registers(R_FPUREGISTER) then
  1126. cg.dealloccpuregisters(current_asmdata.CurrAsmList,R_FPUREGISTER,regs_to_save_fpu);
  1127. if cg.uses_registers(R_ADDRESSREGISTER) then
  1128. cg.dealloccpuregisters(current_asmdata.CurrAsmList,R_ADDRESSREGISTER,regs_to_save_address);
  1129. cg.dealloccpuregisters(current_asmdata.CurrAsmList,R_INTREGISTER,regs_to_save_int);
  1130. { Need to remove the parameters from the stack? }
  1131. if procdefinition.proccalloption in clearstack_pocalls then
  1132. begin
  1133. pop_size:=pushedparasize;
  1134. { for Cdecl functions we don't need to pop the funcret when it
  1135. was pushed by para. Except for safecall functions with
  1136. safecall-exceptions enabled. In that case the funcret is always
  1137. returned as a para which is considered a normal para on the
  1138. c-side, so the funcret has to be pop'ed normally. }
  1139. if not ((procdefinition.proccalloption=pocall_safecall) and
  1140. (tf_safecall_exceptions in target_info.flags)) and
  1141. paramanager.ret_in_param(procdefinition.returndef,procdefinition) then
  1142. dec(pop_size,sizeof(pint));
  1143. { Remove parameters/alignment from the stack }
  1144. pop_parasize(pop_size);
  1145. end
  1146. { in case we use a fixed stack, we did not push anything, if the stack is
  1147. really adjusted because a ret xxx was done, depends on
  1148. pop_parasize which uses pushedparasize to determine this
  1149. This does not apply to interrupt procedures, their ret statment never clears any stack parameters }
  1150. else if paramanager.use_fixed_stack and
  1151. not(po_interrupt in procdefinition.procoptions) and
  1152. (target_info.abi=abi_i386_dynalignedstack) then
  1153. begin
  1154. { however, a delphi style frame pointer for a nested subroutine
  1155. is not cleared by the callee, so we have to compensate for this
  1156. by passing 4 as pushedparasize does include it }
  1157. if po_delphi_nested_cc in procdefinition.procoptions then
  1158. pop_parasize(sizeof(pint))
  1159. else
  1160. pop_parasize(0);
  1161. end
  1162. { frame pointer parameter is popped by the caller when it's passed the
  1163. Delphi way and $parentfp is used }
  1164. else if (po_delphi_nested_cc in procdefinition.procoptions) and
  1165. not paramanager.use_fixed_stack and
  1166. is_parentfp_pushed() then
  1167. pop_parasize(sizeof(pint));
  1168. if procdefinition.generate_safecall_wrapper then
  1169. begin
  1170. pd:=search_system_proc('fpc_safecallcheck');
  1171. cgpara.init;
  1172. { fpc_safecallcheck returns its parameter value (= function result of function we just called) }
  1173. paramanager.getcgtempparaloc(current_asmdata.CurrAsmList,pd,1,cgpara);
  1174. location_reset(tmploc,LOC_REGISTER,def_cgsize(retloc.Def));
  1175. tmploc.register:=hlcg.getregisterfordef(current_asmdata.CurrAsmList,retloc.Def);
  1176. hlcg.gen_load_cgpara_loc(current_asmdata.CurrAsmList,retloc.Def,retloc,tmploc,true);
  1177. paramanager.freecgpara(current_asmdata.CurrAsmList,cgpara);
  1178. hlcg.a_load_loc_cgpara(current_asmdata.CurrAsmList,retloc.Def,tmploc,cgpara);
  1179. retloc.resetiftemp;
  1180. retloc:=hlcg.g_call_system_proc(current_asmdata.CurrAsmList,pd,[@cgpara],nil);
  1181. cgpara.done;
  1182. end;
  1183. { handle function results }
  1184. if (not is_void(resultdef)) then
  1185. handle_return_value
  1186. else
  1187. location_reset(location,LOC_VOID,OS_NO);
  1188. { convert persistent temps for parameters and function result to normal temps }
  1189. if assigned(callcleanupblock) then
  1190. secondpass(tnode(callcleanupblock));
  1191. { copy back copy-out parameters if any }
  1192. copy_back_paras;
  1193. { release temps and finalize unused return values, must be
  1194. after the callcleanupblock because that converts temps
  1195. from persistent to normal }
  1196. release_unused_return_value;
  1197. { release temps of paras }
  1198. release_para_temps;
  1199. { check for fpu exceptions }
  1200. if cnf_check_fpu_exceptions in callnodeflags then
  1201. cg.maybe_check_for_fpu_exception(current_asmdata.CurrAsmList);
  1202. { perhaps i/o check ? }
  1203. if (cs_check_io in current_settings.localswitches) and
  1204. (po_iocheck in procdefinition.procoptions) and
  1205. not(po_iocheck in current_procinfo.procdef.procoptions) and
  1206. { no IO check for methods and procedure variables }
  1207. (right=nil) and
  1208. not(po_virtualmethod in procdefinition.procoptions) then
  1209. begin
  1210. hlcg.g_call_system_proc(current_asmdata.CurrAsmList,'fpc_iocheck',[],nil).resetiftemp;
  1211. end;
  1212. end;
  1213. destructor tcgcallnode.destroy;
  1214. begin
  1215. retloc.resetiftemp;
  1216. inherited destroy;
  1217. end;
  1218. begin
  1219. ccallparanode:=tcgcallparanode;
  1220. ccallnode:=tcgcallnode;
  1221. end.