1 {
2     Copyright (c) 1998-2002 by Jonas Maebe, member of the Free Pascal
3     Development Team
4 
5     This unit contains the base of all optimizer related objects
6 
7     This program is free software; you can redistribute it and/or modify
8     it under the terms of the GNU General Public License as published by
9     the Free Software Foundation; either version 2 of the License, or
10     (at your option) any later version.
11 
12     This program is distributed in the hope that it will be useful,
13     but WITHOUT ANY WARRANTY; without even the implied warranty of
14     MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
15     GNU General Public License for more details.
16 
17     You should have received a copy of the GNU General Public License
18     along with this program; if not, write to the Free Software
19     Foundation, Inc., 675 Mass Ave, Cambridge, MA 02139, USA.
20 
21  ****************************************************************************
22 }
23 unit aoptbase;
24 
25 {$i fpcdefs.inc}
26 
27   interface
28 
29     uses
30       aasmbase,aasmcpu,aasmtai,aasmdata,
31       cpubase,
32       cgbase,
33       cgutils;
34 
35     Type
36       { the number of tai objects processed by an optimizer object since the last
37         time a register was modified                                              }
38       { size at each dimension depends on the registers of this type }
39       TInstrSinceLastMod = Array[tregistertype] of pbyte;
40 
41     { the TAopBase object implements the basic methods that most other }
42     { assembler optimizer objects require                              }
43     Type
44       TAoptBase = class
45         { processor independent methods }
46 
47         constructor create; virtual;
48         destructor destroy;override;
49         { returns true if register Reg is used by instruction p1 }
RegInInstructionnull50         Function RegInInstruction(Reg: TRegister; p1: tai): Boolean;virtual;
51         { returns true if register Reg occurs in operand op }
RegInOpnull52         Function RegInOp(Reg: TRegister; const op: toper): Boolean;
53         { returns true if register Reg is used in the reference Ref }
RegInRefnull54         Function RegInRef(Reg: TRegister; Const Ref: TReference): Boolean;
55 
RegModifiedByInstructionnull56         function RegModifiedByInstruction(Reg: TRegister; p1: tai): boolean;virtual;
57 
58         { returns true if the references are completely equal }
59         {Function RefsEqual(Const R1, R2: TReference): Boolean;}
60 
61         { gets the next tai object after current that contains info relevant }
62         { to the optimizer in p1. If there is none, it returns false and     }
63         { sets p1 to nil                                                     }
GetNextInstructionnull64         class Function GetNextInstruction(Current: tai; Var Next: tai): Boolean;
65         { gets the previous tai object after current that contains info  }
66         { relevant to the optimizer in last. If there is none, it retuns }
67         { false and sets last to nil                                     }
GetLastInstructionnull68         Function GetLastInstruction(Current: tai; Var Last: tai): Boolean;
69 
SkipEntryExitMarkernull70         function SkipEntryExitMarker(current: tai; var next: tai): boolean;
71 
72         { processor dependent methods }
73 
74         { returns the maximum width component of Reg. Only has to be }
75         { overridden for the 80x86 (afaik)                           }
RegMaxSizenull76         Function RegMaxSize(Reg: TRegister): TRegister; Virtual;
77         { returns true if Reg1 and Reg2 are of the samae width. Only has to }
78         { overridden for the 80x86 (afaik)                                  }
RegsSameSizenull79         Function RegsSameSize(Reg1, Reg2: TRegister): Boolean; Virtual;
80         { returns whether P is a load instruction (load contents from a }
81         { memory location or (register) variable into a register)       }
IsLoadMemRegnull82         Function IsLoadMemReg(p: tai): Boolean; Virtual; Abstract;
83         { returns whether P is a load constant instruction (load a constant }
84         { into a register)                                                  }
IsLoadConstRegnull85         Function IsLoadConstReg(p: tai): Boolean; Virtual; Abstract;
86         { returns whether P is a store instruction (store contents from a
87           register to a memory location or to a (register) variable)      }
IsStoreRegMemnull88         Function IsStoreRegMem(p: tai): Boolean; Virtual; Abstract;
89 
90         { create a paicpu Object that loads the contents of reg1 into reg2 }
a_load_reg_regnull91         Function a_load_reg_reg(reg1, reg2: TRegister): taicpu; Virtual; Abstract;
92 
93         { returns true if reg is used by any instruction between p1 and p2 }
RegUsedBetweennull94         Function RegUsedBetween(reg: TRegister; p1, p2: tai): Boolean;
95 
96         { returns true if reg is modified by any instruction between p1 and p2 }
RegModifiedBetweennull97         function RegModifiedBetween(reg: TRegister; p1, p2: tai): Boolean;
98 
99         { returns true if reg is loaded with a new value by hp }
RegLoadedWithNewValuenull100         function RegLoadedWithNewValue(reg: tregister; hp: tai): boolean; Virtual;
101 
102         { returns true if hp loads a value from reg }
InstructionLoadsFromRegnull103         function InstructionLoadsFromReg(const reg : TRegister; const hp : tai) : boolean; Virtual;
104 
105         { compares reg1 and reg2 having the same type and being the same super registers
106           so the register size is neglected }
SuperRegistersEqualnull107         function SuperRegistersEqual(reg1,reg2 : TRegister) : Boolean;
108     end;
109 
labelCanBeSkippednull110     function labelCanBeSkipped(p: tai_label): boolean;
111 
112   implementation
113 
114     uses
115       verbose,globals,aoptcpub;
116 
117   constructor taoptbase.create;
118     begin
119       inherited create;
120     end;
121 
122 
123   destructor taoptbase.destroy;
124     begin
125       inherited destroy;
126     end;
127 
128 
TAOptBase.RegInInstructionnull129   Function TAOptBase.RegInInstruction(Reg: TRegister; p1: tai): Boolean;
130     Var
131       Count: longint;
132     Begin
133       result:=false;
134       if p1.typ<>ait_instruction then
135         exit;
136       for Count:=0 to TInstr(p1).ops-1 do
137         if RegInOp(Reg, TInstr(p1).oper[Count]^) then
138           exit(true);
139       result:=false;
140     End;
141 
142 
TAOptBase.RegInOpnull143   Function TAOptBase.RegInOp(Reg: TRegister; const op: toper): Boolean;
144     Begin
145       Case op.typ Of
146         Top_Reg: RegInOp := SuperRegistersEqual(Reg,op.reg);
147         Top_Ref: RegInOp := RegInRef(Reg, op.ref^);
148         {$ifdef arm}
149         Top_Shifterop: RegInOp := op.shifterop^.rs = Reg;
150         Top_RegSet: RegInOp := getsupreg(Reg) in op.regset^;
151         {$endif arm}
152         Else RegInOp := False
153       End
154     End;
155 
156 
TAOptBase.RegInRefnull157   Function TAOptBase.RegInRef(Reg: TRegister; Const Ref: TReference): Boolean;
158   Begin
159     RegInRef := SuperRegistersEqual(Ref.Base,Reg)
160 {$ifdef cpurefshaveindexreg}
161     Or SuperRegistersEqual(Ref.Index,Reg)
162 {$endif cpurefshaveindexreg}
163 {$ifdef x86}
164     or (Reg=Ref.segment)
165     { if Ref.segment isn't set, the cpu uses implicitly ss or ds, depending on the base register }
166     or ((Ref.segment=NR_NO) and (
167       ((Reg=NR_SS) and (SuperRegistersEqual(Ref.base,NR_EBP) or SuperRegistersEqual(Ref.base,NR_ESP))) or
168       ((Reg=NR_DS) and not(SuperRegistersEqual(Ref.base,NR_EBP) or SuperRegistersEqual(Ref.base,NR_ESP)))
169     ))
170 {$endif x86}
171   End;
172 
TAOptBase.RegModifiedByInstructionnull173   Function TAOptBase.RegModifiedByInstruction(Reg: TRegister; p1: tai): Boolean;
174   Begin
175     Result:=true;
176   End;
177 
178 
labelCanBeSkippednull179   function labelCanBeSkipped(p: tai_label): boolean;
180   begin
181     labelCanBeSkipped := not(p.labsym.is_used) or (p.labsym.labeltype<>alt_jump);
182   end;
183 
184 
TAOptBase.GetNextInstructionnull185   class Function TAOptBase.GetNextInstruction(Current: tai; Var Next: tai): Boolean;
186   Begin
187     Repeat
188       Current := tai(Current.Next);
189       While Assigned(Current) And
190             ((Current.typ In SkipInstr) or
191 {$ifdef cpudelayslot}
192              ((Current.typ=ait_instruction) and
193               (taicpu(Current).opcode=A_NOP)
194              ) or
195 {$endif cpudelayslot}
196              ((Current.typ = ait_label) And
197               labelCanBeSkipped(Tai_Label(Current)))) Do
198         Current := tai(Current.Next);
199       If Assigned(Current) And
200          (Current.typ = ait_Marker) And
201          (Tai_Marker(Current).Kind = mark_NoPropInfoStart) Then
202         Begin
203           While Assigned(Current) And
204                 ((Current.typ <> ait_Marker) Or
205                  (Tai_Marker(Current).Kind <> mark_NoPropInfoEnd)) Do
206             Current := Tai(Current.Next);
207         End;
208     Until Not(Assigned(Current)) Or
209           (Current.typ <> ait_Marker) Or
210           (Tai_Marker(Current).Kind <> mark_NoPropInfoEnd);
211     Next := Current;
212     If Assigned(Current) And
213        Not((Current.typ In SkipInstr) or
214            ((Current.typ = ait_label) And
215             labelCanBeSkipped(Tai_Label(Current))))
216       Then GetNextInstruction := True
217       Else
218         Begin
219           Next := Nil;
220           GetNextInstruction := False;
221         End;
222   End;
223 
TAOptBase.GetLastInstructionnull224   Function TAOptBase.GetLastInstruction(Current: tai; Var Last: tai): Boolean;
225   Begin
226     Repeat
227       Current := Tai(Current.previous);
228       While Assigned(Current) And
229             (((Current.typ = ait_Marker) And
230               Not(Tai_Marker(Current).Kind in [mark_AsmBlockEnd{,mark_NoPropInfoEnd}])) or
231              (Current.typ In SkipInstr) or
232              ((Current.typ = ait_label) And
233               labelCanBeSkipped(Tai_Label(Current)))) Do
234         Current := Tai(Current.previous);
235 {      If Assigned(Current) And
236          (Current.typ = ait_Marker) And
237          (Tai_Marker(Current).Kind = mark_NoPropInfoEnd) Then
238         Begin
239           While Assigned(Current) And
240                 ((Current.typ <> ait_Marker) Or
241                  (Tai_Marker(Current).Kind <> mark_NoPropInfoStart)) Do
242             Current := Tai(Current.previous);
243         End; }
244     Until Not(Assigned(Current)) Or
245           (Current.typ <> ait_Marker) Or
246           not(tai_Marker(current).Kind in [mark_NoPropInfoStart,mark_NoPropInfoEnd]);
247     If Not(Assigned(Current)) or
248        (Current.typ In SkipInstr) or
249        ((Current.typ = ait_label) And
250         labelCanBeSkipped(Tai_Label(Current))) or
251        ((Current.typ = ait_Marker) And
252         (Tai_Marker(Current).Kind = mark_AsmBlockEnd))
253       Then
254         Begin
255           Last := Nil;
256           GetLastInstruction := False
257         End
258       Else
259         Begin
260           Last := Current;
261           GetLastInstruction := True;
262         End;
263   End;
264 
265 
TAOptBase.SkipEntryExitMarkernull266   function TAOptBase.SkipEntryExitMarker(current: tai; var next: tai): boolean;
267     begin
268       result:=true;
269       if current.typ<>ait_marker then
270         exit;
271       next:=current;
272       while GetNextInstruction(next,next) do
273         begin
274           if (next.typ<>ait_marker) or not(tai_marker(next).Kind in [mark_Position,mark_BlockStart]) then
275             exit;
276         end;
277       result:=false;
278     end;
279 
280 
TAOptBase.RegUsedBetweennull281   Function TAOptBase.RegUsedBetween(reg : TRegister;p1,p2 : tai) : Boolean;
282   Begin
283     Result:=false;
284     while assigned(p1) and assigned(p2) and GetNextInstruction(p1,p1) and (p1<>p2) do
285       if RegInInstruction(reg,p1) then
286         begin
287           Result:=true;
288           exit;
289         end;
290   end;
291 
292 
TAOptBase.RegModifiedBetweennull293   Function TAOptBase.RegModifiedBetween(reg : TRegister;p1,p2 : tai) : Boolean;
294   Begin
295     Result:=false;
296     while assigned(p1) and assigned(p2) and GetNextInstruction(p1,p1) and (p1<>p2) do
297       if RegModifiedByInstruction(reg,p1) then
298         begin
299           Result:=true;
300           exit;
301         end;
302   end;
303 
304 
TAoptBase.RegLoadedWithNewValuenull305   function TAoptBase.RegLoadedWithNewValue(reg : tregister; hp : tai) : boolean;
306     begin
307       result:=false;
308       internalerror(2016012401);
309     end;
310 
311 
TAoptBase.InstructionLoadsFromRegnull312   function TAoptBase.InstructionLoadsFromReg(const reg : TRegister; const hp : tai) : boolean;
313     begin
314       { save approximation }
315       Result:=true;
316     end;
317 
318 
TAOptBase.SuperRegistersEqualnull319   function TAOptBase.SuperRegistersEqual(reg1,reg2 : TRegister) : Boolean;
320   Begin
321     Result:=(getregtype(reg1) = getregtype(reg2)) and
322             (getsupreg(reg1) = getsupreg(Reg2));
323   end;
324 
325   { ******************* Processor dependent stuff *************************** }
326 
TAOptBase.RegMaxSizenull327   Function TAOptBase.RegMaxSize(Reg: TRegister): TRegister;
328   Begin
329     RegMaxSize := Reg
330   End;
331 
TAOptBase.RegsSameSizenull332   Function TAOptBase.RegsSameSize(Reg1, Reg2: TRegister): Boolean;
333   Begin
334     RegsSameSize := True
335   End;
336 
337 end.
338