ncgcal.pas 60 KB

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