nppcset.pas 7.3 KB

123456789101112131415161718192021222324252627282930313233343536373839404142434445464748495051525354555657585960616263646566676869707172737475767778798081828384858687888990919293949596979899100101102103104105106107108109110111112113114115116117118119120121122123124125126127128129130131132133134135136137138139140141142143144145146147148149150151152153154155156157158159160161162163164165166167168169170171172173174175176177178179180181182183184185186187188189190191192193194195196197198199200201202203204205206207208209210211212213214215216217218219220221222223224225226227228229230231232233
  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 := cg.get_scratch_reg_int(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. cg.free_scratch_reg(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. r.enum:=R_CR0;
  78. if t^._low-last=0 then
  79. exprasmlist.concat(taicpu.op_reg_reg_const(A_CMPWI,r,
  80. hregister,0))
  81. else
  82. gensub(longint(t^._low-last));
  83. last:=t^._low;
  84. resflags.cr := R_CR0;
  85. resflags.flag := F_EQ;
  86. cg.a_jmp_flags(exprasmlist,resflags,t^.statement);
  87. end
  88. else
  89. begin
  90. { it begins with the smallest label, if the value }
  91. { is even smaller then jump immediately to the }
  92. { ELSE-label }
  93. if first then
  94. begin
  95. { have we to ajust the first value ? }
  96. if (t^._low>get_min_value(left.resulttype.def)) then
  97. gensub(longint(t^._low));
  98. end
  99. else
  100. begin
  101. { if there is no unused label between the last and the }
  102. { present label then the lower limit can be checked }
  103. { immediately. else check the range in between: }
  104. gensub(longint(t^._low-last));
  105. if (t^._low-last) <> 1 then
  106. tcgppc(cg).a_jmp_cond(exprasmlist,jmp_lt,elselabel);
  107. end;
  108. gensub(longint(t^._high-t^._low));
  109. tcgppc(cg).a_jmp_cond(exprasmlist,jmp_le,t^.statement);
  110. last:=t^._high;
  111. end;
  112. first:=false;
  113. if assigned(t^.greater) then
  114. genitem(t^.greater);
  115. end;
  116. begin
  117. { do we need to generate cmps? }
  118. if (with_sign and (min_label<0)) or
  119. (opsize = OS_32) then
  120. genlinearcmplist(hp)
  121. else
  122. begin
  123. last:=0;
  124. first:=true;
  125. genitem(hp);
  126. cg.a_jmp_always(exprasmlist,elselabel);
  127. end;
  128. end;
  129. begin
  130. ccasenode:=tppccasenode;
  131. end.
  132. {
  133. $Log$
  134. Revision 1.7 2003-02-19 22:00:16 daniel
  135. * Code generator converted to new register notation
  136. - Horribily outdated todo.txt removed
  137. Revision 1.6 2003/01/08 18:43:58 daniel
  138. * Tregister changed into a record
  139. Revision 1.5 2002/11/25 17:43:28 peter
  140. * splitted defbase in defutil,symutil,defcmp
  141. * merged isconvertable and is_equal into compare_defs(_ext)
  142. * made operator search faster by walking the list only once
  143. Revision 1.4 2002/10/21 18:08:05 jonas
  144. * some range errors fixed
  145. Revision 1.3 2002/09/09 13:57:45 jonas
  146. * small optimization to case genlist() case statements
  147. Revision 1.2 2002/09/08 20:14:33 jonas
  148. * use genlinearcmplist() for unsigned 32bit case statements instead
  149. of genlinearlist(), because the addic. instruction always sets the
  150. flags as if the arguments are signed 32bits (for smaller unsigned
  151. types, this doesn't matter since they fit in s32bit)
  152. Revision 1.1 2002/08/11 11:39:12 jonas
  153. + powerpc-specific genlinearlist
  154. Revision 1.13 2002/08/11 06:14:40 florian
  155. * fixed powerpc compilation problems
  156. Revision 1.12 2002/08/10 17:15:12 jonas
  157. * optimizations and bugfix
  158. Revision 1.11 2002/07/28 09:24:18 carl
  159. + generic case node
  160. Revision 1.10 2002/07/23 14:31:00 daniel
  161. * Added internal error when asked to generate code for 'if expr in []'
  162. Revision 1.9 2002/07/23 12:34:30 daniel
  163. * Readded old set code. To use it define 'oldset'. Activated by default
  164. for ppc.
  165. Revision 1.8 2002/07/22 11:48:04 daniel
  166. * Sets are now internally sets.
  167. Revision 1.7 2002/07/21 16:58:20 jonas
  168. * fixed some bugs in tcginnode.pass_2() and optimized the bit test
  169. Revision 1.6 2002/07/20 11:57:54 florian
  170. * types.pas renamed to defbase.pas because D6 contains a types
  171. unit so this would conflicts if D6 programms are compiled
  172. + Willamette/SSE2 instructions to assembler added
  173. Revision 1.5 2002/07/11 14:41:28 florian
  174. * start of the new generic parameter handling
  175. Revision 1.4 2002/07/07 10:16:29 florian
  176. * problems with last commit fixed
  177. Revision 1.3 2002/07/06 20:19:25 carl
  178. + generic set handling
  179. Revision 1.2 2002/07/01 16:23:53 peter
  180. * cg64 patch
  181. * basics for currency
  182. * asnode updates for class and interface (not finished)
  183. Revision 1.1 2002/06/16 08:14:56 carl
  184. + generic sets
  185. }