1234567891011121314151617181920212223242526272829303132333435363738394041424344454647484950515253545556575859606162636465666768697071727374757677787980818283848586878889909192939495969798991001011021031041051061071081091101111121131141151161171181191201211221231241251261271281291301311321331341351361371381391401411421431441451461471481491501511521531541551561571581591601611621631641651661671681691701711721731741751761771781791801811821831841851861871881891901911921931941951961971981992002012022032042052062072082092102112122132142152162172182192202212222232242252262272282292302312322332342352362372382392402412422432442452462472482492502512522532542552562572582592602612622632642652662672682692702712722732742752762772782792802812822832842852862872882892902912922932942952962972982993003013023033043053063073083093103113123133143153163173183193203213223233243253263273283293303313323333343353363373383393403413423433443453463473483493503513523533543553563573583593603613623633643653663673683693703713723733743753763773783793803813823833843853863873883893903913923933943953963973983994004014024034044054064074084094104114124134144154164174184194204214224234244254264274284294304314324334344354364374384394404414424434444454464474484494504514524534544554564574584594604614624634644654664674684694704714724734744754764774784794804814824834844854864874884894904914924934944954964974984995005015025035045055065075085095105115125135145155165175185195205215225235245255265275285295305315325335345355365375385395405415425435445455465475485495505515525535545555565575585595605615625635645655665675685695705715725735745755765775785795805815825835845855865875885895905915925935945955965975985996006016026036046056066076086096106116126136146156166176186196206216226236246256266276286296306316326336346356366376386396406416426436446456466476486496506516526536546556566576586596606616626636646656666676686696706716726736746756766776786796806816826836846856866876886896906916926936946956966976986997007017027037047057067077087097107117127137147157167177187197207217227237247257267277287297307317327337347357367377387397407417427437447457467477487497507517527537547557567577587597607617627637647657667677687697707717727737747757767777787797807817827837847857867877887897907917927937947957967977987998008018028038048058068078088098108118128138148158168178188198208218228238248258268278288298308318328338348358368378388398408418428438448458468478488498508518528538548558568578588598608618628638648658668678688698708718728738748758768778788798808818828838848858868878888898908918928938948958968978988999009019029039049059069079089099109119129139149159169179189199209219229239249259269279289299309319329339349359369379389399409419429439449459469479489499509519529539549559569579589599609619629639649659669679689699709719729739749759769779789799809819829839849859869879889899909919929939949959969979989991000100110021003100410051006100710081009101010111012101310141015101610171018101910201021102210231024102510261027102810291030103110321033103410351036103710381039104010411042104310441045104610471048104910501051105210531054105510561057105810591060106110621063106410651066106710681069107010711072107310741075107610771078107910801081108210831084108510861087108810891090109110921093109410951096109710981099110011011102110311041105110611071108110911101111111211131114111511161117111811191120112111221123112411251126112711281129113011311132113311341135113611371138113911401141 |
- {
- Copyright (c) 1998-2004 by Jonas Maebe, member of the Free Pascal
- Development Team
- This unit contains the processor independent assembler optimizer
- object, base for the dataflow analyzer, peepholeoptimizer and
- common subexpression elimination objects.
- 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 AoptObj;
- {$i fpcdefs.inc}
- { general, processor independent objects for use by the assembler optimizer }
- Interface
- uses
- globtype,
- aasmbase,aasmcpu,aasmtai,aasmdata,
- cclasses,
- cgbase,cgutils,
- cpubase,
- aoptbase,aoptcpub,aoptda;
- { ************************************************************************* }
- { ********************************* Constants ***************************** }
- { ************************************************************************* }
- Const
- {Possible register content types}
- con_Unknown = 0;
- con_ref = 1;
- con_const = 2;
- {***************** Types ****************}
- Type
- { ************************************************************************* }
- { ************************* Some general type definitions ***************** }
- { ************************************************************************* }
- TRefCompare = Function(const r1, r2: TReference): Boolean;
- //!!! FIXME
- TRegArray = Array[byte] of tsuperregister;
- TRegSet = Set of byte;
- { possible actions on an operand: read, write or modify (= read & write) }
- TOpAction = (OpAct_Read, OpAct_Write, OpAct_Modify, OpAct_Unknown);
- { ************************************************************************* }
- { * Object to hold information on which regiters are in use and which not * }
- { ************************************************************************* }
- TUsedRegs = class
- Constructor create;
- Constructor create_regset(Const _RegSet: TRegSet);
- Destructor Destroy;override;
- { update the info with the pairegalloc objects coming after }
- { p }
- Procedure Update(p: Tai);
- { is Reg currently in use }
- Function IsUsed(Reg: TRegister): Boolean;
- { get all the currently used registers }
- Function GetUsedRegs: TRegSet;
- Private
- UsedRegs: TRegSet;
- End;
- { ************************************************************************* }
- { ******************* Contents of the integer registers ******************* }
- { ************************************************************************* }
- { size of the integer that holds the state number of a register. Can be any }
- { integer type, so it can be changed to reduce the size of the TContent }
- { structure or to improve alignment }
- TStateInt = Byte;
- TContent = Record
- { start and end of block instructions that defines the }
- { content of this register. If Typ = con_const, then }
- { Longint(StartMod) = value of the constant) }
- StartMod: Tai;
- { starts at 0, gets increased everytime the register is }
- { written to }
- WState: TStateInt;
- { starts at 0, gets increased everytime the register is read }
- { from }
- RState: TStateInt;
- { how many instructions starting with StarMod does the block }
- { consist of }
- NrOfMods: Byte;
- { the type of the content of the register: unknown, memory }
- { (variable) or constant }
- Typ: Byte;
- End;
- //!!! FIXME
- TRegContent = Array[byte] Of TContent;
- { ************************************************************************** }
- { information object with the contents of every register. Every Tai object }
- { gets one of these assigned: a pointer to it is stored in the OptInfo field }
- { ************************************************************************** }
- TPaiProp = class(TAoptBaseCpu)
- Regs: TRegContent;
- { info about allocation of general purpose integer registers }
- UsedRegs: TUsedRegs;
- { can this instruction be removed? }
- CanBeRemoved: Boolean;
- Constructor create; reintroduce;
- { checks the whole sequence of which (so regs[which].StartMod and and }
- { the next NrOfMods Tai objects) to see whether Reg is used somewhere, }
- { without it being loaded with something else first }
- Function RegInSequence(Reg, which: TRegister): Boolean;
- { destroy the contents of a register, as well as those whose contents }
- { are based on those of that register }
- Procedure DestroyReg(Reg: TRegister; var InstrSinceLastMod:
- TInstrSinceLastMod);
- { if the contents of WhichReg (can be R_NO in case of a constant) are }
- { written to memory at the location Ref, the contents of the registers }
- { that depend on Ref have to be destroyed }
- Procedure DestroyRefs(Const Ref: TReference; WhichReg: TRegister; var
- InstrSinceLastMod: TInstrSinceLastMod);
- { an instruction reads from operand o }
- Procedure ReadOp(const o:toper);
- { an instruction reads from reference Ref }
- Procedure ReadRef(Ref: PReference);
- { an instruction reads from register Reg }
- Procedure ReadReg(Reg: TRegister);
- { an instruction writes/modifies operand o and this has special }
- { side-effects or modifies the contents in such a way that we can't }
- { simply add this instruction to the sequence of instructions that }
- { describe the contents of the operand, so destroy it }
- Procedure DestroyOp(const o:Toper; var InstrSinceLastMod:
- TInstrSinceLastMod);
- { destroy the contents of all registers }
- Procedure DestroyAllRegs(var InstrSinceLastMod: TInstrSinceLastMod);
- { a register's contents are modified, but not destroyed (the new value }
- { depends on the old one) }
- Procedure ModifyReg(reg: TRegister; var InstrSinceLastMod:
- TInstrSinceLastMod);
- { an operand's contents are modified, but not destroyed (the new value }
- { depends on the old one) }
- Procedure ModifyOp(const oper: TOper; var InstrSinceLastMod:
- TInstrSinceLastMod);
- { increase the write state of a register (call every time a register is }
- { written to) }
- Procedure IncWState(Reg: TRegister);
- { increase the read state of a register (call every time a register is }
- { read from) }
- Procedure IncRState(Reg: TRegister);
- { get the write state of a register }
- Function GetWState(Reg: TRegister): TStateInt;
- { get the read state of a register }
- Function GetRState(Reg: TRegister): TStateInt;
- { get the type of contents of a register }
- Function GetRegContentType(Reg: TRegister): Byte;
- Destructor Done;
- Private
- Procedure IncState(var s: TStateInt);
- { returns whether the reference Ref is used somewhere in the loading }
- { sequence Content }
- Function RefInSequence(Const Ref: TReference; Content: TContent;
- RefsEq: TRefCompare): Boolean;
- { returns whether the instruction P reads from and/or writes }
- { to Reg }
- Function RefInInstruction(Const Ref: TReference; p: Tai;
- RefsEq: TRefCompare): Boolean;
- { returns whether two references with at least one pointing to an array }
- { may point to the same memory location }
- End;
- { ************************************************************************* }
- { ************************ Label information ****************************** }
- { ************************************************************************* }
- TLabelTableItem = Record
- PaiObj: Tai;
- End;
- TLabelTable = Array[0..2500000] Of TLabelTableItem;
- PLabelTable = ^TLabelTable;
- PLabelInfo = ^TLabelInfo;
- TLabelInfo = Record
- { the highest and lowest label number occurring in the current code }
- { fragment }
- LowLabel, HighLabel: AWord;
- LabelDif: AWord;
- { table that contains the addresses of the Pai_Label objects associated
- with each label number }
- LabelTable: PLabelTable;
- End;
- { ************************************************************************* }
- { ********** General optimizer object, used to derive others from ********* }
- { ************************************************************************* }
- TAOptObj = class(TAoptBaseCpu)
- { the PAasmOutput list this optimizer instance works on }
- AsmL: TAsmList;
- { The labelinfo record contains the addresses of the Tai objects }
- { that are labels, how many labels there are and the min and max }
- { label numbers }
- LabelInfo: PLabelInfo;
- { Start and end of the block that is currently being optimized }
- BlockStart, BlockEnd: Tai;
- DFA: TAOptDFA;
- { _AsmL is the PAasmOutpout list that has to be optimized, }
- { _BlockStart and _BlockEnd the start and the end of the block }
- { that has to be optimized and _LabelInfo a pointer to a }
- { TLabelInfo record }
- Constructor create(_AsmL: TAsmList; _BlockStart, _BlockEnd: Tai;
- _LabelInfo: PLabelInfo); virtual; reintroduce;
- { processor independent methods }
- { returns true if the label L is found between hp and the next }
- { instruction }
- Function FindLabel(L: TasmLabel; Var hp: Tai): Boolean;
- { inserts new_one between prev and foll in AsmL }
- Procedure InsertLLItem(prev, foll, new_one: TLinkedListItem);
- { If P is a Tai object releveant to the optimizer, P is returned
- If it is not relevant tot he optimizer, the first object after P
- that is relevant is returned }
- Function SkipHead(P: Tai): Tai;
- { returns true if the operands o1 and o2 are completely equal }
- Function OpsEqual(const o1,o2:toper): Boolean;
- { Returns true if a ait_alloc object for Reg is found in the block
- of Tai's starting with StartPai and ending with the next "real"
- instruction }
- Function FindRegAlloc(Reg: TRegister; StartPai: Tai): Boolean;
- { traces sucessive jumps to their final destination and sets it, e.g.
- je l1 je l3
- <code> <code>
- l1: becomes l1:
- je l2 je l3
- <code> <code>
- l2: l2:
- jmp l3 jmp l3
- the level parameter denotes how deeep we have already followed the jump,
- to avoid endless loops with constructs such as "l5: ; jmp l5" }
- function GetFinalDestination(hp: taicpu; level: longint): boolean;
- function getlabelwithsym(sym: tasmlabel): tai;
- { peephole optimizer }
- procedure PrePeepHoleOpts;
- procedure PeepHoleOptPass1;
- procedure PeepHoleOptPass2; virtual;
- procedure PostPeepHoleOpts;
- { processor dependent methods }
- // if it returns true, perform a "continue"
- function PeepHoleOptPass1Cpu(var p: tai): boolean; virtual;
- function PostPeepHoleOptsCpu(var p: tai): boolean; virtual;
- End;
- Function ArrayRefsEq(const r1, r2: TReference): Boolean;
- { ***************************** Implementation **************************** }
- Implementation
- uses
- globals,
- verbose,
- procinfo;
- { ************************************************************************* }
- { ******************************** TUsedRegs ****************************** }
- { ************************************************************************* }
- Constructor TUsedRegs.create;
- Begin
- UsedRegs := [];
- End;
- Constructor TUsedRegs.create_regset(Const _RegSet: TRegSet);
- Begin
- UsedRegs := _RegSet;
- End;
- Procedure TUsedRegs.Update(p: Tai);
- {updates UsedRegs with the RegAlloc Information coming after P}
- Begin
- Repeat
- While Assigned(p) And
- ((p.typ in (SkipInstr - [ait_RegAlloc])) or
- ((p.typ = ait_label) And
- Not(Tai_Label(p).labsym.is_used))) Do
- p := Tai(p.next);
- While Assigned(p) And
- (p.typ=ait_RegAlloc) Do
- Begin
- {!!!!!!!! FIXME
- if tai_regalloc(p).ratype=ra_alloc then
- UsedRegs := UsedRegs + [tai_regalloc(p).Reg]
- else
- UsedRegs := UsedRegs - [tai_regalloc(p).Reg];
- p := Tai(p.next);
- }
- End;
- Until Not(Assigned(p)) Or
- (Not(p.typ in SkipInstr) And
- Not((p.typ = ait_label) And
- Not(Tai_Label(p).labsym.is_used)));
- End;
- Function TUsedRegs.IsUsed(Reg: TRegister): Boolean;
- Begin
- //!!!!!!!!!!! IsUsed := Reg in UsedRegs
- End;
- Function TUsedRegs.GetUsedRegs: TRegSet;
- Begin
- GetUsedRegs := UsedRegs;
- End;
- Destructor TUsedRegs.Destroy;
- Begin
- inherited destroy;
- end;
- { ************************************************************************* }
- { **************************** TPaiProp *********************************** }
- { ************************************************************************* }
- Constructor TPaiProp.Create;
- Begin
- {!!!!!!
- UsedRegs.Init;
- CondRegs.init;
- }
- { DirFlag: TFlagContents; I386 specific}
- End;
- Function TPaiProp.RegInSequence(Reg, which: TRegister): Boolean;
- Var p: Tai;
- RegsChecked: TRegSet;
- content: TContent;
- Counter: Byte;
- TmpResult: Boolean;
- Begin
- {!!!!!!!!!!1
- RegsChecked := [];
- content := regs[which];
- p := content.StartMod;
- TmpResult := False;
- Counter := 1;
- While Not(TmpResult) And
- (Counter <= Content.NrOfMods) Do
- Begin
- If IsLoadMemReg(p) Then
- With PInstr(p)^.oper[LoadSrc]^.ref^ Do
- If (Base = ProcInfo.FramePointer)
- {$ifdef RefsHaveIndexReg}
- And (Index = R_NO)
- {$endif RefsHaveIndexReg} Then
- Begin
- RegsChecked := RegsChecked +
- [RegMaxSize(PInstr(p)^.oper[LoadDst]^.reg)];
- If Reg = RegMaxSize(PInstr(p)^.oper[LoadDst]^.reg) Then
- Break;
- End
- Else
- Begin
- If (Base = Reg) And
- Not(Base In RegsChecked)
- Then TmpResult := True;
- {$ifdef RefsHaveIndexReg}
- If Not(TmpResult) And
- (Index = Reg) And
- Not(Index In RegsChecked)
- Then TmpResult := True;
- {$Endif RefsHaveIndexReg}
- End
- Else TmpResult := RegInInstruction(Reg, p);
- Inc(Counter);
- GetNextInstruction(p,p)
- End;
- RegInSequence := TmpResult
- }
- End;
- Procedure TPaiProp.DestroyReg(Reg: TRegister; var InstrSinceLastMod:
- TInstrSinceLastMod);
- { Destroys the contents of the register Reg in the PPaiProp p1, as well as }
- { the contents of registers are loaded with a memory location based on Reg }
- Var TmpWState, TmpRState: Byte;
- Counter: TRegister;
- Begin
- {!!!!!!!
- Reg := RegMaxSize(Reg);
- If (Reg in [LoGPReg..HiGPReg]) Then
- For Counter := LoGPReg to HiGPReg Do
- With Regs[Counter] Do
- If (Counter = reg) Or
- ((Typ = Con_Ref) And
- RegInSequence(Reg, Counter)) Then
- Begin
- InstrSinceLastMod[Counter] := 0;
- IncWState(Counter);
- TmpWState := GetWState(Counter);
- TmpRState := GetRState(Counter);
- FillChar(Regs[Counter], SizeOf(TContent), 0);
- WState := TmpWState;
- RState := TmpRState
- End
- }
- End;
- Function ArrayRefsEq(const r1, r2: TReference): Boolean;
- Begin
- {!!!!!!!!!!
- ArrayRefsEq := (R1.Offset+R1.OffsetFixup = R2.Offset+R2.OffsetFixup) And
- {$ifdef refsHaveSegmentReg}
- (R1.Segment = R2.Segment) And
- {$endif}
- (R1.Base = R2.Base) And
- (R1.Symbol=R2.Symbol);
- }
- End;
- Procedure TPaiProp.DestroyRefs(Const Ref: TReference; WhichReg: TRegister;
- var InstrSinceLastMod: TInstrSinceLastMod);
- { destroys all registers which possibly contain a reference to Ref, WhichReg }
- { is the register whose contents are being written to memory (if this proc }
- { is called because of a "mov?? %reg, (mem)" instruction) }
- Var RefsEq: TRefCompare;
- Counter: TRegister;
- Begin
- {!!!!!!!!!!!
- WhichReg := RegMaxSize(WhichReg);
- If (Ref.base = procinfo.FramePointer) or
- Assigned(Ref.Symbol) Then
- Begin
- If
- {$ifdef refsHaveIndexReg}
- (Ref.Index = R_NO) And
- {$endif refsHaveIndexReg}
- (Not(Assigned(Ref.Symbol)) or
- (Ref.base = R_NO)) Then
- { local variable which is not an array }
- RefsEq := @RefsEqual
- Else
- { local variable which is an array }
- RefsEq := @ArrayRefsEq;
- {write something to a parameter, a local or global variable, so
- * with uncertain optimizations on:
- - destroy the contents of registers whose contents have somewhere a
- "mov?? (Ref), %reg". WhichReg (this is the register whose contents
- are being written to memory) is not destroyed if it's StartMod is
- of that form and NrOfMods = 1 (so if it holds ref, but is not a
- pointer or value based on Ref)
- * with uncertain optimizations off:
- - also destroy registers that contain any pointer}
- For Counter := LoGPReg to HiGPReg Do
- With Regs[Counter] Do
- Begin
- If (typ = Con_Ref) And
- ((Not(cs_opt_size in current_settings.optimizerswitches) And
- (NrOfMods <> 1)
- ) Or
- (RefInSequence(Ref,Regs[Counter], RefsEq) And
- ((Counter <> WhichReg) Or
- ((NrOfMods <> 1) And
- {StarMod is always of the type ait_instruction}
- (PInstr(StartMod)^.oper[0].typ = top_ref) And
- RefsEq(PInstr(StartMod)^.oper[0].ref^, Ref)
- )
- )
- )
- )
- Then
- DestroyReg(Counter, InstrSinceLastMod)
- End
- End
- Else
- {write something to a pointer location, so
- * with uncertain optimzations on:
- - do not destroy registers which contain a local/global variable or a
- parameter, except if DestroyRefs is called because of a "movsl"
- * with uncertain optimzations off:
- - destroy every register which contains a memory location
- }
- For Counter := LoGPReg to HiGPReg Do
- With Regs[Counter] Do
- If (typ = Con_Ref) And
- (Not(cs_opt_size in current_settings.optimizerswitches) Or
- {$ifdef x86}
- {for movsl}
- (Ref.Base = R_EDI) Or
- {$endif}
- {don't destroy if reg contains a parameter, local or global variable}
- Not((NrOfMods = 1) And
- (PInstr(StartMod)^.oper[0].typ = top_ref) And
- ((PInstr(StartMod)^.oper[0].ref^.base = ProcInfo.FramePointer) Or
- Assigned(PInstr(StartMod)^.oper[0].ref^.Symbol)
- )
- )
- )
- Then DestroyReg(Counter, InstrSinceLastMod)
- }
- End;
- Procedure TPaiProp.DestroyAllRegs(var InstrSinceLastMod: TInstrSinceLastMod);
- Var Counter: TRegister;
- Begin {initializes/desrtoys all registers}
- {!!!!!!!!!
- For Counter := LoGPReg To HiGPReg Do
- Begin
- ReadReg(Counter);
- DestroyReg(Counter, InstrSinceLastMod);
- End;
- CondRegs.Init;
- { FPURegs.Init; }
- }
- End;
- Procedure TPaiProp.DestroyOp(const o:Toper; var InstrSinceLastMod:
- TInstrSinceLastMod);
- Begin
- {!!!!!!!
- Case o.typ Of
- top_reg: DestroyReg(o.reg, InstrSinceLastMod);
- top_ref:
- Begin
- ReadRef(o.ref);
- DestroyRefs(o.ref^, R_NO, InstrSinceLastMod);
- End;
- top_symbol:;
- End;
- }
- End;
- Procedure TPaiProp.ReadReg(Reg: TRegister);
- Begin
- {!!!!!!!
- Reg := RegMaxSize(Reg);
- If Reg in General_Registers Then
- IncRState(RegMaxSize(Reg))
- }
- End;
- Procedure TPaiProp.ReadRef(Ref: PReference);
- Begin
- {!!!!!!!
- If Ref^.Base <> R_NO Then
- ReadReg(Ref^.Base);
- {$ifdef refsHaveIndexReg}
- If Ref^.Index <> R_NO Then
- ReadReg(Ref^.Index);
- {$endif}
- }
- End;
- Procedure TPaiProp.ReadOp(const o:toper);
- Begin
- Case o.typ Of
- top_reg: ReadReg(o.reg);
- top_ref: ReadRef(o.ref);
- else
- internalerror(200410241);
- End;
- End;
- Procedure TPaiProp.ModifyReg(reg: TRegister; Var InstrSinceLastMod:
- TInstrSinceLastMod);
- Begin
- {!!!!!!!
- With Regs[reg] Do
- If (Typ = Con_Ref)
- Then
- 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, InstrSinceLastMod[Reg]);
- PPaiProp(StartMod.OptInfo)^.Regs[Reg].NrOfMods := NrOfMods;
- InstrSinceLastMod[Reg] := 0;
- End
- Else
- DestroyReg(Reg, InstrSinceLastMod);
- }
- End;
- Procedure TPaiProp.ModifyOp(const oper: TOper; var InstrSinceLastMod:
- TInstrSinceLastMod);
- Begin
- If oper.typ = top_reg Then
- ModifyReg(RegMaxSize(oper.reg),InstrSinceLastMod)
- Else
- Begin
- ReadOp(oper);
- DestroyOp(oper, InstrSinceLastMod);
- End
- End;
- Procedure TPaiProp.IncWState(Reg: TRegister);{$ifdef inl} inline;{$endif inl}
- Begin
- //!!!! IncState(Regs[Reg].WState);
- End;
- Procedure TPaiProp.IncRState(Reg: TRegister);{$ifdef inl} inline;{$endif inl}
- Begin
- //!!!! IncState(Regs[Reg].RState);
- End;
- Function TPaiProp.GetWState(Reg: TRegister): TStateInt; {$ifdef inl} inline;{$endif inl}
- Begin
- //!!!! GetWState := Regs[Reg].WState
- End;
- Function TPaiProp.GetRState(Reg: TRegister): TStateInt; {$ifdef inl} inline;{$endif inl}
- Begin
- //!!!! GetRState := Regs[Reg].RState
- End;
- Function TPaiProp.GetRegContentType(Reg: TRegister): Byte; {$ifdef inl} inline;{$endif inl}
- Begin
- //!!!! GetRegContentType := Regs[Reg].typ
- End;
- Destructor TPaiProp.Done;
- Begin
- //!!!! UsedRegs.Done;
- //!!!! CondRegs.Done;
- { DirFlag: TFlagContents; I386 specific}
- End;
- { ************************ private TPaiProp stuff ************************* }
- Procedure TPaiProp.IncState(Var s: TStateInt); {$ifdef inl} inline;{$endif inl}
- Begin
- If s <> High(TStateInt) Then Inc(s)
- Else s := 0
- End;
- Function TPaiProp.RefInInstruction(Const Ref: TReference; p: Tai;
- RefsEq: TRefCompare): Boolean;
- Var Count: AWord;
- TmpResult: Boolean;
- Begin
- TmpResult := False;
- If (p.typ = ait_instruction) Then
- Begin
- Count := 0;
- Repeat
- If (TInstr(p).oper[Count]^.typ = Top_Ref) Then
- TmpResult := RefsEq(Ref, PInstr(p)^.oper[Count]^.ref^);
- Inc(Count);
- Until (Count = MaxOps) or TmpResult;
- End;
- RefInInstruction := TmpResult;
- End;
- Function TPaiProp.RefInSequence(Const Ref: TReference; Content: TContent;
- RefsEq: TRefCompare): Boolean;
- Var p: Tai;
- Counter: Byte;
- TmpResult: Boolean;
- Begin
- p := Content.StartMod;
- TmpResult := False;
- Counter := 1;
- While Not(TmpResult) And
- (Counter <= Content.NrOfMods) Do
- Begin
- If (p.typ = ait_instruction) And
- RefInInstruction(Ref, p, @references_equal)
- Then TmpResult := True;
- Inc(Counter);
- GetNextInstruction(p,p)
- End;
- RefInSequence := TmpResult
- End;
- { ************************************************************************* }
- { ***************************** TAoptObj ********************************** }
- { ************************************************************************* }
- Constructor TAoptObj.create(_AsmL: TAsmList; _BlockStart, _BlockEnd: Tai;
- _LabelInfo: PLabelInfo);
- Begin
- AsmL := _AsmL;
- BlockStart := _BlockStart;
- BlockEnd := _BlockEnd;
- LabelInfo := _LabelInfo
- End;
- Function TAOptObj.FindLabel(L: TasmLabel; Var hp: Tai): Boolean;
- Var TempP: Tai;
- Begin
- TempP := hp;
- While Assigned(TempP) and
- (TempP.typ In SkipInstr + [ait_label]) Do
- If (TempP.typ <> ait_Label) Or
- (Tai_label(TempP).labsym <> L)
- Then GetNextInstruction(TempP, TempP)
- Else
- Begin
- hp := TempP;
- FindLabel := True;
- exit
- End;
- FindLabel := False;
- End;
- Procedure TAOptObj.InsertLLItem(prev, foll, new_one : TLinkedListItem);
- Begin
- If Assigned(prev) Then
- If Assigned(foll) Then
- Begin
- If Assigned(new_one) Then
- Begin
- new_one.previous := prev;
- new_one.next := foll;
- prev.next := new_one;
- foll.previous := new_one;
- { should we update line information? }
- if (not (tai(new_one).typ in SkipLineInfo)) and
- (not (tai(foll).typ in SkipLineInfo)) then
- Tailineinfo(new_one).fileinfo := Tailineinfo(foll).fileinfo
- End
- End
- Else AsmL.Concat(new_one)
- Else If Assigned(Foll) Then AsmL.Insert(new_one)
- End;
- Function TAOptObj.SkipHead(P: Tai): Tai;
- Var OldP: Tai;
- Begin
- Repeat
- OldP := P;
- If (P.typ in SkipInstr) Or
- ((P.typ = ait_marker) And
- (Tai_Marker(P).Kind = mark_AsmBlockEnd)) Then
- GetNextInstruction(P, P)
- Else If ((P.Typ = Ait_Marker) And
- (Tai_Marker(P).Kind = mark_NoPropInfoStart)) Then
- { a marker of the type mark_NoPropInfoStart can't be the first instruction of a }
- { paasmoutput list }
- GetNextInstruction(Tai(P.Previous),P);
- If (P.Typ = Ait_Marker) And
- (Tai_Marker(P).Kind = mark_AsmBlockStart) Then
- Begin
- P := Tai(P.Next);
- While (P.typ <> Ait_Marker) Or
- (Tai_Marker(P).Kind <> mark_AsmBlockEnd) Do
- P := Tai(P.Next)
- End;
- Until P = OldP;
- SkipHead := P;
- End;
- Function TAOptObj.OpsEqual(const o1,o2:toper): Boolean;
- Begin
- if o1.typ=o2.typ then
- Case o1.typ Of
- Top_Reg :
- OpsEqual:=o1.reg=o2.reg;
- Top_Ref :
- OpsEqual := references_equal(o1.ref^, o2.ref^);
- Top_Const :
- OpsEqual:=o1.val=o2.val;
- Top_None :
- OpsEqual := True
- else OpsEqual := False
- End;
- End;
- Function TAOptObj.FindRegAlloc(Reg: TRegister; StartPai: Tai): Boolean;
- Begin
- FindRegAlloc:=False;
- Repeat
- While Assigned(StartPai) And
- ((StartPai.typ in (SkipInstr - [ait_regAlloc])) Or
- ((StartPai.typ = ait_label) and
- Not(Tai_Label(StartPai).labsym.Is_Used))) Do
- StartPai := Tai(StartPai.Next);
- If Assigned(StartPai) And
- (StartPai.typ = ait_regAlloc) and (tai_regalloc(StartPai).ratype=ra_alloc) Then
- Begin
- if tai_regalloc(StartPai).Reg = Reg then
- begin
- FindRegAlloc:=true;
- exit;
- end;
- StartPai := Tai(StartPai.Next);
- End
- else
- exit;
- Until false;
- End;
- function SkipLabels(hp: tai; var hp2: tai): boolean;
- {skips all labels and returns the next "real" instruction}
- begin
- while assigned(hp.next) and
- (tai(hp.next).typ in SkipInstr + [ait_label,ait_align]) Do
- hp := tai(hp.next);
- if assigned(hp.next) then
- begin
- SkipLabels := True;
- hp2 := tai(hp.next)
- end
- else
- begin
- hp2 := hp;
- SkipLabels := False
- end;
- end;
- function FindAnyLabel(hp: tai; var l: tasmlabel): Boolean;
- begin
- FindAnyLabel := false;
- while assigned(hp.next) and
- (tai(hp.next).typ in (SkipInstr+[ait_align])) Do
- hp := tai(hp.next);
- if assigned(hp.next) and
- (tai(hp.next).typ = ait_label) then
- begin
- FindAnyLabel := true;
- l := tai_label(hp.next).labsym;
- end
- end;
- {$ifopt r+}
- {$define rangewason}
- {$r-}
- {$endif}
- function tAOptObj.getlabelwithsym(sym: tasmlabel): tai;
- begin
- if (sym.labelnr >= labelinfo^.lowlabel) and
- (sym.labelnr <= labelinfo^.highlabel) then { range check, a jump can go past an assembler block! }
- getlabelwithsym := labelinfo^.labeltable^[sym.labelnr-labelinfo^.lowlabel].paiobj
- else
- getlabelwithsym := nil;
- end;
- {$ifdef rangewason}
- {$r+}
- {$undef rangewason}
- {$endif}
- function TAOptObj.GetFinalDestination(hp: taicpu; level: longint): boolean;
- {traces sucessive jumps to their final destination and sets it, e.g.
- je l1 je l3
- <code> <code>
- l1: becomes l1:
- je l2 je l3
- <code> <code>
- l2: l2:
- jmp l3 jmp l3
- the level parameter denotes how deeep we have already followed the jump,
- to avoid endless loops with constructs such as "l5: ; jmp l5" }
- var p1, p2: tai;
- l: tasmlabel;
- begin
- GetfinalDestination := false;
- if level > 20 then
- exit;
- p1 := getlabelwithsym(tasmlabel(hp.oper[0]^.ref^.symbol));
- if assigned(p1) then
- begin
- SkipLabels(p1,p1);
- if (tai(p1).typ = ait_instruction) and
- (taicpu(p1).is_jmp) then
- if { the next instruction after the label where the jump hp arrives}
- { is unconditional or of the same type as hp, so continue }
- (((taicpu(p1).opcode = aopt_uncondjmp) and
- {$ifdef arm}
- (taicpu(p1).condition = C_None) and
- {$endif arm}
- (taicpu(p1).oper[0]^.typ = top_ref) and
- (assigned(taicpu(p1).oper[0]^.ref^.symbol)) and
- (taicpu(p1).oper[0]^.ref^.symbol is TAsmLabel)) or
- conditions_equal(taicpu(p1).condition,hp.condition)) or
- { the next instruction after the label where the jump hp arrives}
- { is the opposite of hp (so this one is never taken), but after }
- { that one there is a branch that will be taken, so perform a }
- { little hack: set p1 equal to this instruction (that's what the}
- { last SkipLabels is for, only works with short bool evaluation)}
- (conditions_equal(taicpu(p1).condition,inverse_cond(hp.condition)) and
- SkipLabels(p1,p2) and
- (p2.typ = ait_instruction) and
- (taicpu(p2).is_jmp) and
- (((taicpu(p2).opcode = aopt_uncondjmp) and
- {$ifdef arm}
- (taicpu(p1).condition = C_None) and
- {$endif arm}
- (taicpu(p2).oper[0]^.typ = top_ref) and
- (assigned(taicpu(p2).oper[0]^.ref^.symbol)) and
- (taicpu(p2).oper[0]^.ref^.symbol is TAsmLabel)) or
- (conditions_equal(taicpu(p2).condition,hp.condition))) and
- SkipLabels(p1,p1)) then
- begin
- { quick check for loops of the form "l5: ; jmp l5 }
- if (tasmlabel(taicpu(p1).oper[0]^.ref^.symbol).labelnr =
- tasmlabel(hp.oper[0]^.ref^.symbol).labelnr) then
- exit;
- if not GetFinalDestination(taicpu(p1),succ(level)) then
- exit;
- tasmlabel(hp.oper[0]^.ref^.symbol).decrefs;
- hp.oper[0]^.ref^.symbol:=taicpu(p1).oper[0]^.ref^.symbol;
- tasmlabel(hp.oper[0]^.ref^.symbol).increfs;
- end
- else
- if conditions_equal(taicpu(p1).condition,inverse_cond(hp.condition)) then
- if not FindAnyLabel(p1,l) then
- begin
- {$ifdef finaldestdebug}
- insertllitem(asml,p1,p1.next,tai_comment.Create(
- strpnew('previous label inserted'))));
- {$endif finaldestdebug}
- current_asmdata.getjumplabel(l);
- insertllitem(p1,p1.next,tai_label.Create(l));
- tasmlabel(taicpu(hp).oper[0]^.ref^.symbol).decrefs;
- hp.oper[0]^.ref^.symbol := l;
- l.increfs;
- { this won't work, since the new label isn't in the labeltable }
- { so it will fail the rangecheck. Labeltable should become a }
- { hashtable to support this: }
- { GetFinalDestination(asml, hp); }
- end
- else
- begin
- {$ifdef finaldestdebug}
- insertllitem(asml,p1,p1.next,tai_comment.Create(
- strpnew('next label reused'))));
- {$endif finaldestdebug}
- l.increfs;
- hp.oper[0]^.ref^.symbol := l;
- if not GetFinalDestination(hp,succ(level)) then
- exit;
- end;
- end;
- GetFinalDestination := true;
- end;
- procedure TAOptObj.PrePeepHoleOpts;
- begin
- end;
- procedure TAOptObj.PeepHoleOptPass1;
- var
- p,hp1,hp2 : tai;
- begin
- p := BlockStart;
- //!!!! UsedRegs := [];
- while (p <> BlockEnd) Do
- begin
- //!!!! UpDateUsedRegs(UsedRegs, tai(p.next));
- if PeepHoleOptPass1Cpu(p) then
- continue;
- case p.Typ Of
- ait_instruction:
- begin
- { Handle Jmp Optimizations }
- if taicpu(p).is_jmp then
- begin
- { the following if-block removes all code between a jmp and the next label,
- because it can never be executed
- }
- if (taicpu(p).opcode = aopt_uncondjmp) and
- {$ifdef arm}
- (taicpu(p).condition = C_None) and
- {$endif arm}
- (taicpu(p).oper[0]^.typ = top_ref) and
- (assigned(taicpu(p).oper[0]^.ref^.symbol)) and
- (taicpu(p).oper[0]^.ref^.symbol is TAsmLabel) then
- begin
- while GetNextInstruction(p, hp1) and
- (hp1.typ <> ait_label) do
- if not(hp1.typ in ([ait_label,ait_align]+skipinstr)) then
- begin
- asml.remove(hp1);
- hp1.free;
- end
- else break;
- end;
- { remove jumps to a label coming right after them }
- if GetNextInstruction(p, hp1) then
- begin
- if FindLabel(tasmlabel(taicpu(p).oper[0]^.ref^.symbol), hp1) and
- {$warning FIXME removing the first instruction fails}
- (p<>blockstart) then
- begin
- hp2:=tai(hp1.next);
- asml.remove(p);
- p.free;
- p:=hp2;
- continue;
- end
- else
- begin
- if hp1.typ = ait_label then
- SkipLabels(hp1,hp1);
- if (tai(hp1).typ=ait_instruction) and
- (taicpu(hp1).opcode=aopt_uncondjmp) and
- {$ifdef arm}
- (taicpu(hp1).condition=C_None) and
- {$endif arm}
- (taicpu(hp1).oper[0]^.typ = top_ref) and
- (assigned(taicpu(hp1).oper[0]^.ref^.symbol)) and
- (taicpu(hp1).oper[0]^.ref^.symbol is TAsmLabel) and
- GetNextInstruction(hp1, hp2) and
- FindLabel(tasmlabel(taicpu(p).oper[0]^.ref^.symbol), hp2) then
- begin
- if (taicpu(p).opcode=aopt_condjmp)
- {$ifdef arm}
- and (taicpu(p).condition<>C_None)
- {$endif arm}
- then
- begin
- taicpu(p).condition:=inverse_cond(taicpu(p).condition);
- tai_label(hp2).labsym.decrefs;
- taicpu(p).oper[0]^.ref^.symbol:=taicpu(hp1).oper[0]^.ref^.symbol;
- { when freeing hp1, the reference count
- isn't decreased, so don't increase
- taicpu(p).oper[0]^.ref^.symbol.increfs;
- }
- {$ifdef SPARC}
- hp2:=tai(hp1.next);
- asml.remove(hp2);
- hp2.free;
- {$endif SPARC}
- asml.remove(hp1);
- hp1.free;
- GetFinalDestination(taicpu(p),0);
- end
- else
- begin
- GetFinalDestination(taicpu(p),0);
- p:=tai(p.next);
- continue;
- end;
- end
- else
- GetFinalDestination(taicpu(p),0);
- end;
- end;
- end
- else
- { All other optimizes }
- begin
- end; { if is_jmp }
- end;
- end;
- //!!!!!!!! updateUsedRegs(UsedRegs,p);
- p:=tai(p.next);
- end;
- end;
- procedure TAOptObj.PeepHoleOptPass2;
- begin
- end;
- procedure TAOptObj.PostPeepHoleOpts;
- var
- p: tai;
- begin
- p := BlockStart;
- //!!!! UsedRegs := [];
- while (p <> BlockEnd) Do
- begin
- //!!!! UpDateUsedRegs(UsedRegs, tai(p.next));
- if PostPeepHoleOptsCpu(p) then
- continue;
- //!!!!!!!! updateUsedRegs(UsedRegs,p);
- p:=tai(p.next);
- end;
- end;
- function TAOptObj.PeepHoleOptPass1Cpu(var p: tai): boolean;
- begin
- result := false;
- end;
- function TAOptObj.PostPeepHoleOptsCpu(var p: tai): boolean;
- begin
- result := false;
- end;
- End.
|