nppcset.pas 7.5 KB

123456789101112131415161718192021222324252627282930313233343536373839404142434445464748495051525354555657585960616263646566676869707172737475767778798081828384858687888990919293949596979899100101102103104105106107108109110111112113114115116117118119120121122123124125126127128129130131132133134135136137138139140141142143144145146147148149150151152153154155156157158159160161162163164165166167168169170171172173174175176177178179180181182183184185186187188189190191192193194195196197198199200201202203204205206207208209210211212213214215216217218219220221222223224225226227228229230231232233234235236237238239
  1. {
  2. $Id$
  3. Copyright (c) 1998-2002 by Florian Klaempfl and Carl Eric Codere
  4. Generate PowerPC assembler for in set/case nodes
  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 nppcset;
  19. {$i fpcdefs.inc}
  20. interface
  21. uses
  22. node,nset,ncgset,cpubase,cginfo,cgbase,cgobj,aasmbase,aasmtai;
  23. type
  24. tppccasenode = class(tcgcasenode)
  25. protected
  26. procedure genlinearlist(hp : pcaserecord); override;
  27. end;
  28. implementation
  29. uses
  30. globtype,systems,
  31. verbose,globals,
  32. symconst,symdef,defutil,
  33. paramgr,
  34. cpuinfo,
  35. pass_2,cgcpu,
  36. ncon,
  37. cga,tgobj,ncgutil,regvars,rgobj,aasmcpu;
  38. {*****************************************************************************
  39. TCGCASENODE
  40. *****************************************************************************}
  41. procedure tppccasenode.genlinearlist(hp : pcaserecord);
  42. var
  43. first : boolean;
  44. last : TConstExprInt;
  45. resflags: tresflags;
  46. procedure genitem(t : pcaserecord);
  47. var r:Tregister;
  48. procedure gensub(value:longint);
  49. var
  50. tmpreg: tregister;
  51. begin
  52. value := -value;
  53. if (value >= low(smallint)) and
  54. (value <= high(smallint)) then
  55. exprasmlist.concat(taicpu.op_reg_reg_const(A_ADDIC_,hregister,
  56. hregister,value))
  57. else
  58. begin
  59. tmpreg := rg.getregisterint(exprasmlist,OS_INT);
  60. cg.a_load_const_reg(exprasmlist,OS_INT,aword(value),tmpreg);
  61. exprasmlist.concat(taicpu.op_reg_reg_reg(A_ADD_,hregister,
  62. hregister,tmpreg));
  63. rg.ungetregisterint(exprasmlist,tmpreg);
  64. end;
  65. end;
  66. begin
  67. if assigned(t^.less) then
  68. genitem(t^.less);
  69. { need we to test the first value }
  70. if first and (t^._low>get_min_value(left.resulttype.def)) then
  71. begin
  72. cg.a_cmp_const_reg_label(exprasmlist,OS_INT,jmp_lt,
  73. aword(t^._low),hregister,elselabel);
  74. end;
  75. if t^._low=t^._high then
  76. begin
  77. if t^._low-last=0 then
  78. exprasmlist.concat(taicpu.op_reg_reg_const(A_CMPWI,NR_CR0,
  79. hregister,0))
  80. else
  81. gensub(longint(t^._low-last));
  82. last:=t^._low;
  83. resflags.cr := RS_CR0;
  84. resflags.flag := F_EQ;
  85. cg.a_jmp_flags(exprasmlist,resflags,t^.statement);
  86. end
  87. else
  88. begin
  89. { it begins with the smallest label, if the value }
  90. { is even smaller then jump immediately to the }
  91. { ELSE-label }
  92. if first then
  93. begin
  94. { have we to ajust the first value ? }
  95. if (t^._low>get_min_value(left.resulttype.def)) then
  96. gensub(longint(t^._low));
  97. end
  98. else
  99. begin
  100. { if there is no unused label between the last and the }
  101. { present label then the lower limit can be checked }
  102. { immediately. else check the range in between: }
  103. gensub(longint(t^._low-last));
  104. if (t^._low-last) <> 1 then
  105. tcgppc(cg).a_jmp_cond(exprasmlist,jmp_lt,elselabel);
  106. end;
  107. gensub(longint(t^._high-t^._low));
  108. tcgppc(cg).a_jmp_cond(exprasmlist,jmp_le,t^.statement);
  109. last:=t^._high;
  110. end;
  111. first:=false;
  112. if assigned(t^.greater) then
  113. genitem(t^.greater);
  114. end;
  115. begin
  116. { do we need to generate cmps? }
  117. if (with_sign and (min_label<0)) or
  118. (opsize = OS_32) then
  119. genlinearcmplist(hp)
  120. else
  121. begin
  122. last:=0;
  123. first:=true;
  124. genitem(hp);
  125. cg.a_jmp_always(exprasmlist,elselabel);
  126. end;
  127. end;
  128. begin
  129. ccasenode:=tppccasenode;
  130. end.
  131. {
  132. $Log$
  133. Revision 1.9 2003-09-03 19:35:24 peter
  134. * powerpc compiles again
  135. Revision 1.8 2003/06/14 22:32:43 jonas
  136. * ppc compiles with -dnewra, haven't tried to compile anything with it
  137. yet though
  138. Revision 1.7 2003/02/19 22:00:16 daniel
  139. * Code generator converted to new register notation
  140. - Horribily outdated todo.txt removed
  141. Revision 1.6 2003/01/08 18:43:58 daniel
  142. * Tregister changed into a record
  143. Revision 1.5 2002/11/25 17:43:28 peter
  144. * splitted defbase in defutil,symutil,defcmp
  145. * merged isconvertable and is_equal into compare_defs(_ext)
  146. * made operator search faster by walking the list only once
  147. Revision 1.4 2002/10/21 18:08:05 jonas
  148. * some range errors fixed
  149. Revision 1.3 2002/09/09 13:57:45 jonas
  150. * small optimization to case genlist() case statements
  151. Revision 1.2 2002/09/08 20:14:33 jonas
  152. * use genlinearcmplist() for unsigned 32bit case statements instead
  153. of genlinearlist(), because the addic. instruction always sets the
  154. flags as if the arguments are signed 32bits (for smaller unsigned
  155. types, this doesn't matter since they fit in s32bit)
  156. Revision 1.1 2002/08/11 11:39:12 jonas
  157. + powerpc-specific genlinearlist
  158. Revision 1.13 2002/08/11 06:14:40 florian
  159. * fixed powerpc compilation problems
  160. Revision 1.12 2002/08/10 17:15:12 jonas
  161. * optimizations and bugfix
  162. Revision 1.11 2002/07/28 09:24:18 carl
  163. + generic case node
  164. Revision 1.10 2002/07/23 14:31:00 daniel
  165. * Added internal error when asked to generate code for 'if expr in []'
  166. Revision 1.9 2002/07/23 12:34:30 daniel
  167. * Readded old set code. To use it define 'oldset'. Activated by default
  168. for ppc.
  169. Revision 1.8 2002/07/22 11:48:04 daniel
  170. * Sets are now internally sets.
  171. Revision 1.7 2002/07/21 16:58:20 jonas
  172. * fixed some bugs in tcginnode.pass_2() and optimized the bit test
  173. Revision 1.6 2002/07/20 11:57:54 florian
  174. * types.pas renamed to defbase.pas because D6 contains a types
  175. unit so this would conflicts if D6 programms are compiled
  176. + Willamette/SSE2 instructions to assembler added
  177. Revision 1.5 2002/07/11 14:41:28 florian
  178. * start of the new generic parameter handling
  179. Revision 1.4 2002/07/07 10:16:29 florian
  180. * problems with last commit fixed
  181. Revision 1.3 2002/07/06 20:19:25 carl
  182. + generic set handling
  183. Revision 1.2 2002/07/01 16:23:53 peter
  184. * cg64 patch
  185. * basics for currency
  186. * asnode updates for class and interface (not finished)
  187. Revision 1.1 2002/06/16 08:14:56 carl
  188. + generic sets
  189. }