mirror of
				https://gitlab.com/freepascal.org/fpc/source.git
				synced 2025-10-31 22:11:12 +01:00 
			
		
		
		
	
		
			
				
	
	
		
			258 lines
		
	
	
		
			8.1 KiB
		
	
	
	
		
			ObjectPascal
		
	
	
	
	
	
			
		
		
	
	
			258 lines
		
	
	
		
			8.1 KiB
		
	
	
	
		
			ObjectPascal
		
	
	
	
	
	
| {
 | |
|     $Id$
 | |
|     Copyright (c) 1998-2002 by Jonas Maebe, member of the Free Pascal
 | |
|     Development Team
 | |
| 
 | |
|     This unit contains the interface routines between the code generator
 | |
|     and the optimizer.
 | |
| 
 | |
|     This program is free software; you can redistribute it and/or modify
 | |
|     it under the terms of the GNU General Public License as published by
 | |
|     the Free Software Foundation; either version 2 of the License, or
 | |
|     (at your option) any later version.
 | |
| 
 | |
|     This program is distributed in the hope that it will be useful,
 | |
|     but WITHOUT ANY WARRANTY; without even the implied warranty of
 | |
|     MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
 | |
|     GNU General Public License for more details.
 | |
| 
 | |
|     You should have received a copy of the GNU General Public License
 | |
|     along with this program; if not, write to the Free Software
 | |
|     Foundation, Inc., 675 Mass Ave, Cambridge, MA 02139, USA.
 | |
| 
 | |
|  ****************************************************************************
 | |
| }
 | |
| Unit aopt;
 | |
| 
 | |
| Interface
 | |
| 
 | |
| Uses Aasmbase,aasmtai,aasmcpu, cobjects, aoptobj, aoptcpud, aoptcpub {aoptcs, aoptpeep} ;
 | |
| 
 | |
| Type
 | |
|   PAsmOptimizer = ^TAsmOptimizer;
 | |
|   TAsmOptimizer = Object(TAoptObj)
 | |
| 
 | |
|     { _AsmL is the PAasmOutpout list that has to be optimized }
 | |
|     Constructor Init(_AsmL: PAasmOutput);
 | |
| 
 | |
|     { call the necessary optimizer procedures }
 | |
|     Procedure Optimize;
 | |
|     Destructor Done;
 | |
| 
 | |
|     private
 | |
| 
 | |
|     Function FindLoHiLabels: Pai;
 | |
|     Procedure BuildLabelTableAndFixRegAlloc;
 | |
| 
 | |
|   End;
 | |
| 
 | |
| procedure Optimize(AsmL:Paasmoutput);
 | |
| 
 | |
| 
 | |
| Implementation
 | |
| 
 | |
| uses cpuinfo, globtype, globals;
 | |
| 
 | |
| Constructor TAsmOptimizer.Init(_AsmL: PAasmOutput);
 | |
| Begin
 | |
|   AsmL := _AsmL;
 | |
| {setup labeltable, always necessary}
 | |
|   New(LabelInfo);
 | |
|   LabelInfo^.LowLabel := High(AWord);
 | |
|   LabelInfo^.HighLabel := 0;
 | |
|   LabelInfo^.LabelDif := 0;
 | |
| End;
 | |
| 
 | |
| Function TAsmOptimizer.FindLoHiLabels: Pai;
 | |
| { Walks through the paasmlist to find the lowest and highest label number.  }
 | |
| { Returns the last Pai object of the current block                          }
 | |
| Var LabelFound: Boolean;
 | |
|     P: Pai;
 | |
| Begin
 | |
|   LabelFound := False;
 | |
|   P := BlockStart;
 | |
|   With LabelInfo^ Do
 | |
|     Begin
 | |
|       While Assigned(P) And
 | |
|             ((P^.typ <> Ait_Marker) Or
 | |
|              (Pai_Marker(P)^.Kind <> AsmBlockStart)) Do
 | |
|         Begin
 | |
|           If (Pai(p)^.typ = ait_label) Then
 | |
|             If (Pai_Label(p)^.l^.is_used) Then
 | |
|               Begin
 | |
|                 LabelFound := True;
 | |
|                 If (Pai_Label(p)^.l^.labelnr < LowLabel) Then
 | |
