paramgr.pas 27 KB

123456789101112131415161718192021222324252627282930313233343536373839404142434445464748495051525354555657585960616263646566676869707172737475767778798081828384858687888990919293949596979899100101102103104105106107108109110111112113114115116117118119120121122123124125126127128129130131132133134135136137138139140141142143144145146147148149150151152153154155156157158159160161162163164165166167168169170171172173174175176177178179180181182183184185186187188189190191192193194195196197198199200201202203204205206207208209210211212213214215216217218219220221222223224225226227228229230231232233234235236237238239240241242243244245246247248249250251252253254255256257258259260261262263264265266267268269270271272273274275276277278279280281282283284285286287288289290291292293294295296297298299300301302303304305306307308309310311312313314315316317318319320321322323324325326327328329330331332333334335336337338339340341342343344345346347348349350351352353354355356357358359360361362363364365366367368369370371372373374375376377378379380381382383384385386387388389390391392393394395396397398399400401402403404405406407408409410411412413414415416417418419420421422423424425426427428429430431432433434435436437438439440441442443444445446447448449450451452453454455456457458459460461462463464465466467468469470471472473474475476477478479480481482483484485486487488489490491492493494495496497498499500501502503504505506507508509510511512513514515516517518519520521522523524525526527528529530531532533534535536537538539540541542543544545546547548549550551552553554555556557558559560561562563564565566567568569570571572573574575576577578579580581582583584585586587588589590591592593594595596597598599600601602603604605606607608609610611612613614615616617618619620621622623624625626627628629630631632633634635636637638639640641642643644645646647648649650651652653654655656657658659660661662663664665666667668669670671672673674675676677678679680681682683684685686687688689690691692693694695696697698699700701702703704705706707708709710711712713714715716717718719720721722723724725726727728729730731732733734735736737738739740741742743744
  1. {
  2. Copyright (c) 2002 by Florian Klaempfl
  3. Generic calling convention handling
  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. {# Parameter passing manager. Used to manage how
  18. parameters are passed to routines.
  19. }
  20. unit paramgr;
  21. {$i fpcdefs.inc}
  22. interface
  23. uses
  24. globtype,
  25. cpubase,cgbase,cgutils,
  26. parabase,
  27. aasmdata,
  28. symconst,symtype,symsym,symdef;
  29. type
  30. {# This class defines some methods to take care of routine
  31. parameters. It should be overridden for each new processor
  32. }
  33. { tparamanager }
  34. tparamanager = class
  35. { true if the location in paraloc can be reused as localloc }
  36. function param_use_paraloc(const cgpara:tcgpara):boolean;virtual;
  37. { Returns true if the return value is actually a parameter pointer }
  38. function ret_in_param(def:tdef;pd:tabstractprocdef):boolean;virtual;
  39. function push_high_param(varspez:tvarspez;def : tdef;calloption : tproccalloption) : boolean;virtual;
  40. function keep_para_array_range(varspez:tvarspez;def : tdef;calloption : tproccalloption) : boolean;virtual;
  41. { Returns true if a parameter is too large to copy and only
  42. the address is pushed
  43. }
  44. function push_addr_param(varspez:tvarspez;def : tdef;calloption : tproccalloption) : boolean;virtual;abstract;
  45. { returns true if a parameter must be handled via copy-out (construct
  46. a reference, copy the parameter's value there in case of copy-in/out, pass the reference)
  47. }
  48. function push_copyout_param(varspez:tvarspez;def : tdef;calloption : tproccalloption) : boolean;virtual;
  49. { return the size of a push }
  50. function push_size(varspez:tvarspez;def : tdef;calloption : tproccalloption) : longint;virtual;
  51. {# Returns a structure giving the information on
  52. the storage of the parameter (which must be
  53. an integer parameter). This is only used when calling
  54. internal routines directly, where all parameters must
  55. be 4-byte values.
  56. In case the location is a register, this register is allocated.
  57. Call freeintparaloc() after the call to free the locations again.
  58. Default implementation: don't do anything at all (in case you don't
  59. use register parameter passing)
  60. @param(list Current assembler list)
  61. @param(nr Parameter number of routine, starting from 1)
  62. }
  63. function get_para_align(calloption : tproccalloption):byte;virtual;
  64. function get_volatile_registers_int(calloption : tproccalloption):tcpuregisterset;virtual;
  65. function get_volatile_registers_address(calloption : tproccalloption):tcpuregisterset;virtual;
  66. function get_volatile_registers_fpu(calloption : tproccalloption):tcpuregisterset;virtual;
  67. function get_volatile_registers_flags(calloption : tproccalloption):tcpuregisterset;virtual;
  68. function get_volatile_registers_mm(calloption : tproccalloption):tcpuregisterset;virtual;
  69. procedure getintparaloc(list: TAsmList; pd: tabstractprocdef; nr : longint; var cgpara: tcgpara);virtual;
  70. {# allocate an individual pcgparalocation that's part of a tcgpara
  71. @param(list Current assembler list)
  72. @param(loc Parameter location element)
  73. }
  74. procedure allocparaloc(list: TAsmList; const paraloc: pcgparalocation);
  75. {# allocate a parameter location created with create_paraloc_info
  76. @param(list Current assembler list)
  77. @param(loc Parameter location)
  78. }
  79. procedure alloccgpara(list: TAsmList; const cgpara: TCGPara); virtual;
  80. {# free a parameter location allocated with alloccgpara
  81. @param(list Current assembler list)
  82. @param(loc Parameter location)
  83. }
  84. procedure freecgpara(list: TAsmList; const cgpara: TCGPara); virtual;
  85. { This is used to populate the location information on all parameters
  86. for the routine as seen in either the caller or the callee. It returns
  87. the size allocated on the stack
  88. }
  89. function create_paraloc_info(p : tabstractprocdef; side: tcallercallee):longint;virtual;abstract;
  90. { Returns the location of the function result if p had def as
  91. function result instead of its actual result. Used if the compiler
  92. forces the function result to something different than the real
  93. result. }
  94. function get_funcretloc(p : tabstractprocdef; side: tcallercallee; forcetempdef: tdef): tcgpara;virtual;abstract;
  95. procedure create_funcretloc_info(p : tabstractprocdef; side: tcallercallee);
  96. { This is used to populate the location information on all parameters
  97. for the routine when it is being inlined. It returns
  98. the size allocated on the stack
  99. }
  100. function create_inline_paraloc_info(p : tabstractprocdef):longint;virtual;
  101. { This is used to populate the location information on all parameters
  102. for the routine that are passed as varargs. It returns
  103. the size allocated on the stack (including the normal parameters)
  104. }
  105. function create_varargs_paraloc_info(p : tabstractprocdef; varargspara:tvarargsparalist):longint;virtual;abstract;
  106. function is_stack_paraloc(paraloc: pcgparalocation): boolean;virtual;
  107. procedure createtempparaloc(list: TAsmList;calloption : tproccalloption;parasym : tparavarsym;can_use_final_stack_loc : boolean;var cgpara:TCGPara);virtual;
  108. procedure duplicatecgparaloc(const orgparaloc: pcgparalocation; intonewparaloc: pcgparalocation);
  109. procedure duplicateparaloc(list: TAsmList;calloption : tproccalloption;parasym : tparavarsym;var cgpara:TCGPara);
  110. function parseparaloc(parasym : tparavarsym;const s : string) : boolean;virtual;
  111. function parsefuncretloc(p : tabstractprocdef; const s : string) : boolean;virtual;
  112. { Convert a list of CGParaLocation entries to a RTTIParaLoc array that
  113. can be written by ncgrtti }
  114. function cgparalocs_to_rttiparalocs(paralocs:pcgparalocation):trttiparalocs;
  115. { allocate room for parameters on the stack in the entry code? }
  116. function use_fixed_stack: boolean;
  117. { whether stack pointer can be changed in the middle of procedure }
  118. function use_stackalloc: boolean;
  119. strict protected
  120. { common part of get_funcretloc; returns true if retloc is completely
  121. initialized afterwards }
  122. function set_common_funcretloc_info(p : tabstractprocdef; forcetempdef: tdef; out retcgsize: tcgsize; out retloc: tcgpara): boolean;
  123. { common part of ret_in_param; is called by ret_in_param at the
  124. beginning and every tparamanager descendant can decide to call it
  125. itself as well; parameter retinparam is only valid if function
  126. returns true }
  127. function handle_common_ret_in_param(def:tdef;pd:tabstractprocdef;out retinparam:boolean):boolean;
  128. { returns the def to use for a tparalocation part of a cgpara for paradef,
  129. for which the def is paradef and the integer length is restlen.
  130. fullsize is true if restlen equals the full paradef size }
  131. function get_paraloc_def(paradef: tdef; restlen: aint; fullsize: boolean): tdef;
  132. { convert a single CGParaLocation to a RTTIParaLoc; the method *might*
  133. be overriden by targets to provide backwards compatibility with
  134. older versions in case register indices changed }
  135. function cgparaloc_to_rttiparaloc(paraloc:pcgparalocation):trttiparaloc;virtual;
  136. end;
  137. var
  138. paramanager : tparamanager;
  139. implementation
  140. uses
  141. systems,
  142. cgobj,tgobj,
  143. defutil,verbose,
  144. hlcgobj;
  145. { true if the location in paraloc can be reused as localloc }
  146. function tparamanager.param_use_paraloc(const cgpara:tcgpara):boolean;
  147. begin
  148. result:=false;
  149. end;
  150. { true if uses a parameter as return value }
  151. function tparamanager.ret_in_param(def:tdef;pd:tabstractprocdef):boolean;
  152. begin
  153. { This handles all managed types, including COM interfaces and Variants }
  154. if handle_common_ret_in_param(def,pd,result) then
  155. exit;
  156. ret_in_param:=(def.typ=arraydef) or
  157. (def.typ=recorddef) or
  158. (def.typ=stringdef) or
  159. ((def.typ=procvardef) and not tprocvardef(def).is_addressonly) or
  160. ((def.typ=objectdef) and (is_object(def))) or
  161. ((def.typ=setdef) and not is_smallset(def));
  162. end;
  163. function tparamanager.push_high_param(varspez:tvarspez;def : tdef;calloption : tproccalloption) : boolean;
  164. begin
  165. push_high_param:=not(calloption in cdecl_pocalls) and
  166. (
  167. is_open_array(def) or
  168. is_open_string(def) or
  169. is_array_of_const(def)
  170. );
  171. end;
  172. function tparamanager.keep_para_array_range(varspez: tvarspez; def: tdef; calloption: tproccalloption): boolean;
  173. begin
  174. result:=push_high_param(varspez,def,calloption);
  175. end;
  176. function tparamanager.push_copyout_param(varspez: tvarspez; def: tdef; calloption: tproccalloption): boolean;
  177. begin
  178. push_copyout_param:=false;
  179. end;
  180. { return the size of a push }
  181. function tparamanager.push_size(varspez:tvarspez;def : tdef;calloption : tproccalloption) : longint;
  182. begin
  183. push_size:=-1;
  184. case varspez of
  185. vs_constref,
  186. vs_out,
  187. vs_var :
  188. push_size:=voidpointertype.size;
  189. vs_value,
  190. vs_const :
  191. begin
  192. if push_addr_param(varspez,def,calloption) then
  193. push_size:=voidpointertype.size
  194. else
  195. begin
  196. { special array are normally pushed by addr, only for
  197. cdecl array of const it comes here and the pushsize
  198. is unknown }
  199. if is_array_of_const(def) then
  200. push_size:=0
  201. else
  202. push_size:=def.size;
  203. end;
  204. end;
  205. end;
  206. end;
  207. function tparamanager.get_para_align(calloption : tproccalloption):byte;
  208. begin
  209. result:=std_param_align;
  210. end;
  211. function tparamanager.get_volatile_registers_int(calloption : tproccalloption):tcpuregisterset;
  212. begin
  213. result:=[];
  214. end;
  215. function tparamanager.get_volatile_registers_address(calloption : tproccalloption):tcpuregisterset;
  216. begin
  217. result:=[];
  218. end;
  219. function tparamanager.get_volatile_registers_fpu(calloption : tproccalloption):tcpuregisterset;
  220. begin
  221. result:=[];
  222. end;
  223. function tparamanager.get_volatile_registers_flags(calloption : tproccalloption):tcpuregisterset;
  224. begin
  225. result:=[];
  226. end;
  227. function tparamanager.get_volatile_registers_mm(calloption : tproccalloption):tcpuregisterset;
  228. begin
  229. result:=[];
  230. end;
  231. {$if first_mm_imreg = 0}
  232. {$WARN 4044 OFF} { Comparison might be always false ... }
  233. {$endif}
  234. procedure tparamanager.allocparaloc(list: TAsmList; const paraloc: pcgparalocation);
  235. begin
  236. case paraloc^.loc of
  237. LOC_REGISTER,
  238. LOC_CREGISTER:
  239. begin
  240. if getsupreg(paraloc^.register)<first_int_imreg then
  241. cg.getcpuregister(list,paraloc^.register);
  242. end;
  243. {$ifndef x86}
  244. { don't allocate ST(x), they're not handled by the register allocator }
  245. LOC_FPUREGISTER,
  246. LOC_CFPUREGISTER:
  247. begin
  248. if getsupreg(paraloc^.register)<first_fpu_imreg then
  249. cg.getcpuregister(list,paraloc^.register);
  250. end;
  251. {$endif not x86}
  252. LOC_MMREGISTER,
  253. LOC_CMMREGISTER :
  254. begin
  255. if getsupreg(paraloc^.register)<first_mm_imreg then
  256. cg.getcpuregister(list,paraloc^.register);
  257. end;
  258. end;
  259. end;
  260. procedure tparamanager.alloccgpara(list: TAsmList; const cgpara: TCGPara);
  261. var
  262. paraloc : pcgparalocation;
  263. begin
  264. paraloc:=cgpara.location;
  265. while assigned(paraloc) do
  266. begin
  267. allocparaloc(list,paraloc);
  268. paraloc:=paraloc^.next;
  269. end;
  270. end;
  271. procedure tparamanager.freecgpara(list: TAsmList; const cgpara: TCGPara);
  272. var
  273. paraloc : Pcgparalocation;
  274. href : treference;
  275. begin
  276. paraloc:=cgpara.location;
  277. while assigned(paraloc) do
  278. begin
  279. case paraloc^.loc of
  280. LOC_VOID:
  281. ;
  282. LOC_REGISTER,
  283. LOC_CREGISTER:
  284. begin
  285. if getsupreg(paraloc^.register)<first_int_imreg then
  286. cg.ungetcpuregister(list,paraloc^.register);
  287. end;
  288. LOC_FPUREGISTER,
  289. LOC_CFPUREGISTER:
  290. begin
  291. if getsupreg(paraloc^.register)<first_fpu_imreg then
  292. cg.ungetcpuregister(list,paraloc^.register);
  293. end;
  294. LOC_MMREGISTER,
  295. LOC_CMMREGISTER :
  296. begin
  297. if getsupreg(paraloc^.register)<first_mm_imreg then
  298. cg.ungetcpuregister(list,paraloc^.register);
  299. end;
  300. LOC_REFERENCE,
  301. LOC_CREFERENCE :
  302. begin
  303. if use_fixed_stack then
  304. begin
  305. { don't use reference_reset_base, because that will depend on cgobj }
  306. fillchar(href,sizeof(href),0);
  307. href.base:=paraloc^.reference.index;
  308. href.offset:=paraloc^.reference.offset;
  309. tg.ungetiftemp(list,href);
  310. end;
  311. end;
  312. else
  313. internalerror(2004110212);
  314. end;
  315. paraloc:=paraloc^.next;
  316. end;
  317. end;
  318. function tparamanager.is_stack_paraloc(paraloc: pcgparalocation): boolean;
  319. begin
  320. result:=
  321. assigned(paraloc) and
  322. (paraloc^.loc=LOC_REFERENCE) and
  323. (paraloc^.reference.index=NR_STACK_POINTER_REG);
  324. end;
  325. procedure tparamanager.createtempparaloc(list: TAsmList;calloption : tproccalloption;parasym : tparavarsym;can_use_final_stack_loc : boolean;var cgpara:TCGPara);
  326. var
  327. href : treference;
  328. len : aint;
  329. paraloc,
  330. newparaloc : pcgparalocation;
  331. begin
  332. paraloc:=parasym.paraloc[callerside].location;
  333. cgpara.reset;
  334. cgpara.size:=parasym.paraloc[callerside].size;
  335. cgpara.intsize:=parasym.paraloc[callerside].intsize;
  336. cgpara.alignment:=parasym.paraloc[callerside].alignment;
  337. cgpara.def:=parasym.paraloc[callerside].def;
  338. while assigned(paraloc) do
  339. begin
  340. if paraloc^.size=OS_NO then
  341. len:=push_size(parasym.varspez,parasym.vardef,calloption)
  342. else
  343. len:=tcgsize2size[paraloc^.size];
  344. newparaloc:=cgpara.add_location;
  345. newparaloc^.size:=paraloc^.size;
  346. newparaloc^.def:=paraloc^.def;
  347. { shiftval overlaps with part of the reference, so it may be
  348. different from 0 and if wr then force the newparaloc to a register
  349. in the optimization below, shiftval will remain <> 0 }
  350. if not(paraloc^.loc in [LOC_REFERENCE,LOC_CREFERENCE]) then
  351. newparaloc^.shiftval:=paraloc^.shiftval;
  352. { $warning maybe release this optimization for all targets? }
  353. { released for all CPUs:
  354. i386 isn't affected anyways because it uses the stack to push parameters
  355. on arm it reduces executable size of the compiler by 2.1 per cent (FK) }
  356. { Does it fit a register? }
  357. if ((not can_use_final_stack_loc and
  358. use_fixed_stack) or
  359. not is_stack_paraloc(paraloc)) and
  360. (len<=sizeof(pint)) and
  361. (paraloc^.size in [OS_8,OS_16,OS_32,OS_64,OS_128,OS_S8,OS_S16,OS_S32,OS_S64,OS_S128]) then
  362. newparaloc^.loc:=LOC_REGISTER
  363. else
  364. newparaloc^.loc:=paraloc^.loc;
  365. case newparaloc^.loc of
  366. LOC_REGISTER :
  367. begin
  368. if (vo_has_explicit_paraloc in parasym.varoptions) and (paraloc^.loc = LOC_REGISTER) then
  369. if getregtype(paraloc^.register) = R_ADDRESSREGISTER then
  370. newparaloc^.register:=cg.getaddressregister(list)
  371. else
  372. newparaloc^.register:=cg.getintregister(list,paraloc^.size)
  373. else
  374. begin
  375. {$ifdef cpu_uses_separate_address_registers}
  376. if hlcg.def2regtyp(paraloc^.def) = R_ADDRESSREGISTER then
  377. newparaloc^.register:=hlcg.getaddressregister(list,paraloc^.def)
  378. else
  379. {$endif}
  380. newparaloc^.register:=cg.getintregister(list,paraloc^.size);
  381. end;
  382. end;
  383. LOC_FPUREGISTER :
  384. newparaloc^.register:=cg.getfpuregister(list,paraloc^.size);
  385. LOC_MMREGISTER :
  386. newparaloc^.register:=cg.getmmregister(list,paraloc^.size);
  387. LOC_REFERENCE :
  388. begin
  389. if (can_use_final_stack_loc or
  390. not use_fixed_stack) and
  391. is_stack_paraloc(paraloc) then
  392. duplicatecgparaloc(paraloc,newparaloc)
  393. else
  394. begin
  395. if assigned(cgpara.def) then
  396. tg.gethltemp(list,cgpara.def,len,tt_persistent,href)
  397. else
  398. tg.gettemp(list,len,cgpara.alignment,tt_persistent,href);
  399. newparaloc^.reference.index:=href.base;
  400. newparaloc^.reference.offset:=href.offset;
  401. end;
  402. end;
  403. end;
  404. paraloc:=paraloc^.next;
  405. end;
  406. end;
  407. procedure tparamanager.duplicatecgparaloc(const orgparaloc: pcgparalocation; intonewparaloc: pcgparalocation);
  408. begin
  409. move(orgparaloc^,intonewparaloc^,sizeof(intonewparaloc^));
  410. intonewparaloc^.next:=nil;
  411. end;
  412. procedure tparamanager.duplicateparaloc(list: TAsmList;calloption : tproccalloption;parasym : tparavarsym;var cgpara:TCGPara);
  413. var
  414. paraloc,
  415. newparaloc : pcgparalocation;
  416. begin
  417. cgpara.reset;
  418. cgpara.size:=parasym.paraloc[callerside].size;
  419. cgpara.intsize:=parasym.paraloc[callerside].intsize;
  420. cgpara.alignment:=parasym.paraloc[callerside].alignment;
  421. paraloc:=parasym.paraloc[callerside].location;
  422. while assigned(paraloc) do
  423. begin
  424. newparaloc:=cgpara.add_location;
  425. duplicatecgparaloc(paraloc,newparaloc);
  426. paraloc:=paraloc^.next;
  427. end;
  428. end;
  429. procedure tparamanager.create_funcretloc_info(p : tabstractprocdef; side: tcallercallee);
  430. begin
  431. if not assigned(p.funcretloc[side].Location) then
  432. p.funcretloc[side]:=get_funcretloc(p,side,nil);
  433. end;
  434. function tparamanager.create_inline_paraloc_info(p : tabstractprocdef):longint;
  435. begin
  436. { We need to return the size allocated }
  437. p.init_paraloc_info(callbothsides);
  438. result:=p.calleeargareasize;
  439. end;
  440. { used by syscall conventions which require explicit paralocation support }
  441. { this is the standard implementation, CGs might overwrite it }
  442. function tparamanager.parseparaloc(parasym: tparavarsym; const s: string): boolean;
  443. var
  444. paraloc : pcgparalocation;
  445. begin
  446. parasym.paraloc[callerside].alignment:=sizeof(pint);
  447. paraloc:=parasym.paraloc[callerside].add_location;
  448. paraloc^.loc:=LOC_REGISTER;
  449. paraloc^.size:=def_cgsize(parasym.vardef);
  450. paraloc^.def:=parasym.vardef;
  451. paraloc^.register:=std_regnum_search(lowercase(s));
  452. { copy to callee side }
  453. parasym.paraloc[calleeside].add_location^:=paraloc^;
  454. result:=(paraloc^.register <> NR_NO) and
  455. (paraloc^.register <> NR_STACK_POINTER_REG);
  456. end;
  457. function tparamanager.parsefuncretloc(p: tabstractprocdef; const s: string): boolean;
  458. begin
  459. Result:=False;
  460. internalerror(200807236);
  461. end;
  462. function tparamanager.use_fixed_stack: boolean;
  463. begin
  464. {$ifdef i386}
  465. result := target_info.stackalign > 4;
  466. {$else i386}
  467. {$ifdef cputargethasfixedstack}
  468. result := true;
  469. {$else cputargethasfixedstack}
  470. result := false;
  471. {$endif cputargethasfixedstack}
  472. {$endif i386}
  473. end;
  474. { This is a separate function because at least win64 allows stack allocations
  475. despite of fixed stack semantics (actually supporting it requires generating
  476. a compliant stack frame, not yet possible) }
  477. function tparamanager.use_stackalloc: boolean;
  478. begin
  479. result:=not use_fixed_stack;
  480. end;
  481. function tparamanager.set_common_funcretloc_info(p : tabstractprocdef; forcetempdef: tdef; out retcgsize: tcgsize; out retloc: tcgpara): boolean;
  482. var
  483. paraloc : pcgparalocation;
  484. begin
  485. result:=true;
  486. retloc.init;
  487. if not assigned(forcetempdef) then
  488. retloc.def:=p.returndef
  489. else
  490. begin
  491. retloc.def:=forcetempdef;
  492. retloc.temporary:=true;
  493. end;
  494. retloc.alignment:=get_para_align(p.proccalloption);
  495. { void has no location }
  496. if is_void(retloc.def) then
  497. begin
  498. paraloc:=retloc.add_location;
  499. retloc.size:=OS_NO;
  500. retcgsize:=OS_NO;
  501. retloc.intsize:=0;
  502. paraloc^.def:=retloc.def;
  503. paraloc^.size:=OS_NO;
  504. paraloc^.loc:=LOC_VOID;
  505. exit;
  506. end;
  507. { Constructors return self instead of a boolean }
  508. if p.proctypeoption=potype_constructor then
  509. begin
  510. retloc.def:=tdef(p.owner.defowner);
  511. if not (is_implicit_pointer_object_type(retloc.def) or
  512. (retloc.def.typ<>objectdef)) then
  513. retloc.def:=cpointerdef.getreusable_no_free(retloc.def);
  514. end;
  515. retcgsize:=def_cgsize(retloc.def);
  516. retloc.intsize:=retloc.def.size;
  517. retloc.size:=retcgsize;
  518. { Return is passed as var parameter }
  519. if ret_in_param(retloc.def,p) then
  520. begin
  521. retloc.def:=cpointerdef.getreusable_no_free(retloc.def);
  522. paraloc:=retloc.add_location;
  523. paraloc^.loc:=LOC_REFERENCE;
  524. paraloc^.size:=retcgsize;
  525. paraloc^.def:=retloc.def;
  526. exit;
  527. end;
  528. result:=false;
  529. end;
  530. function tparamanager.handle_common_ret_in_param(def: tdef;
  531. pd: tabstractprocdef; out retinparam: boolean): boolean;
  532. begin
  533. { This must be system independent: safecall and record constructor result
  534. is always returned in param.
  535. Furthermore, any managed type is returned in param, in order to avoid
  536. its finalization on exception at callee side. }
  537. if ((tf_safecall_exceptions in target_info.flags) and
  538. (pd.proccalloption=pocall_safecall)) or
  539. (
  540. (pd.proctypeoption=potype_constructor) and
  541. (
  542. is_record(def) or
  543. (
  544. (def.typ<>objectdef) and
  545. (pd.owner.symtabletype=objectsymtable) and
  546. is_objectpascal_helper(tdef(pd.owner.defowner))
  547. )
  548. )
  549. ) or is_managed_type(def) then
  550. begin
  551. retinparam:=true;
  552. exit(true);
  553. end;
  554. if pd.proctypeoption=potype_constructor then
  555. begin
  556. retinparam:=false;
  557. exit(true);
  558. end;
  559. result:=false;
  560. end;
  561. function tparamanager.get_paraloc_def(paradef: tdef; restlen: aint; fullsize: boolean): tdef;
  562. begin
  563. if fullsize then
  564. result:=paradef
  565. { no support for 128 bit ints -> tcgsize2orddef can't handle
  566. OS_(S)128 }
  567. else if restlen in [1,2,4,8] then
  568. result:=cgsize_orddef(int_cgsize(restlen))
  569. else
  570. result:=carraydef.getreusable_no_free(u8inttype,restlen);
  571. end;
  572. procedure tparamanager.getintparaloc(list: TAsmList; pd: tabstractprocdef; nr : longint; var cgpara: tcgpara);
  573. begin
  574. if (nr<1) or (nr>pd.paras.count) then
  575. InternalError(2013060101);
  576. pd.init_paraloc_info(callerside);
  577. cgpara:=tparavarsym(pd.paras[nr-1]).paraloc[callerside].getcopy;
  578. end;
  579. function tparamanager.cgparalocs_to_rttiparalocs(paralocs:pcgparalocation):trttiparalocs;
  580. var
  581. c : longint;
  582. tmploc : pcgparalocation;
  583. begin
  584. c:=0;
  585. tmploc:=paralocs;
  586. while assigned(tmploc) do
  587. begin
  588. inc(c);
  589. tmploc:=tmploc^.next;
  590. end;
  591. setlength(result,c);
  592. c:=0;
  593. tmploc:=paralocs;
  594. while assigned(tmploc) do
  595. begin
  596. result[c]:=cgparaloc_to_rttiparaloc(tmploc);
  597. inc(c);
  598. tmploc:=tmploc^.next;
  599. end;
  600. end;
  601. function tparamanager.cgparaloc_to_rttiparaloc(paraloc:pcgparalocation):trttiparaloc;
  602. var
  603. reg : tregisterrec;
  604. begin
  605. if paraloc^.Loc=LOC_REFERENCE then
  606. begin
  607. reg:=tregisterrec(paraloc^.reference.index);
  608. result.offset:=paraloc^.reference.offset;
  609. result.loctype:=$80;
  610. end
  611. else
  612. begin
  613. reg:=tregisterrec(paraloc^.register);
  614. { use sign extension }
  615. result.offset:=paraloc^.shiftval;
  616. result.loctype:=$00;
  617. end;
  618. case reg.regtype of
  619. R_INTREGISTER,
  620. R_FPUREGISTER,
  621. R_MMXREGISTER,
  622. R_MMREGISTER,
  623. R_SPECIALREGISTER,
  624. R_ADDRESSREGISTER:
  625. begin
  626. result.loctype:=result.loctype or ord(reg.regtype);
  627. result.regsub:=ord(reg.subreg);
  628. result.regindex:=reg.supreg;
  629. end;
  630. else
  631. begin
  632. { no need to adjust loctype }
  633. result.regsub:=0;
  634. result.regindex:=0;
  635. end;
  636. end;
  637. end;
  638. initialization
  639. ;
  640. finalization
  641. paramanager.free;
  642. end.