1 {
2     Helper routines for the optimizer
3 
4     Copyright (c) 2007 by Florian Klaempfl
5 
6     This program is free software; you can redistribute it and/or modify
7     it under the terms of the GNU General Public License as published by
8     the Free Software Foundation; either version 2 of the License, or
9     (at your option) any later version.
10 
11     This program is distributed in the hope that it will be useful,
12     but WITHOUT ANY WARRANTY; without even the implied warranty of
13     MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
14     GNU General Public License for more details.
15 
16     You should have received a copy of the GNU General Public License
17     along with this program; if not, write to the Free Software
18     Foundation, Inc., 675 Mass Ave, Cambridge, MA 02139, USA.
19 
20  ****************************************************************************
21 }
22 unit optutils;
23 
24 {$i fpcdefs.inc}
25 
26   interface
27 
28     uses
29       cclasses,
30       node,
31       globtype;
32 
33     type
34       { this implementation should be really improved,
35         its purpose is to find equal nodes }
36       TIndexedNodeSet = class(TFPList)
Addnull37         function Add(node : tnode) : boolean;
Includesnull38         function Includes(node : tnode) : tnode;
Removenull39         function Remove(node : tnode) : boolean;
40       end;
41 
42     procedure SetNodeSucessors(p,last : tnode);
43     procedure PrintDFAInfo(var f : text;p : tnode);
44     procedure PrintIndexedNodeSet(var f : text;s : TIndexedNodeSet);
45     { determines the optinfo.defsum field for the given node
46       this field contains a sum of all expressions defined by
47       all child expressions reachable through p
48     }
49     procedure CalcDefSum(p : tnode);
50 
51     { calculates/estimates the field execution weight of optinfo }
52     procedure CalcExecutionWeights(p : tnode;Initial : longint = 100);
53 
54     { returns true, if n is a valid node and has life info }
has_life_infonull55     function has_life_info(n : tnode) : boolean;
56 
57   implementation
58 
59     uses
60       cutils,
61       verbose,
62       optbase,
63       ncal,nbas,nflw,nutils,nset,ncon;
64 
TIndexedNodeSet.Addnull65     function TIndexedNodeSet.Add(node : tnode) : boolean;
66       var
67         i : Integer;
68         p : tnode;
69       begin
70         node.allocoptinfo;
71         p:=Includes(node);
72         if assigned(p) then
73           begin
74             result:=false;
75             node.optinfo^.index:=p.optinfo^.index;
76           end
77         else
78           begin
79             i:=inherited Add(node);
80             node.optinfo^.index:=i;
81             result:=true;
82           end
83       end;
84 
85 
TIndexedNodeSet.Includesnull86     function TIndexedNodeSet.Includes(node : tnode) : tnode;
87       var
88         i : longint;
89       begin
90         for i:=0 to Count-1 do
91           if tnode(List^[i]).isequal(node) then
92             begin
93               result:=tnode(List^[i]);
94               exit;
95             end;
96         result:=nil;
97       end;
98 
99 
TIndexedNodeSet.Removenull100     function TIndexedNodeSet.Remove(node : tnode) : boolean;
101       var
102         p : tnode;
103       begin
104         result:=false;
105         p:=Includes(node);
106         if assigned(p) then
107           begin
108             if inherited Remove(p)<>-1 then
109               result:=true;
110           end;
111       end;
112 
113 
114     procedure PrintIndexedNodeSet(var f : text;s : TIndexedNodeSet);
115       var
116         i : integer;
117       begin
118         for i:=0 to s.count-1 do
119           begin
120             writeln(f,'=============================== Node ',i,' ===============================');
121             printnode(f,tnode(s[i]));
122             writeln(f);
123           end;
124       end;
125 
126 
PrintNodeDFAnull127     function PrintNodeDFA(var n: tnode; arg: pointer): foreachnoderesult;
128       begin
129         if assigned(n.optinfo) and ((n.optinfo^.life<>nil) or (n.optinfo^.use<>nil) or (n.optinfo^.def<>nil)) then
130           begin
131             write(text(arg^),nodetype2str[n.nodetype],'(',n.fileinfo.line,',',n.fileinfo.column,') Life: ');
132             PrintDFASet(text(arg^),n.optinfo^.life);
133             write(text(arg^),' Def: ');
134             PrintDFASet(text(arg^),n.optinfo^.def);
135             write(text(arg^),' Use: ');
136             PrintDFASet(text(arg^),n.optinfo^.use);
137             if assigned(n.successor) then
138               write(text(arg^),' Successor: ',nodetype2str[n.successor.nodetype],'(',n.successor.fileinfo.line,',',n.successor.fileinfo.column,')')
139             else
140               write(text(arg^),' Successor: nil');
141             write(text(arg^),' DefSum: ');
142             PrintDFASet(text(arg^),n.optinfo^.defsum);
143             writeln(text(arg^));
144           end;
145         result:=fen_false;
146       end;
147 
148 
149     procedure PrintDFAInfo(var f : text;p : tnode);
150       begin
151         foreachnodestatic(pm_postprocess,p,@PrintNodeDFA,@f);
152       end;
153 
154 
155     procedure SetNodeSucessors(p,last : tnode);
156       var
157         Continuestack : TFPList;
158         Breakstack : TFPList;
159       { sets the successor nodes of a node tree block
160         returns the first node of the tree if it's a controll flow node }
DoSetnull161       function DoSet(p : tnode;succ : tnode) : tnode;
162         var
163           hp1,hp2 : tnode;
164           i : longint;
165         begin
166           result:=nil;
167           if p=nil then
168             exit;
169           case p.nodetype of
170             statementn:
171               begin
172                 hp1:=p;
173                 result:=p;
174                 while assigned(hp1) do
175                   begin
176                     { does another statement follow? }
177                     if assigned(tstatementnode(hp1).next) then
178                       begin
179                         hp2:=DoSet(tstatementnode(hp1).statement,tstatementnode(hp1).next);
180                         if assigned(hp2) then
181                           tstatementnode(hp1).successor:=hp2
182                         else
183                           tstatementnode(hp1).successor:=tstatementnode(hp1).next;
184                       end
185                     else
186                       begin
187                         hp2:=DoSet(tstatementnode(hp1).statement,succ);
188                         if assigned(hp2) then
189                           tstatementnode(hp1).successor:=hp2
190                         else
191                           tstatementnode(hp1).successor:=succ;
192                       end;
193                     hp1:=tstatementnode(hp1).next;
194                   end;
195               end;
196             blockn:
197               begin
198                 result:=p;
199                 DoSet(tblocknode(p).statements,succ);
200                 if assigned(tblocknode(p).statements) then
201                   p.successor:=tblocknode(p).statements
202                 else
203                   p.successor:=succ;
204               end;
205             forn:
206               begin
207                 Breakstack.Add(succ);
208                 Continuestack.Add(p);
209                 result:=p;
210                 { the successor of the last node of the for body is the dummy loop iteration node
211                   it allows the dfa to inject needed life information into the loop }
212                 tfornode(p).loopiteration:=cnothingnode.create;
213 
214                 DoSet(tfornode(p).t2,tfornode(p).loopiteration);
215                 p.successor:=succ;
216                 Breakstack.Delete(Breakstack.Count-1);
217                 Continuestack.Delete(Continuestack.Count-1);
218               end;
219             breakn:
220               begin
221                 result:=p;
222                 p.successor:=tnode(Breakstack.Last);
223               end;
224             continuen:
225               begin
226                 result:=p;
227                 p.successor:=tnode(Continuestack.Last);
228               end;
229             whilerepeatn:
230               begin
231                 Breakstack.Add(succ);
232                 Continuestack.Add(p);
233                 result:=p;
234                 { the successor of the last node of the while/repeat body is the while node itself }
235                 DoSet(twhilerepeatnode(p).right,p);
236 
237                 p.successor:=succ;
238 
239                 { special case: we do not do a dyn. dfa, but we should handle endless loops }
240                 if is_constboolnode(twhilerepeatnode(p).left) then
241                   begin
242                     if ((lnf_testatbegin in twhilerepeatnode(p).loopflags) and
243                       getbooleanvalue(twhilerepeatnode(p).left)) or (not(lnf_testatbegin in twhilerepeatnode(p).loopflags) and
244                       not(getbooleanvalue(twhilerepeatnode(p).left))) then
245                       p.successor:=nil;
246                   end;
247 
248                 Breakstack.Delete(Breakstack.Count-1);
249                 Continuestack.Delete(Continuestack.Count-1);
250               end;
251             ifn:
252               begin
253                 result:=p;
254                 DoSet(tifnode(p).right,succ);
255                 DoSet(tifnode(p).t1,succ);
256                 p.successor:=succ;
257               end;
258             labeln:
259               begin
260                 result:=p;
261                 if assigned(tlabelnode(p).left) then
262                   begin
263                     DoSet(tlabelnode(p).left,succ);
264                     p.successor:=tlabelnode(p).left;
265                   end
266                 else
267                   p.successor:=succ;
268               end;
269             assignn:
270               begin
271                 result:=p;
272                 p.successor:=succ;
273               end;
274             goton:
275               begin
276                 result:=p;
277                 if not(assigned(tgotonode(p).labelnode)) then
278                   internalerror(2007050701);
279                 p.successor:=tgotonode(p).labelnode;
280               end;
281             exitn:
282               begin
283                 result:=p;
284                 p.successor:=nil;
285               end;
286             casen:
287               begin
288                 result:=p;
289                 DoSet(tcasenode(p).elseblock,succ);
290                 for i:=0 to tcasenode(p).blocks.count-1 do
291                   DoSet(pcaseblock(tcasenode(p).blocks[i])^.statement,succ);
292                 p.successor:=succ;
293               end;
294             calln:
295               begin
296                 { not sure if this is enough (FK) }
297                 result:=p;
298                 if not(cnf_call_never_returns in tcallnode(p).callnodeflags) then
299                   p.successor:=succ;
300               end;
301             inlinen:
302               begin
303                 { not sure if this is enough (FK) }
304                 result:=p;
305                 p.successor:=succ;
306               end;
307             loadn,
308             tempcreaten,
309             tempdeleten,
310             nothingn:
311                begin
312                 result:=p;
313                 p.successor:=succ;
314               end;
315             raisen:
316               begin
317                 result:=p;
318                 { raise never returns }
319                 p.successor:=nil;
320               end;
321             tryexceptn,
322             tryfinallyn,
323             onn:
324               internalerror(2007050501);
325           end;
326         end;
327 
328       begin
329         Breakstack:=TFPList.Create;
330         Continuestack:=TFPList.Create;
331         DoSet(p,last);
332         Continuestack.Free;
333         Breakstack.Free;
334       end;
335 
336     var
337       sum : TDFASet;
338 
adddefnull339     function adddef(var n: tnode; arg: pointer): foreachnoderesult;
340       begin
341         if assigned(n.optinfo) then
342           DFASetIncludeSet(sum,n.optinfo^.def);
343         Result:=fen_false;
344       end;
345 
346 
347     procedure CalcDefSum(p : tnode);
348       begin
349         p.allocoptinfo;
350         if not assigned(p.optinfo^.defsum) then
351           begin
352             sum:=nil;
353             foreachnodestatic(pm_postprocess,p,@adddef,nil);
354             p.optinfo^.defsum:=sum;
355           end;
356       end;
357 
358 
SetExecutionWeightnull359     function SetExecutionWeight(var n: tnode; arg: pointer): foreachnoderesult;
360       var
361         Weight : longint;
362         i : Integer;
363       begin
364         Result:=fen_false;
365         n.allocoptinfo;
366         Weight:=max(plongint(arg)^,1);
367         case n.nodetype of
368           casen:
369             begin
370               CalcExecutionWeights(tcasenode(n).left,Weight);
371               for i:=0 to tcasenode(n).blocks.count-1 do
372                 CalcExecutionWeights(pcaseblock(tcasenode(n).blocks[i])^.statement,max(1,Weight div case_count_labels(tcasenode(n).labels)));
373 
374               CalcExecutionWeights(tcasenode(n).elseblock,max(1,Weight div case_count_labels(tcasenode(n).labels)));
375               Result:=fen_norecurse_false;
376             end;
377           whilerepeatn:
378             begin
379               CalcExecutionWeights(twhilerepeatnode(n).right,max(Weight,1)*8);
380               CalcExecutionWeights(twhilerepeatnode(n).left,max(Weight,1)*8);
381               Result:=fen_norecurse_false;
382             end;
383           ifn:
384             begin
385               CalcExecutionWeights(tifnode(n).left,Weight);
386               CalcExecutionWeights(tifnode(n).right,max(Weight div 2,1));
387               CalcExecutionWeights(tifnode(n).t1,max(Weight div 2,1));
388               Result:=fen_norecurse_false;
389             end;
390           else
391             n.optinfo^.executionweight:=weight;
392         end;
393       end;
394 
395 
396     procedure CalcExecutionWeights(p : tnode;Initial : longint = 100);
397       begin
398         if assigned(p) then
399           foreachnodestatic(pm_postprocess,p,@SetExecutionWeight,Pointer(@Initial));
400       end;
401 
402 
has_life_infonull403     function has_life_info(n : tnode) : boolean;
404       begin
405         result:=assigned(n) and assigned(n.optinfo) and
406           assigned(n.optinfo^.life);
407       end;
408 
409 end.
410 
411