|                   LowLabel := Pai_Label(p)^.l^.labelnr;
 | |
|                 If (Pai_Label(p)^.l^.labelnr > HighLabel) Then
 | |
|                   HighLabel := Pai_Label(p)^.l^.labelnr
 | |
|               End;
 | |
|           GetNextInstruction(p, p)
 | |
|         End;
 | |
|       FindLoHiLabels := p;
 | |
|       If LabelFound
 | |
|         Then LabelDif := HighLabel-LowLabel+1
 | |
|         Else LabelDif := 0
 | |
|     End
 | |
| End;
 | |
| 
 | |
| Procedure TAsmOptimizer.BuildLabelTableAndFixRegAlloc;
 | |
| { Builds a table with the locations of the labels in the paasmoutput.       }
 | |
| { Also fixes some RegDeallocs like "# %eax released; push (%eax)"           }
 | |
| Var p, hp1, hp2: Pai;
 | |
|     UsedRegs: TRegSet;
 | |
| Begin
 | |
|   UsedRegs := [];
 | |
|   With LabelInfo^ Do
 | |
|     If (LabelDif <> 0) Then
 | |
|       Begin
 | |
|         GetMem(LabelTable, LabelDif*SizeOf(TLabelTableItem));
 | |
|         FillChar(LabelTable^, LabelDif*SizeOf(TLabelTableItem), 0);
 | |
|         p := BlockStart;
 | |
|         While (P <> BlockEnd) Do
 | |
|           Begin
 | |
|             Case p^.typ Of
 | |
|               ait_Label:
 | |
|                 If Pai_Label(p)^.l^.is_used Then
 | |
|                   LabelTable^[Pai_Label(p)^.l^.labelnr-LowLabel].PaiObj := p;
 | |
|               ait_regAlloc:
 | |
|                 begin
 | |
|                   if PairegAlloc(p)^.Allocation then
 | |
|                     Begin
 | |
|                       If Not(PaiRegAlloc(p)^.Reg in UsedRegs) Then
 | |
|                         UsedRegs := UsedRegs + [PaiRegAlloc(p)^.Reg]
 | |
|                       Else
 | |
|                         Begin
 | |
|                           hp1 := p;
 | |
|                           hp2 := nil;
 | |
|                           While GetLastInstruction(hp1, hp1) And
 | |
|                                 Not(RegInInstruction(PaiRegAlloc(p)^.Reg, hp1)) Do
 | |
|                             hp2 := hp1;
 | |
|                           If hp2 <> nil Then
 | |
|                             Begin
 | |
|                               hp1 := New(PaiRegAlloc, DeAlloc(PaiRegAlloc(p)^.Reg));
 | |
|                               InsertLLItem(Pai(hp2^.previous), hp2, hp1);
 | |
|                             End;
 | |
|                         End;
 | |
|                     End
 | |
|                   else
 | |
|                     Begin
 | |
|                       UsedRegs := UsedRegs - [PaiRegAlloc(p)^.Reg];
 | |
|                       hp1 := p;
 | |
|                       hp2 := nil;
 | |
|                       While Not(FindRegAlloc(PaiRegAlloc(p)^.Reg, Pai(hp1^.Next))) And
 | |
|                             GetNextInstruction(hp1, hp1) And
 | |
|                             RegInInstruction(PaiRegAlloc(p)^.Reg, hp1) Do
 | |
|                         hp2 := hp1;
 | |
|                       If hp2 <> nil Then
 | |
|                         Begin
 | |
|                           hp1 := Pai(p^.previous);
 | |
|                           AsmL^.Remove(p);
 | |
|                           InsertLLItem(hp2, Pai(hp2^.Next), p);
 | |
|                           p := hp1;
 | |
|                         End
 | |
|                     End
 | |
|                 End
 | |
|             End
 | |
|           End;
 | |
|         P := Pai(p^.Next);
 | |
|         While Assigned(p) And
 | |
|               (p^.typ in (SkipInstr - [ait_regalloc])) Do
 | |
|           P := Pai(P^.Next)
 | |
|       End
 | |
| End;
 | |
| 
 | |
| 
 | |
| 
 | |
| Procedure TAsmOptimizer.Optimize;
 | |
| Var HP: Pai;
 | |
