paramgr.pas 6.1 KB

123456789101112131415161718192021222324252627282930313233343536373839404142434445464748495051525354555657585960616263646566676869707172737475767778798081828384858687888990919293949596979899100101102103104105106107108109110111112113114115116117118119120121122123124125126127128129130131132133134135136137138139140141142143144145146147148149150151152153154155156157158159160161162163164165166167168169170171172173174175176
  1. {
  2. $Id$
  3. Copyright (c) 2002 by Florian Klaempfl
  4. PowerPC specific calling conventions
  5. This program is free software; you can redistribute it and/or modify
  6. it under the terms of the GNU General Public License as published by
  7. the Free Software Foundation; either version 2 of the License, or
  8. (at your option) any later version.
  9. This program is distributed in the hope that it will be useful,
  10. but WITHOUT ANY WARRANTY; without even the implied warranty of
  11. MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
  12. GNU General Public License for more details.
  13. You should have received a copy of the GNU General Public License
  14. along with this program; if not, write to the Free Software
  15. Foundation, Inc., 675 Mass Ave, Cambridge, MA 02139, USA.
  16. ****************************************************************************
  17. }
  18. {
  19. }
  20. unit paramgr;
  21. {$i fpcdefs.inc}
  22. interface
  23. uses
  24. cpubase,
  25. symtype,symdef;
  26. type
  27. tparamanager = class
  28. { Returns true if the return value can be put in accumulator }
  29. function ret_in_acc(def : tdef) : boolean;virtual;
  30. { Returns true if uses a parameter as return value (???) }
  31. function ret_in_param(def : tdef) : boolean;virtual;
  32. function push_high_param(def : tdef) : boolean;virtual;
  33. { Returns true if a parameter is too large to copy and only the address is pushed
  34. }
  35. function push_addr_param(def : tdef) : boolean;virtual;
  36. function getintparaloc(nr : longint) : tparalocation;virtual;abstract;
  37. procedure create_param_loc_info(p : tabstractprocdef);virtual;abstract;
  38. { Returns the location where the invisible parameter for structured
  39. function results will be passed.
  40. }
  41. function getfuncretloc(p : tabstractprocdef) : tparalocation;virtual;abstract;
  42. { Returns the self pointer for the give procdef
  43. function getfuncretloc(p : tabstractprocdef) : tparalocation;virtual;abstract;
  44. }
  45. end;
  46. procedure setparalocs(p : tprocdef);
  47. var
  48. paralocdummy : tparalocation;
  49. paramanager : tparamanager;
  50. implementation
  51. uses
  52. cpuinfo,
  53. symconst,symbase,symsym,
  54. defbase;
  55. { true if the return value is in accumulator (EAX for i386), D0 for 68k }
  56. function tparamanager.ret_in_acc(def : tdef) : boolean;
  57. begin
  58. ret_in_acc:=(def.deftype in [orddef,pointerdef,enumdef,classrefdef]) or
  59. ((def.deftype=stringdef) and (tstringdef(def).string_typ in [st_ansistring,st_widestring])) or
  60. ((def.deftype=procvardef) and not(po_methodpointer in tprocvardef(def).procoptions)) or
  61. ((def.deftype=objectdef) and not is_object(def)) or
  62. ((def.deftype=setdef) and (tsetdef(def).settype=smallset));
  63. end;
  64. { true if uses a parameter as return value }
  65. function tparamanager.ret_in_param(def : tdef) : boolean;
  66. begin
  67. ret_in_param:=(def.deftype in [arraydef,recorddef]) or
  68. ((def.deftype=stringdef) and (tstringdef(def).string_typ in [st_shortstring,st_longstring])) or
  69. ((def.deftype=procvardef) and (po_methodpointer in tprocvardef(def).procoptions)) or
  70. ((def.deftype=objectdef) and is_object(def)) or
  71. (def.deftype=variantdef) or
  72. ((def.deftype=setdef) and (tsetdef(def).settype<>smallset));
  73. end;
  74. function tparamanager.push_high_param(def : tdef) : boolean;
  75. begin
  76. push_high_param:=is_open_array(def) or
  77. is_open_string(def) or
  78. is_array_of_const(def);
  79. end;
  80. { true if a parameter is too large to copy and only the address is pushed }
  81. function tparamanager.push_addr_param(def : tdef) : boolean;
  82. begin
  83. push_addr_param:=false;
  84. if never_copy_const_param then
  85. push_addr_param:=true
  86. else
  87. begin
  88. case def.deftype of
  89. variantdef,
  90. formaldef :
  91. push_addr_param:=true;
  92. recorddef :
  93. push_addr_param:=(def.size>pointer_size);
  94. arraydef :
  95. push_addr_param:=((tarraydef(def).highrange>=tarraydef(def).lowrange) and (def.size>pointer_size)) or
  96. is_open_array(def) or
  97. is_array_of_const(def) or
  98. is_array_constructor(def);
  99. objectdef :
  100. push_addr_param:=is_object(def);
  101. stringdef :
  102. push_addr_param:=tstringdef(def).string_typ in [st_shortstring,st_longstring];
  103. procvardef :
  104. push_addr_param:=(po_methodpointer in tprocvardef(def).procoptions);
  105. setdef :
  106. push_addr_param:=(tsetdef(def).settype<>smallset);
  107. end;
  108. end;
  109. end;
  110. procedure setparalocs(p : tprocdef);
  111. var
  112. hp : tparaitem;
  113. begin
  114. hp:=tparaitem(p.para.first);
  115. while assigned(hp) do
  116. begin
  117. if (hp.paraloc.loc in [LOC_REGISTER,LOC_FPUREGISTER]) and
  118. { if the parameter isn't regable, we've to work with the local copy }
  119. (vo_regable in tvarsym(hp.parasym).varoptions) then
  120. tvarsym(hp.parasym).reg:=hp.paraloc.register;
  121. hp:=tparaitem(hp.next);
  122. end;
  123. end;
  124. finalization
  125. paramanager.free;
  126. end.
  127. {
  128. $Log$
  129. Revision 1.6 2002-07-30 20:50:43 florian
  130. * the code generator knows now if parameters are in registers
  131. Revision 1.5 2002/07/26 21:15:39 florian
  132. * rewrote the system handling
  133. Revision 1.4 2002/07/20 11:57:55 florian
  134. * types.pas renamed to defbase.pas because D6 contains a types
  135. unit so this would conflicts if D6 programms are compiled
  136. + Willamette/SSE2 instructions to assembler added
  137. Revision 1.3 2002/07/13 19:38:43 florian
  138. * some more generic calling stuff fixed
  139. Revision 1.2 2002/07/13 07:17:15 jonas
  140. * fixed memory leak reported by Sergey Korshunoff
  141. Revision 1.1 2002/07/11 14:41:28 florian
  142. * start of the new generic parameter handling
  143. }