optbase.pas 5.3 KB

123456789101112131415161718192021222324252627282930313233343536373839404142434445464748495051525354555657585960616263646566676869707172737475767778798081828384858687888990919293949596979899100101102103104105106107108109110111112113114115116117118119120121122123124125126127128129130131132133134135136137138139140141142143144145146147148149150151152153154155156157158159160161162163164165166167168169170171172173174175176177178179180181182183184185186187188189190191192193194195196197198199200201202203204205206207208209210211212213214215216217
  1. {
  2. Basic node optimizer stuff
  3. Copyright (c) 2007 by Florian Klaempfl
  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. unit optbase;
  18. {$i fpcdefs.inc}
  19. interface
  20. uses
  21. globtype;
  22. type
  23. { this should maybe replaced by a spare set,
  24. using a dyn. array makes assignments cheap }
  25. tdfaset = array of byte;
  26. PDFASet = ^TDFASet;
  27. toptinfo = record
  28. { index of the current node inside the dfa sets, aword(-1) if no entry }
  29. index : aword;
  30. def : tdfaset;
  31. use : tdfaset;
  32. life : tdfaset;
  33. end;
  34. poptinfo = ^toptinfo;
  35. { basic set operations for dfa sets }
  36. { add e to s }
  37. procedure DFASetInclude(var s : tdfaset;e : integer);
  38. { add s to d }
  39. procedure DFASetIncludeSet(var d : tdfaset;const s : tdfaset);
  40. { remove e from s }
  41. procedure DFASetExclude(var s : tdfaset;e : integer);
  42. { test if s contains e }
  43. function DFASetIn(const s : tdfaset;e : integer) : boolean;
  44. { d:=s1+s2; }
  45. procedure DFASetUnion(var d : tdfaset;const s1,s2 : tdfaset);
  46. { d:=s1*s2; }
  47. procedure DFASetIntersect(var d : tdfaset;const s1,s2 : tdfaset);
  48. { d:=s1-s2; }
  49. procedure DFASetDiff(var d : tdfaset;const s1,s2 : tdfaset);
  50. { s1<>s2; }
  51. function DFASetNotEqual(const s1,s2 : tdfaset) : boolean;
  52. { output DFA set }
  53. procedure PrintDFASet(var f : text;s : TDFASet);
  54. implementation
  55. uses
  56. cutils;
  57. procedure DFASetInclude(var s : tdfaset;e : integer);
  58. var
  59. i,
  60. oldhigh,
  61. e8 : Integer;
  62. begin
  63. e8:=e div 8;
  64. if e8>high(s) then
  65. begin
  66. oldhigh:=high(s);
  67. SetLength(s,e8+1);
  68. for i:=oldhigh+1 to high(s) do
  69. s[i]:=0;
  70. end;
  71. s[e8]:=s[e8] or (1 shl (e mod 8));
  72. end;
  73. procedure DFASetIncludeSet(var d : tdfaset;const s : tdfaset);
  74. var
  75. i : integer;
  76. begin
  77. if length(s)>length(d) then
  78. SetLength(d,length(s));
  79. for i:=0 to high(s) do
  80. d[i]:=d[i] or s[i];
  81. end;
  82. procedure DFASetExclude(var s : tdfaset;e : integer);
  83. var
  84. e8 : Integer;
  85. begin
  86. e8:=e div 8;
  87. if e8>high(s) then
  88. SetLength(s,e8+1);
  89. s[e8]:=s[e8] and not(1 shl (e mod 8));
  90. end;
  91. function DFASetIn(const s : tdfaset;e : integer) : boolean;
  92. var
  93. e8 : Integer;
  94. begin
  95. result:=false;
  96. e8:=e div 8;
  97. if e8>high(s) then
  98. exit;
  99. result:=(s[e8] and (1 shl (e mod 8)))<>0;
  100. end;
  101. procedure DFASetUnion(var d : tdfaset;const s1,s2 : tdfaset);
  102. var
  103. i : integer;
  104. begin
  105. SetLength(d,max(Length(s1),Length(s2)));
  106. for i:=0 to high(s1) do
  107. d[i]:=s1[i];
  108. for i:=0 to high(s2) do
  109. d[i]:=d[i] or s2[i];
  110. end;
  111. procedure DFASetIntersect(var d : tdfaset;const s1,s2 : tdfaset);
  112. var
  113. i : integer;
  114. begin
  115. SetLength(d,min(Length(s1),Length(s2)));
  116. for i:=0 to min(high(s1),high(s2)) do
  117. d[i]:=s1[i] and s2[i];
  118. end;
  119. procedure DFASetDiff(var d : tdfaset;const s1,s2 : tdfaset);
  120. var
  121. i : integer;
  122. begin
  123. SetLength(d,length(s1));
  124. for i:=0 to high(d) do
  125. if i>high(s2) then
  126. d[i]:=s1[i]
  127. else
  128. d[i]:=s1[i] and not(s2[i]);
  129. end;
  130. function DFASetNotEqual(const s1,s2 : tdfaset) : boolean;
  131. var
  132. i : integer;
  133. begin
  134. result:=true;
  135. { one set could be larger than the other }
  136. if length(s1)>length(s2) then
  137. begin
  138. for i:=0 to high(s2) do
  139. if s1[i]<>s2[i] then
  140. exit;
  141. { check remaining part being zero }
  142. for i:=length(s2) to high(s1) do
  143. if s1[i]<>0 then
  144. exit;
  145. end
  146. else
  147. begin
  148. for i:=0 to high(s1) do
  149. if s1[i]<>s2[i] then
  150. exit;
  151. { check remaining part being zero }
  152. for i:=length(s1) to high(s2) do
  153. if s2[i]<>0 then
  154. exit;
  155. end;
  156. result:=false;
  157. end;
  158. procedure PrintDFASet(var f : text;s : TDFASet);
  159. var
  160. i : integer;
  161. first : boolean;
  162. begin
  163. first:=true;
  164. for i:=0 to Length(s)*8 do
  165. begin
  166. if DFASetIn(s,i) then
  167. begin
  168. if not(first) then
  169. write(f,',');
  170. write(f,i);
  171. first:=false;
  172. end;
  173. end;
  174. end;
  175. end.