ncgcal.pas 59 KB

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