ncgcal.pas 56 KB

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