ncgcal.pas 59 KB

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