tainst.pas 7.8 KB

123456789101112131415161718192021222324252627282930313233343536373839404142434445464748495051525354555657585960616263646566676869707172737475767778798081828384858687888990919293949596979899100101102103104105106107108109110111112113114115116117118119120121122123124125126127128129130131132133134135136137138139140141142143144145146147148149150151152153154155156157158159160161162163164165166167168169170171172173174175176177178179180181182183184185186187188189190191192193194195196197198199200201202203204205206207208209210211212213214215216217218219220221222223224225226227228229230231232233234235236237238239240241242243244245246247248249250251252253254255256257258259260261262263264265266267268269270271272273274275276277278279280281282283284285286287288289290291292293
  1. {
  2. $Id$
  3. Copyright (c) 1998-2000 by Michael Van Canneyt
  4. Contains a generic assembler instruction object;
  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. Unit tainst;
  19. {$i defines.inc}
  20. interface
  21. Uses aasm,cpubase,cpuinfo,cclasses;
  22. Type
  23. tairegalloc = class(tai)
  24. allocation : boolean;
  25. reg : tregister;
  26. constructor alloc(r : tregister);
  27. constructor dealloc(r : tregister);
  28. end;
  29. tainstruction = class(tai)
  30. condition : TAsmCond;
  31. ops : longint;
  32. oper : array[0..max_operands-1] of toper;
  33. opcode : tasmop;
  34. {$ifdef i386}
  35. segprefix : tregister;
  36. {$endif i386}
  37. is_jmp : boolean; { is this instruction a jump? (needed for optimizer) }
  38. Constructor Create(op : tasmop);
  39. Destructor Destroy;override;
  40. function getcopy:tlinkedlistitem;override;
  41. procedure loadconst(opidx:longint;l:aword);
  42. procedure loadsymbol(opidx:longint;s:tasmsymbol;sofs:longint);
  43. procedure loadref(opidx:longint;const r:treference);
  44. procedure loadreg(opidx:longint;r:tregister);
  45. procedure loadoper(opidx:longint;o:toper);
  46. procedure SetCondition(const c:TAsmCond);
  47. end;
  48. implementation
  49. {*****************************************************************************
  50. TaiRegAlloc
  51. *****************************************************************************}
  52. constructor tairegalloc.alloc(r : tregister);
  53. begin
  54. inherited create;
  55. typ:=ait_regalloc;
  56. allocation:=true;
  57. reg:=r;
  58. end;
  59. constructor tairegalloc.dealloc(r : tregister);
  60. begin
  61. inherited create;
  62. typ:=ait_regalloc;
  63. allocation:=false;
  64. reg:=r;
  65. end;
  66. { ---------------------------------------------------------------------
  67. TaInstruction Constructor/Destructor
  68. ---------------------------------------------------------------------}
  69. constructor Tainstruction.Create(op : tasmop);
  70. begin
  71. inherited create;
  72. typ:=ait_instruction;
  73. is_jmp:=false;
  74. opcode:=op;
  75. ops:=0;
  76. fillchar(condition,sizeof(condition),0);
  77. fillchar(oper,sizeof(oper),0);
  78. end;
  79. destructor Tainstruction.Destroy;
  80. var
  81. i : longint;
  82. begin
  83. for i:=0 to ops-1 do
  84. case oper[i].typ of
  85. top_ref:
  86. dispose(oper[i].ref);
  87. top_symbol:
  88. dec(tasmsymbol(oper[i].sym).refs);
  89. end;
  90. inherited destroy;
  91. end;
  92. { ---------------------------------------------------------------------
  93. Loading of operands.
  94. ---------------------------------------------------------------------}
  95. procedure tainstruction.loadconst(opidx:longint;l:aword);
  96. begin
  97. if opidx>=ops then
  98. ops:=opidx+1;
  99. with oper[opidx] do
  100. begin
  101. if typ=top_ref then
  102. dispose(ref);
  103. val:=l;
  104. typ:=top_const;
  105. end;
  106. end;
  107. procedure tainstruction.loadsymbol(opidx:longint;s:tasmsymbol;sofs:longint);
  108. begin
  109. if opidx>=ops then
  110. ops:=opidx+1;
  111. with oper[opidx] do
  112. begin
  113. if typ=top_ref then
  114. dispose(ref);
  115. sym:=s;
  116. symofs:=sofs;
  117. typ:=top_symbol;
  118. end;
  119. { Mark the symbol as used }
  120. if assigned(s) then
  121. inc(s.refs);
  122. end;
  123. procedure tainstruction.loadref(opidx:longint;const r:treference);
  124. begin
  125. if opidx>=ops then
  126. ops:=opidx+1;
  127. with oper[opidx] do
  128. begin
  129. if typ<>top_ref then
  130. new(ref);
  131. ref^:=r;
  132. {$ifdef i386}
  133. { We allow this exception for i386, since overloading this would be
  134. too much of a a speed penalty}
  135. if not(ref^.segment in [R_DS,R_NO]) then
  136. segprefix:=ref^.segment;
  137. {$endif}
  138. typ:=top_ref;
  139. { mark symbol as used }
  140. if assigned(ref^.symbol) then
  141. inc(ref^.symbol.refs);
  142. end;
  143. end;
  144. procedure tainstruction.loadreg(opidx:longint;r:tregister);
  145. begin
  146. if opidx>=ops then
  147. ops:=opidx+1;
  148. with oper[opidx] do
  149. begin
  150. if typ=top_ref then
  151. dispose(ref);
  152. reg:=r;
  153. typ:=top_reg;
  154. end;
  155. end;
  156. procedure tainstruction.loadoper(opidx:longint;o:toper);
  157. begin
  158. if opidx>=ops then
  159. ops:=opidx+1;
  160. if oper[opidx].typ=top_ref then
  161. dispose(oper[opidx].ref);
  162. oper[opidx]:=o;
  163. { copy also the reference }
  164. if oper[opidx].typ=top_ref then
  165. begin
  166. new(oper[opidx].ref);
  167. oper[opidx].ref^:=o.ref^;
  168. end;
  169. end;
  170. { ---------------------------------------------------------------------
  171. Miscellaneous methods.
  172. ---------------------------------------------------------------------}
  173. procedure tainstruction.SetCondition(const c:TAsmCond);
  174. begin
  175. condition:=c;
  176. end;
  177. Function tainstruction.getcopy:tlinkedlistitem;
  178. var
  179. i : longint;
  180. p : tlinkedlistitem;
  181. begin
  182. p:=inherited getcopy;
  183. { make a copy of the references }
  184. for i:=1 to ops do
  185. if (tainstruction(p).oper[i-1].typ=top_ref) then
  186. begin
  187. new(tainstruction(p).oper[i-1].ref);
  188. tainstruction(p).oper[i-1].ref^:=oper[i-1].ref^;
  189. end;
  190. getcopy:=p;
  191. end;
  192. end.
  193. {
  194. $Log$
  195. Revision 1.4 2002-04-02 17:11:32 peter
  196. * tlocation,treference update
  197. * LOC_CONSTANT added for better constant handling
  198. * secondadd splitted in multiple routines
  199. * location_force_reg added for loading a location to a register
  200. of a specified size
  201. * secondassignment parses now first the right and then the left node
  202. (this is compatible with Kylix). This saves a lot of push/pop especially
  203. with string operations
  204. * adapted some routines to use the new cg methods
  205. Revision 1.3 2001/12/29 16:29:08 jonas
  206. * fixed stupid copy-paste bug
  207. Revision 1.2 2001/12/29 15:28:57 jonas
  208. * powerpc/cgcpu.pas compiles :)
  209. * several powerpc-related fixes
  210. * cpuasm unit is now based on common tainst unit
  211. + nppcmat unit for powerpc (almost complete)
  212. Revision 1.1 2001/08/26 13:36:52 florian
  213. * some cg reorganisation
  214. * some PPC updates
  215. Revision 1.1 2000/07/13 06:30:08 michael
  216. + Initial import
  217. Revision 1.6 2000/01/07 01:14:54 peter
  218. * updated copyright to 2000
  219. Revision 1.5 1999/09/10 18:48:11 florian
  220. * some bug fixes (e.g. must_be_valid and procinfo.funcret_is_valid)
  221. * most things for stored properties fixed
  222. Revision 1.4 1999/09/03 13:10:11 jonas
  223. * condition is now zeroed using fillchar
  224. because on powerpc it's a record now
  225. Revision 1.3 1999/08/26 14:52:59 jonas
  226. * added segprefix field for i386 in tainstruction object
  227. Revision 1.2 1999/08/06 16:38:37 jonas
  228. * declared getcopy virtual, since it's already declared as such
  229. in cobjects.pas (FPC doesn't error on that, TP does)
  230. Revision 1.1 1999/08/06 16:04:05 michael
  231. + introduced tainstruction
  232. }