paramgr.pas 27 KB

123456789101112131415161718192021222324252627282930313233343536373839404142434445464748495051525354555657585960616263646566676869707172737475767778798081828384858687888990919293949596979899100101102103104105106107108109110111112113114115116117118119120121122123124125126127128129130131132133134135136137138139140141142143144145146147148149150151152153154155156157158159160161162163164165166167168169170171172173174175176177178179180181182183184185186187188189190191192193194195196197198199200201202203204205206207208209210211212213214215216217218219220221222223224225226227228229230231232233234235236237238239240241242243244245246247248249250251252253254255256257258259260261262263264265266267268269270271272273274275276277278279280281282283284285286287288289290291292293294295296297298299300301302303304305306307308309310311312313314315316317318319320321322323324325326327328329330331332333334335336337338339340341342343344345346347348349350351352353354355356357358359360361362363364365366367368369370371372373374375376377378379380381382383384385386387388389390391392393394395396397398399400401402403404405406407408409410411412413414415416417418419420421422423424425426427428429430431432433434435436437438439440441442443444445446447448449450451452453454455456457458459460461462463464465466467468469470471472473474475476477478479480481482483484485486487488489490491492493494495496497498499500501502503504505506507508509510511512513514515516517518519520521522523524525526527528529530531532533534535536537538539540541542543544545546547548549550551552553554555556557558559560561562563564565566567568569570571572573574575576577578579580581582583584585586587588589590591592593594595596597598599600601602603604605606607608609610611612613614615616617618619620621622623624625626627628629630631632633634635636637638639640641642643644645646647648649650651652653654655656657658659660661662663664665666667668669670671672673674675676677678679680681682683684685686687688689690691692693694695696697698699700701702703704705706707708709710711712713714715716717718719720721722723724725726727728729730731732733734735736737738739740741742743
  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. cclasses,globtype,
  25. cpubase,cgbase,cgutils,
  26. parabase,
  27. aasmtai,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,hlcgobj,tgobj,
  143. defutil,verbose;
  144. { true if the location in paraloc can be reused as localloc }
  145. function tparamanager.param_use_paraloc(const cgpara:tcgpara):boolean;
  146. begin
  147. result:=false;
  148. end;
  149. { true if uses a parameter as return value }
  150. function tparamanager.ret_in_param(def:tdef;pd:tabstractprocdef):boolean;
  151. begin
  152. { This handles all managed types, including COM interfaces and Variants }
  153. if handle_common_ret_in_param(def,pd,result) then
  154. exit;
  155. ret_in_param:=(def.typ=arraydef) or
  156. (def.typ=recorddef) or
  157. (def.typ=stringdef) or
  158. ((def.typ=procvardef) and not tprocvardef(def).is_addressonly) or
  159. ((def.typ=objectdef) and (is_object(def))) or
  160. ((def.typ=setdef) and not is_smallset(def));
  161. end;
  162. function tparamanager.push_high_param(varspez:tvarspez;def : tdef;calloption : tproccalloption) : boolean;
  163. begin
  164. push_high_param:=not(calloption in cdecl_pocalls) and
  165. (
  166. is_open_array(def) or
  167. is_open_string(def) or
  168. is_array_of_const(def)
  169. );
  170. end;
  171. function tparamanager.keep_para_array_range(varspez: tvarspez; def: tdef; calloption: tproccalloption): boolean;
  172. begin
  173. result:=push_high_param(varspez,def,calloption);
  174. end;
  175. function tparamanager.push_copyout_param(varspez: tvarspez; def: tdef; calloption: tproccalloption): boolean;
  176. begin
  177. push_copyout_param:=false;
  178. end;
  179. { return the size of a push }
  180. function tparamanager.push_size(varspez:tvarspez;def : tdef;calloption : tproccalloption) : longint;
  181. begin
  182. push_size:=-1;
  183. case varspez of
  184. vs_constref,
  185. vs_out,
  186. vs_var :
  187. push_size:=voidpointertype.size;
  188. vs_value,
  189. vs_const :
  190. begin
  191. if push_addr_param(varspez,def,calloption) then
  192. push_size:=voidpointertype.size
  193. else
  194. begin
  195. { special array are normally pushed by addr, only for
  196. cdecl array of const it comes here and the pushsize
  197. is unknown }
  198. if is_array_of_const(def) then
  199. push_size:=0
  200. else
  201. push_size:=def.size;
  202. end;
  203. end;
  204. end;
  205. end;
  206. function tparamanager.get_para_align(calloption : tproccalloption):byte;
  207. begin
  208. result:=std_param_align;
  209. end;
  210. function tparamanager.get_volatile_registers_int(calloption : tproccalloption):tcpuregisterset;
  211. begin
  212. result:=[];
  213. end;
  214. function tparamanager.get_volatile_registers_address(calloption : tproccalloption):tcpuregisterset;
  215. begin
  216. result:=[];
  217. end;
  218. function tparamanager.get_volatile_registers_fpu(calloption : tproccalloption):tcpuregisterset;
  219. begin
  220. result:=[];
  221. end;
  222. function tparamanager.get_volatile_registers_flags(calloption : tproccalloption):tcpuregisterset;
  223. begin
  224. result:=[];
  225. end;
  226. function tparamanager.get_volatile_registers_mm(calloption : tproccalloption):tcpuregisterset;
  227. begin
  228. result:=[];
  229. end;
  230. {$if first_mm_imreg = 0}
  231. {$WARN 4044 OFF} { Comparison might be always false ... }
  232. {$endif}
  233. procedure tparamanager.allocparaloc(list: TAsmList; const paraloc: pcgparalocation);
  234. begin
  235. case paraloc^.loc of
  236. LOC_REGISTER,
  237. LOC_CREGISTER:
  238. begin
  239. if getsupreg(paraloc^.register)<first_int_imreg then
  240. cg.getcpuregister(list,paraloc^.register);
  241. end;
  242. {$ifndef x86}
  243. { don't allocate ST(x), they're not handled by the register allocator }
  244. LOC_FPUREGISTER,
  245. LOC_CFPUREGISTER:
  246. begin
  247. if getsupreg(paraloc^.register)<first_fpu_imreg then
  248. cg.getcpuregister(list,paraloc^.register);
  249. end;
  250. {$endif not x86}
  251. LOC_MMREGISTER,
  252. LOC_CMMREGISTER :
  253. begin
  254. if getsupreg(paraloc^.register)<first_mm_imreg then
  255. cg.getcpuregister(list,paraloc^.register);
  256. end;
  257. end;
  258. end;
  259. procedure tparamanager.alloccgpara(list: TAsmList; const cgpara: TCGPara);
  260. var
  261. paraloc : pcgparalocation;
  262. begin
  263. paraloc:=cgpara.location;
  264. while assigned(paraloc) do
  265. begin
  266. allocparaloc(list,paraloc);
  267. paraloc:=paraloc^.next;
  268. end;
  269. end;
  270. procedure tparamanager.freecgpara(list: TAsmList; const cgpara: TCGPara);
  271. var
  272. paraloc : Pcgparalocation;
  273. href : treference;
  274. begin
  275. paraloc:=cgpara.location;
  276. while assigned(paraloc) do
  277. begin
  278. case paraloc^.loc of
  279. LOC_VOID:
  280. ;
  281. LOC_REGISTER,
  282. LOC_CREGISTER:
  283. begin
  284. if getsupreg(paraloc^.register)<first_int_imreg then
  285. cg.ungetcpuregister(list,paraloc^.register);
  286. end;
  287. LOC_FPUREGISTER,
  288. LOC_CFPUREGISTER:
  289. begin
  290. if getsupreg(paraloc^.register)<first_fpu_imreg then
  291. cg.ungetcpuregister(list,paraloc^.register);
  292. end;
  293. LOC_MMREGISTER,
  294. LOC_CMMREGISTER :
  295. begin
  296. if getsupreg(paraloc^.register)<first_mm_imreg then
  297. cg.ungetcpuregister(list,paraloc^.register);
  298. end;
  299. LOC_REFERENCE,
  300. LOC_CREFERENCE :
  301. begin
  302. if use_fixed_stack then
  303. begin
  304. { don't use reference_reset_base, because that will depend on cgobj }
  305. fillchar(href,sizeof(href),0);
  306. href.base:=paraloc^.reference.index;
  307. href.offset:=paraloc^.reference.offset;
  308. tg.ungetiftemp(list,href);
  309. end;
  310. end;
  311. else
  312. internalerror(2004110212);
  313. end;
  314. paraloc:=paraloc^.next;
  315. end;
  316. end;
  317. function tparamanager.is_stack_paraloc(paraloc: pcgparalocation): boolean;
  318. begin
  319. result:=
  320. assigned(paraloc) and
  321. (paraloc^.loc=LOC_REFERENCE) and
  322. (paraloc^.reference.index=NR_STACK_POINTER_REG);
  323. end;
  324. procedure tparamanager.createtempparaloc(list: TAsmList;calloption : tproccalloption;parasym : tparavarsym;can_use_final_stack_loc : boolean;var cgpara:TCGPara);
  325. var
  326. href : treference;
  327. len : aint;
  328. paraloc,
  329. newparaloc : pcgparalocation;
  330. begin
  331. paraloc:=parasym.paraloc[callerside].location;
  332. cgpara.reset;
  333. cgpara.size:=parasym.paraloc[callerside].size;
  334. cgpara.intsize:=parasym.paraloc[callerside].intsize;
  335. cgpara.alignment:=parasym.paraloc[callerside].alignment;
  336. cgpara.def:=parasym.paraloc[callerside].def;
  337. while assigned(paraloc) do
  338. begin
  339. if paraloc^.size=OS_NO then
  340. len:=push_size(parasym.varspez,parasym.vardef,calloption)
  341. else
  342. len:=tcgsize2size[paraloc^.size];
  343. newparaloc:=cgpara.add_location;
  344. newparaloc^.size:=paraloc^.size;
  345. newparaloc^.def:=paraloc^.def;
  346. { shiftval overlaps with part of the reference, so it may be
  347. different from 0 and if wr then force the newparaloc to a register
  348. in the optimization below, shiftval will remain <> 0 }
  349. if not(paraloc^.loc in [LOC_REFERENCE,LOC_CREFERENCE]) then
  350. newparaloc^.shiftval:=paraloc^.shiftval;
  351. { $warning maybe release this optimization for all targets? }
  352. { released for all CPUs:
  353. i386 isn't affected anyways because it uses the stack to push parameters
  354. on arm it reduces executable size of the compiler by 2.1 per cent (FK) }
  355. { Does it fit a register? }
  356. if ((not can_use_final_stack_loc and
  357. use_fixed_stack) or
  358. not is_stack_paraloc(paraloc)) and
  359. (len<=sizeof(pint)) and
  360. (paraloc^.size in [OS_8,OS_16,OS_32,OS_64,OS_128,OS_S8,OS_S16,OS_S32,OS_S64,OS_S128]) then
  361. newparaloc^.loc:=LOC_REGISTER
  362. else
  363. newparaloc^.loc:=paraloc^.loc;
  364. case newparaloc^.loc of
  365. LOC_REGISTER :
  366. begin
  367. if (vo_has_explicit_paraloc in parasym.varoptions) and (paraloc^.loc = LOC_REGISTER) then
  368. if getregtype(paraloc^.register) = R_ADDRESSREGISTER then
  369. newparaloc^.register:=cg.getaddressregister(list)
  370. else
  371. newparaloc^.register:=cg.getintregister(list,paraloc^.size)
  372. else
  373. begin
  374. {$ifdef cpu_uses_separate_address_registers}
  375. if hlcg.def2regtyp(paraloc^.def) = R_ADDRESSREGISTER then
  376. newparaloc^.register:=hlcg.getaddressregister(list,paraloc^.def)
  377. else
  378. {$endif}
  379. newparaloc^.register:=cg.getintregister(list,paraloc^.size);
  380. end;
  381. end;
  382. LOC_FPUREGISTER :
  383. newparaloc^.register:=cg.getfpuregister(list,paraloc^.size);
  384. LOC_MMREGISTER :
  385. newparaloc^.register:=cg.getmmregister(list,paraloc^.size);
  386. LOC_REFERENCE :
  387. begin
  388. if (can_use_final_stack_loc or
  389. not use_fixed_stack) and
  390. is_stack_paraloc(paraloc) then
  391. duplicatecgparaloc(paraloc,newparaloc)
  392. else
  393. begin
  394. if assigned(cgpara.def) then
  395. tg.gethltemp(list,cgpara.def,len,tt_persistent,href)
  396. else
  397. tg.gettemp(list,len,cgpara.alignment,tt_persistent,href);
  398. newparaloc^.reference.index:=href.base;
  399. newparaloc^.reference.offset:=href.offset;
  400. end;
  401. end;
  402. end;
  403. paraloc:=paraloc^.next;
  404. end;
  405. end;
  406. procedure tparamanager.duplicatecgparaloc(const orgparaloc: pcgparalocation; intonewparaloc: pcgparalocation);
  407. begin
  408. move(orgparaloc^,intonewparaloc^,sizeof(intonewparaloc^));
  409. intonewparaloc^.next:=nil;
  410. end;
  411. procedure tparamanager.duplicateparaloc(list: TAsmList;calloption : tproccalloption;parasym : tparavarsym;var cgpara:TCGPara);
  412. var
  413. paraloc,
  414. newparaloc : pcgparalocation;
  415. begin
  416. cgpara.reset;
  417. cgpara.size:=parasym.paraloc[callerside].size;
  418. cgpara.intsize:=parasym.paraloc[callerside].intsize;
  419. cgpara.alignment:=parasym.paraloc[callerside].alignment;
  420. paraloc:=parasym.paraloc[callerside].location;
  421. while assigned(paraloc) do
  422. begin
  423. newparaloc:=cgpara.add_location;
  424. duplicatecgparaloc(paraloc,newparaloc);
  425. paraloc:=paraloc^.next;
  426. end;
  427. end;
  428. procedure tparamanager.create_funcretloc_info(p : tabstractprocdef; side: tcallercallee);
  429. begin
  430. if not assigned(p.funcretloc[side].Location) then
  431. p.funcretloc[side]:=get_funcretloc(p,side,nil);
  432. end;
  433. function tparamanager.create_inline_paraloc_info(p : tabstractprocdef):longint;
  434. begin
  435. { We need to return the size allocated }
  436. p.init_paraloc_info(callbothsides);
  437. result:=p.calleeargareasize;
  438. end;
  439. { used by syscall conventions which require explicit paralocation support }
  440. { this is the standard implementation, CGs might overwrite it }
  441. function tparamanager.parseparaloc(parasym: tparavarsym; const s: string): boolean;
  442. var
  443. paraloc : pcgparalocation;
  444. begin
  445. parasym.paraloc[callerside].alignment:=sizeof(pint);
  446. paraloc:=parasym.paraloc[callerside].add_location;
  447. paraloc^.loc:=LOC_REGISTER;
  448. paraloc^.size:=def_cgsize(parasym.vardef);
  449. paraloc^.def:=parasym.vardef;
  450. paraloc^.register:=std_regnum_search(lowercase(s));
  451. { copy to callee side }
  452. parasym.paraloc[calleeside].add_location^:=paraloc^;
  453. result:=(paraloc^.register <> NR_NO) and
  454. (paraloc^.register <> NR_STACK_POINTER_REG);
  455. end;
  456. function tparamanager.parsefuncretloc(p: tabstractprocdef; const s: string): boolean;
  457. begin
  458. Result:=False;
  459. internalerror(200807236);
  460. end;
  461. function tparamanager.use_fixed_stack: boolean;
  462. begin
  463. {$ifdef i386}
  464. result := target_info.stackalign > 4;
  465. {$else i386}
  466. {$ifdef cputargethasfixedstack}
  467. result := true;
  468. {$else cputargethasfixedstack}
  469. result := false;
  470. {$endif cputargethasfixedstack}
  471. {$endif i386}
  472. end;
  473. { This is a separate function because at least win64 allows stack allocations
  474. despite of fixed stack semantics (actually supporting it requires generating
  475. a compliant stack frame, not yet possible) }
  476. function tparamanager.use_stackalloc: boolean;
  477. begin
  478. result:=not use_fixed_stack;
  479. end;
  480. function tparamanager.set_common_funcretloc_info(p : tabstractprocdef; forcetempdef: tdef; out retcgsize: tcgsize; out retloc: tcgpara): boolean;
  481. var
  482. paraloc : pcgparalocation;
  483. begin
  484. result:=true;
  485. retloc.init;
  486. if not assigned(forcetempdef) then
  487. retloc.def:=p.returndef
  488. else
  489. begin
  490. retloc.def:=forcetempdef;
  491. retloc.temporary:=true;
  492. end;
  493. retloc.alignment:=get_para_align(p.proccalloption);
  494. { void has no location }
  495. if is_void(retloc.def) then
  496. begin
  497. paraloc:=retloc.add_location;
  498. retloc.size:=OS_NO;
  499. retcgsize:=OS_NO;
  500. retloc.intsize:=0;
  501. paraloc^.def:=retloc.def;
  502. paraloc^.size:=OS_NO;
  503. paraloc^.loc:=LOC_VOID;
  504. exit;
  505. end;
  506. { Constructors return self instead of a boolean }
  507. if p.proctypeoption=potype_constructor then
  508. begin
  509. retloc.def:=tdef(p.owner.defowner);
  510. if not (is_implicit_pointer_object_type(retloc.def) or
  511. (retloc.def.typ<>objectdef)) then
  512. retloc.def:=cpointerdef.getreusable_no_free(retloc.def);
  513. end;
  514. retcgsize:=def_cgsize(retloc.def);
  515. retloc.intsize:=retloc.def.size;
  516. retloc.size:=retcgsize;
  517. { Return is passed as var parameter }
  518. if ret_in_param(retloc.def,p) then
  519. begin
  520. retloc.def:=cpointerdef.getreusable_no_free(retloc.def);
  521. paraloc:=retloc.add_location;
  522. paraloc^.loc:=LOC_REFERENCE;
  523. paraloc^.size:=retcgsize;
  524. paraloc^.def:=retloc.def;
  525. exit;
  526. end;
  527. result:=false;
  528. end;
  529. function tparamanager.handle_common_ret_in_param(def: tdef;
  530. pd: tabstractprocdef; out retinparam: boolean): boolean;
  531. begin
  532. { This must be system independent: safecall and record constructor result
  533. is always returned in param.
  534. Furthermore, any managed type is returned in param, in order to avoid
  535. its finalization on exception at callee side. }
  536. if ((tf_safecall_exceptions in target_info.flags) and
  537. (pd.proccalloption=pocall_safecall)) or
  538. (
  539. (pd.proctypeoption=potype_constructor)and
  540. (
  541. is_record(def) or
  542. (
  543. (def.typ<>objectdef) and
  544. (pd.owner.symtabletype=objectsymtable) and
  545. is_objectpascal_helper(tdef(pd.owner.defowner))
  546. )
  547. )
  548. ) or is_managed_type(def) then
  549. begin
  550. retinparam:=true;
  551. exit(true);
  552. end;
  553. if pd.proctypeoption=potype_constructor then
  554. begin
  555. retinparam:=false;
  556. exit(true);
  557. end;
  558. result:=false;
  559. end;
  560. function tparamanager.get_paraloc_def(paradef: tdef; restlen: aint; fullsize: boolean): tdef;
  561. begin
  562. if fullsize then
  563. result:=paradef
  564. { no support for 128 bit ints -> tcgsize2orddef can't handle
  565. OS_(S)128 }
  566. else if restlen in [1,2,4,8] then
  567. result:=cgsize_orddef(int_cgsize(restlen))
  568. else
  569. result:=carraydef.getreusable_no_free(u8inttype,restlen);
  570. end;
  571. procedure tparamanager.getintparaloc(list: TAsmList; pd: tabstractprocdef; nr : longint; var cgpara: tcgpara);
  572. begin
  573. if (nr<1) or (nr>pd.paras.count) then
  574. InternalError(2013060101);
  575. pd.init_paraloc_info(callerside);
  576. cgpara:=tparavarsym(pd.paras[nr-1]).paraloc[callerside].getcopy;
  577. end;
  578. function tparamanager.cgparalocs_to_rttiparalocs(paralocs:pcgparalocation):trttiparalocs;
  579. var
  580. c : longint;
  581. tmploc : pcgparalocation;
  582. begin
  583. c:=0;
  584. tmploc:=paralocs;
  585. while assigned(tmploc) do
  586. begin
  587. inc(c);
  588. tmploc:=tmploc^.next;
  589. end;
  590. setlength(result,c);
  591. c:=0;
  592. tmploc:=paralocs;
  593. while assigned(tmploc) do
  594. begin
  595. result[c]:=cgparaloc_to_rttiparaloc(tmploc);
  596. inc(c);
  597. tmploc:=tmploc^.next;
  598. end;
  599. end;
  600. function tparamanager.cgparaloc_to_rttiparaloc(paraloc:pcgparalocation):trttiparaloc;
  601. var
  602. reg : tregisterrec;
  603. begin
  604. if paraloc^.Loc=LOC_REFERENCE then
  605. begin
  606. reg:=tregisterrec(paraloc^.reference.index);
  607. result.offset:=paraloc^.reference.offset;
  608. result.loctype:=$80;
  609. end
  610. else
  611. begin
  612. reg:=tregisterrec(paraloc^.register);
  613. { use sign extension }
  614. result.offset:=paraloc^.shiftval;
  615. result.loctype:=$00;
  616. end;
  617. case reg.regtype of
  618. R_INTREGISTER,
  619. R_FPUREGISTER,
  620. R_MMXREGISTER,
  621. R_MMREGISTER,
  622. R_SPECIALREGISTER,
  623. R_ADDRESSREGISTER:
  624. begin
  625. result.loctype:=result.loctype or ord(reg.regtype);
  626. result.regsub:=ord(reg.subreg);
  627. result.regindex:=reg.supreg;
  628. end;
  629. else
  630. begin
  631. { no need to adjust loctype }
  632. result.regsub:=0;
  633. result.regindex:=0;
  634. end;
  635. end;
  636. end;
  637. initialization
  638. ;
  639. finalization
  640. paramanager.free;
  641. end.