fpc/compiler/new/aoptda.pas
1999-08-09 14:07:22 +00:00

487 lines
20 KiB
ObjectPascal

{
$Id$
Copyright (c) 1999 by Jonas Maebe, member of the Free Pascal
Development Team
This unit contains the assembler optimizer data flow analyzer.
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 aoptda;
Interface
uses Aasm, TAoptObj, TAoptCpu;
Type TAsmDFA = Object(TAoptCpu)
{ uses the same constructor as TAoptCpu = constructor from TAoptObj }
Destructor Done;
private
{ How many instructions are between the current instruction and the }
{ last one that modified the register }
NrOfInstrSinceLastMod: TInstrSinceLastMod;
Procedure BuildLabelTableAndFixRegAlloc;
Function FindLoHiLabels(BlockStart: Pai): Pai;
End;
Implementation
uses aoptmsc
{$ifdef i386}
, ao386msc
{$endif i386}
;
Destructor TAsmDFA.Done;
Begin
End;
Procedure TAsmOptimizer.DoDFAPass2;
{ Analyzes the Data Flow of an assembler list. Analyses the reg contents }
{ for the instructions between blockstart and blockend. Returns the last pai }
{ which has been processed }
Var
CurProp: PPaiProp;
Cnt, InstrCnt : Longint;
InstrProp: TAsmInstrucProp;
UsedRegs: TRegSet;
p, hp, NewBlockStart : Pai;
TmpRef: TReference;
TmpReg: TRegister;
{$ifdef AnalyzeLoops}
TmpState: Byte;
{$endif AnalyzeLoops}
Begin
p := BlockStart;
UsedRegs.init;
UsedRegs.Update(p);
NewBlockStart := SkipHead(p);
InstrCnt := 1;
{ done implicitely by the constructor
FillChar(NrOfInstrSinceLastMod, SizeOf(NrOfInstrSinceLastMod), 0); }
While (P <> BlockEnd) Do
Begin
CurProp := New(PPaiProp, init);
If (p <> NewBlockStart)
Then
Begin
{$ifdef JumpAnal}
If (p^.Typ <> ait_label) Then
{$endif JumpAnal}
Begin
GetLastInstruction(p, hp);
CurProp^.Regs := PPaiProp(hp^.OptInfo)^.Regs;
CurProp^.CondRegs.Flags :=
PPaiProp(hp^.OptInfo)^.CondRegs.Flags;
End
End;
CurProp^.UsedRegs.InitWithValue(UsedRegs.GetUsedRegs);
{ CurProp^.CanBeRemoved := False;}
UsedRegs.Update(Pai(p^.Next)));
PPaiProp(p^.OptInfo) := CurProp;
For TmpReg := R_EAX To R_EDI Do
Inc(NrOfInstrSinceLastMod[TmpReg]);
Case p^.typ Of
ait_label:
{$Ifndef JumpAnal}
If (Pai_label(p)^.l^.is_used) Then
CurProp^.DestroyAllRegs;
{$Else JumpAnal}
Begin
If (Pai_Label(p)^.is_used) Then
With LTable^[Pai_Label(p)^.l^.labelnr-LoLab] Do
{$IfDef AnalyzeLoops}
If (RefsFound = Pai_Label(p)^.l^.RefCount)
{$Else AnalyzeLoops}
If (JmpsProcessed = Pai_Label(p)^.l^.RefCount)
{$EndIf AnalyzeLoops}
Then
{all jumps to this label have been found}
{$IfDef AnalyzeLoops}
If (JmpsProcessed > 0)
Then
{$EndIf AnalyzeLoops}
{we've processed at least one jump to this label}
Begin
If (GetLastInstruction(p, hp) And
Not(((hp^.typ = ait_instruction)) And
(pai386_labeled(hp)^.is_jmp))
Then
{previous instruction not a JMP -> the contents of the registers after the
previous intruction has been executed have to be taken into account as well}
For TmpReg := R_EAX to R_EDI Do
Begin
If (CurProp^.Regs[TmpReg].WState <>
PPaiProp(hp^.OptInfo)^.Regs[TmpReg].WState)
Then DestroyReg(CurProp, TmpReg)
End
End
{$IfDef AnalyzeLoops}
Else
{a label from a backward jump (e.g. a loop), no jump to this label has
already been processed}
If GetLastInstruction(p, hp) And
Not(hp^.typ = ait_instruction) And
(pai386_labeled(hp)^.opcode = A_JMP))
Then
{previous instruction not a jmp, so keep all the registers' contents from the
previous instruction}
Begin
CurProp^.Regs := PPaiProp(hp^.OptInfo)^.Regs;
CurProp^.DirFlag := PPaiProp(hp^.OptInfo)^.DirFlag;
End
Else
{previous instruction a jmp and no jump to this label processed yet}
Begin
hp := p;
Cnt := InstrCnt;
{continue until we find a jump to the label or a label which has already
been processed}
While GetNextInstruction(hp, hp) And
Not((hp^.typ = ait_instruction) And
(pai386(hp)^.is_jmp) and
(pasmlabel(pai386(hp)^.oper[0].sym)^.labelnr = Pai_Label(p)^.l^.labelnr)) And
Not((hp^.typ = ait_label) And
(LTable^[Pai_Label(hp)^.l^.labelnr-LoLab].RefsFound
= Pai_Label(hp)^.l^.RefCount) And
(LTable^[Pai_Label(hp)^.l^.labelnr-LoLab].JmpsProcessed > 0)) Do
Inc(Cnt);
If (hp^.typ = ait_label)
Then
{there's a processed label after the current one}
Begin
CurProp^.Regs := PaiPropBlock^[Cnt].Regs;
CurProp^.DirFlag := PaiPropBlock^[Cnt].DirFlag;
End
Else
{there's no label anymore after the current one, or they haven't been
processed yet}
Begin
GetLastInstruction(p, hp);
CurProp^.Regs := PPaiProp(hp^.OptInfo)^.Regs;
CurProp^.DirFlag := PPaiProp(hp^.OptInfo)^.DirFlag;
DestroyAllRegs(PPaiProp(hp^.OptInfo))
End
End
{$EndIf AnalyzeLoops}
Else
{not all references to this label have been found, so destroy all registers}
Begin
GetLastInstruction(p, hp);
CurProp^.Regs := PPaiProp(hp^.OptInfo)^.Regs;
CurProp^.DirFlag := PPaiProp(hp^.OptInfo)^.DirFlag;
DestroyAllRegs(CurProp)
End;
End;
{$EndIf JumpAnal}
{$ifdef GDB}
ait_stabs, ait_stabn, ait_stab_function_name:;
{$endif GDB}
ait_instruction:
Begin
if pai386(p)^.is_jmp then
begin
{$IfNDef JumpAnal}
;
{$Else JumpAnal}
With LTable^[pasmlabel(pai386(p)^.oper[0].sym)^.labelnr-LoLab] Do
If (RefsFound = pasmlabel(pai386(p)^.oper[0].sym)^.RefCount) Then
Begin
If (InstrCnt < InstrNr)
Then
{forward jump}
If (JmpsProcessed = 0) Then
{no jump to this label has been processed yet}
Begin
PaiPropBlock^[InstrNr].Regs := CurProp^.Regs;
PaiPropBlock^[InstrNr].DirFlag := CurProp^.DirFlag;
Inc(JmpsProcessed);
End
Else
Begin
For TmpReg := R_EAX to R_EDI Do
If (PaiPropBlock^[InstrNr].Regs[TmpReg].WState <>
CurProp^.Regs[TmpReg].WState) Then
DestroyReg(@PaiPropBlock^[InstrNr], TmpReg);
Inc(JmpsProcessed);
End
{$ifdef AnalyzeLoops}
Else
{ backward jump, a loop for example}
{ If (JmpsProcessed > 0) Or
Not(GetLastInstruction(PaiObj, hp) And
(hp^.typ = ait_labeled_instruction) And
(pai386_labeled(hp)^.opcode = A_JMP))
Then}
{instruction prior to label is not a jmp, or at least one jump to the label
has yet been processed}
Begin
Inc(JmpsProcessed);
For TmpReg := R_EAX to R_EDI Do
If (PaiPropBlock^[InstrNr].Regs[TmpReg].WState <>
CurProp^.Regs[TmpReg].WState)
Then
Begin
TmpState := PaiPropBlock^[InstrNr].Regs[TmpReg].WState;
Cnt := InstrNr;
While (TmpState = PaiPropBlock^[Cnt].Regs[TmpReg].WState) Do
Begin
DestroyReg(@PaiPropBlock^[Cnt], TmpReg);
Inc(Cnt);
End;
While (Cnt <= InstrCnt) Do
Begin
Inc(PaiPropBlock^[Cnt].Regs[TmpReg].WState);
Inc(Cnt)
End
End;
End
{ Else }
{instruction prior to label is a jmp and no jumps to the label have yet been
processed}
{ Begin
Inc(JmpsProcessed);
For TmpReg := R_EAX to R_EDI Do
Begin
TmpState := PaiPropBlock^[InstrNr].Regs[TmpReg].WState;
Cnt := InstrNr;
While (TmpState = PaiPropBlock^[Cnt].Regs[TmpReg].WState) Do
Begin
PaiPropBlock^[Cnt].Regs[TmpReg] := CurProp^.Regs[TmpReg];
Inc(Cnt);
End;
TmpState := PaiPropBlock^[InstrNr].Regs[TmpReg].WState;
While (TmpState = PaiPropBlock^[Cnt].Regs[TmpReg].WState) Do
Begin
DestroyReg(@PaiPropBlock^[Cnt], TmpReg);
Inc(Cnt);
End;
While (Cnt <= InstrCnt) Do
Begin
Inc(PaiPropBlock^[Cnt].Regs[TmpReg].WState);
Inc(Cnt)
End
End
End}
{$endif AnalyzeLoops}
End;
{$EndIf JumpAnal}
end
else
begin
InstrProp := AsmInstr[PInstr(p)^.opcode];
If IsStoreInstr(p) Then
Begin
CurProp^.ReadReg(PInstr(p)^.oper[StoreSrc].reg);
CurProp^.ReadRef(PInstr(p)^.oper[StoreDst].ref);
CurProp^.DestroyRefs(PInstr(p)^.oper[StoreDst].ref^,
PInstr(p)^.oper[StoreSrc].reg);
End
Else If IsLoadInstr(p) Then
Begin
CurProp^.ReadRef(PInstr(p)^.oper[LoadSrc].ref);
CurProp^.ReadReg(PInstr(p)^.oper[LoadDst].reg);
TmpReg := RegMaxSize(PInstr(p)^.oper[1].reg);
If RegInRef(TmpReg, Pai386(p)^.oper[0].ref^) And
(CurProp^.Regs[TmpReg].Typ = Con_Ref)
Then
Begin
With CurProp^.Regs[TmpReg] Do
Begin
IncState(WState);
{also store how many instructions are part of the sequence in the first
instructions PPaiProp, so it can be easily accessed from within
CheckSequence}
Inc(NrOfMods, NrOfInstrSinceLastMod[TmpReg]);
PPaiProp(Pai(StartMod)^.OptInfo)^.Regs[TmpReg].NrOfMods := NrOfMods;
NrOfInstrSinceLastMod[TmpReg] := 0;
End;
End
Else
Begin
DestroyReg(CurProp, TmpReg);
If Not(RegInRef(TmpReg, Pai386(p)^.oper[0].ref^)) Then
With CurProp^.Regs[TmpReg] Do
Begin
Typ := Con_Ref;
StartMod := p;
NrOfMods := 1;
End
End;
{$ifdef StateDebug}
hp := new(pai_asm_comment,init(strpnew(att_reg2str[TmpReg]+': '+tostr(CurProp^.Regs[TmpReg].WState))));
InsertLLItem(AsmL, p, p^.next, hp);
{$endif StateDebug}
End;
Top_Const:
Begin
Case Pai386(p)^.oper[1].typ Of
Top_Reg:
Begin
TmpReg := Reg32(Pai386(p)^.oper[1].reg);
With CurProp^.Regs[TmpReg] Do
Begin
DestroyReg(CurProp, TmpReg);
typ := Con_Const;
StartMod := p;
End
End;
Top_Ref:
Begin
ReadRef(CurProp, Pai386(p)^.oper[1].ref);
DestroyRefs(P, Pai386(p)^.oper[1].ref^, R_NO);
End;
End;
End;
End;
End;
A_IMUL:
Begin
ReadOp(CurProp, Pai386(p)^.oper[0]);
ReadOp(CurProp, Pai386(p)^.oper[1]);
If (Pai386(p)^.oper[2].typ = top_none) Then
If (Pai386(p)^.oper[1].typ = top_none) Then
Begin
DestroyReg(CurProp, R_EAX);
DestroyReg(CurProp, R_EDX)
End
Else
{$ifdef arithopt}
AddInstr2OpContents(Pai386(p), Pai386(p)^.oper[1])
{$else arithopt}
DestroyOp(p, Pai386(p)^.oper[1])
{$endif arithopt}
Else
{$ifdef arithopt}
AddInstr2OpContents(Pai386(p), Pai386(p)^.oper[2]);
{$else arithopt}
DestroyOp(p, Pai386(p)^.oper[2]);
{$endif arithopt}
End;
A_XOR:
Begin
ReadOp(CurProp, Pai386(p)^.oper[0]);
ReadOp(CurProp, Pai386(p)^.oper[1]);
If (Pai386(p)^.oper[0].typ = top_reg) And
(Pai386(p)^.oper[1].typ = top_reg) And
(Pai386(p)^.oper[0].reg = Pai386(p)^.oper[1].reg)
Then
Begin
DestroyReg(CurProp, Pai386(p)^.oper[0].reg);
CurProp^.Regs[Reg32(Pai386(p)^.oper[0].reg)].typ := Con_Const;
CurProp^.Regs[Reg32(Pai386(p)^.oper[0].reg)].StartMod := Pointer(0)
End
Else
DestroyOp(p, Pai386(p)^.oper[1]);
End
Else
Begin
Cnt := 1;
While (Cnt <= MaxCh) And
(InstrProp.Ch[Cnt] <> C_None) Do
Begin
Case InstrProp.Ch[Cnt] Of
C_REAX..C_REDI: ReadReg(CurProp,TCh2Reg(InstrProp.Ch[Cnt]));
C_WEAX..C_RWEDI:
Begin
If (InstrProp.Ch[Cnt] >= C_RWEAX) Then
ReadReg(CurProp, TCh2Reg(InstrProp.Ch[Cnt]));
DestroyReg(CurProp, TCh2Reg(InstrProp.Ch[Cnt]));
End;
{$ifdef arithopt}
C_MEAX..C_MEDI:
AddInstr2RegContents({$ifdef statedebug} asml, {$endif}
Pai386(p),
TCh2Reg(InstrProp.Ch[Cnt]));
{$endif arithopt}
C_CDirFlag: CurProp^.DirFlag := F_NotSet;
C_SDirFlag: CurProp^.DirFlag := F_Set;
C_Rop1: ReadOp(CurProp, Pai386(p)^.oper[0]);
C_Rop2: ReadOp(CurProp, Pai386(p)^.oper[1]);
C_ROp3: ReadOp(CurProp, Pai386(p)^.oper[2]);
C_Wop1..C_RWop1:
Begin
If (InstrProp.Ch[Cnt] in [C_RWop1]) Then
ReadOp(CurProp, Pai386(p)^.oper[0]);
DestroyOp(p, Pai386(p)^.oper[0]);
End;
{$ifdef arithopt}
C_Mop1:
AddInstr2OpContents({$ifdef statedebug} asml, {$endif}
Pai386(p), Pai386(p)^.oper[0]);
{$endif arithopt}
C_Wop2..C_RWop2:
Begin
If (InstrProp.Ch[Cnt] = C_RWop2) Then
ReadOp(CurProp, Pai386(p)^.oper[1]);
DestroyOp(p, Pai386(p)^.oper[1]);
End;
{$ifdef arithopt}
C_Mop2:
AddInstr2OpContents({$ifdef statedebug} asml, {$endif}
Pai386(p), Pai386(p)^.oper[1]);
{$endif arithopt}
C_WOp3..C_RWOp3:
Begin
If (InstrProp.Ch[Cnt] = C_RWOp3) Then
ReadOp(CurProp, Pai386(p)^.oper[2]);
DestroyOp(p, Pai386(p)^.oper[2]);
End;
{$ifdef arithopt}
C_Mop3:
AddInstr2OpContents({$ifdef statedebug} asml, {$endif}
Pai386(p), Pai386(p)^.oper[2]);
{$endif arithopt}
C_WMemEDI:
Begin
ReadReg(CurProp, R_EDI);
FillChar(TmpRef, SizeOf(TmpRef), 0);
TmpRef.Base := R_EDI;
DestroyRefs(p, TmpRef, R_NO)
End;
C_RFlags, C_WFlags, C_RWFlags, C_FPU:
Else
Begin
DestroyAllRegs(CurProp);
End;
End;
Inc(Cnt);
End
End;
end;
End;
End
Else
Begin
DestroyAllRegs(CurProp);
End;
End;
Inc(InstrCnt);
GetNextInstruction(p, p);
End;
End;
End.