|     DFA: PAOptDFACpu;
 | |
| Begin
 | |
|   BlockStart := Pai(AsmL^.First);
 | |
|   While Assigned(BlockStart) Do
 | |
|     Begin
 | |
|       { Initialize BlockEnd and the LabelInfo (low and high label) }
 | |
|       BlockEnd := FindLoHiLabels;
 | |
|       { initialize the LabelInfo (labeltable) and fix the regalloc info }
 | |
|       BuildLabelTableAndFixRegAlloc;
 | |
|       { peephole optimizations, twice because you can't do them all in one }
 | |
|       { pass                                                               }
 | |
| {      PeepHoleOptPass1;
 | |
|       PeepHoleOptPass1;}
 | |
|       If (cs_slowoptimize in aktglobalswitches) Then
 | |
|         Begin
 | |
|           New(DFA,Init(AsmL,BlockStart,BlockEnd,LabelInfo));
 | |
|           { data flow analyzer }
 | |
|           DFA^.DoDFA;
 | |
|           { common subexpression elimination }
 | |
| {          CSE;}
 | |
|         End;
 | |
|       { more peephole optimizations }
 | |
| {      PeepHoleOptPass2;}
 | |
|       {dispose labeltabel}
 | |
|       If Assigned(LabelInfo^.LabelTable) Then
 | |
|         Begin
 | |
|           Dispose(LabelInfo^.LabelTable);
 | |
|           LabelInfo := Nil
 | |
|         End;
 | |
|       { continue where we left off, BlockEnd is either the start of an }
 | |
|       { assembler block or nil}
 | |
|       BlockStart := BlockEnd;
 | |
|       While Assigned(BlockStart) And
 | |
|             (BlockStart^.typ = ait_Marker) And
 | |
|             (Pai_Marker(BlockStart)^.Kind = AsmBlockStart) Do
 | |
|         Begin
 | |
|          { we stopped at an assembler block, so skip it }
 | |
|           While GetNextInstruction(BlockStart, BlockStart) And
 | |
|                 ((BlockStart^.Typ <> Ait_Marker) Or
 | |
|                  (Pai_Marker(Blockstart)^.Kind <> AsmBlockEnd)) Do;
 | |
|          { blockstart now contains a pai_marker(asmblockend) }
 | |
|           If Not(GetNextInstruction(BlockStart, HP) And
 | |
|                  ((HP^.typ <> ait_Marker) Or
 | |
|                   (Pai_Marker(HP)^.Kind <> AsmBlockStart)
 | |
|                  )
 | |
|                 ) Then
 | |
|            {skip the next assembler block }
 | |
|            BlockStart := HP;
 | |
|          { otherwise there is no assembler block anymore after the current }
 | |
|          { one, so optimize the next block of "normal" instructions        }
 | |
|         End
 | |
|     End;
 | |
| End;
 | |
| 
 | |
| Destructor TAsmOptimizer.Done;
 | |
| Begin
 | |
|   Dispose(LabelInfo)
 | |
| End;
 | |
| 
 | |
| 
 | |
| procedure Optimize(AsmL:Paasmoutput);
 | |
| var
 | |
|   p : PAsmOptimizer;
 | |
| begin
 | |
|   new(p,Init(AsmL));
 | |
|   p^.Optimize;
 | |
|   dispose(p,Done);
 | |
| end;
 | |
| 
 | |
| 
 | |
| End.
 | |
| 
 | |
| {Virtual methods, most have to be overridden by processor dependent methods}
 | |
| 
 | |
| {
 | |
|  $Log$
 | |
|  Revision 1.5  2002-07-01 18:46:21  peter
 | |
|    * internal linker
 | |
|    * reorganized aasm layer
 | |
| 
 | |
|  Revision 1.4  2002/05/18 13:34:05  peter
 | |
|    * readded missing revisions
 | |
| 
 | |
|  Revision 1.3  2002/05/16 19:46:34  carl
 | |
|  + defines.inc -> fpcdefs.inc to avoid conflicts if compiling by hand
 | |
|  + try to fix temp allocation (still in ifdef)
 | |
|  + generic constructor calls
 | |
|  + start of tassembler / tmodulebase class cleanup
 | |
| 
 | |
| }
 | 
