ncgcal.pas 59 KB

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