12345678910111213141516171819202122232425262728293031323334353637383940414243444546474849505152535455565758596061626364656667686970717273747576777879808182838485868788899091929394959697989910010110210310410510610710810911011111211311411511611711811912012112212312412512612712812913013113213313413513613713813914014114214314414514614714814915015115215315415515615715815916016116216316416516616716816917017117217317417517617717817918018118218318418518618718818919019119219319419519619719819920020120220320420520620720820921021121221321421521621721821922022122222322422522622722822923023123223323423523623723823924024124224324424524624724824925025125225325425525625725825926026126226326426526626726826927027127227327427527627727827928028128228328428528628728828929029129229329429529629729829930030130230330430530630730830931031131231331431531631731831932032132232332432532632732832933033133233333433533633733833934034134234334434534634734834935035135235335435535635735835936036136236336436536636736836937037137237337437537637737837938038138238338438538638738838939039139239339439539639739839940040140240340440540640740840941041141241341441541641741841942042142242342442542642742842943043143243343443543643743843944044144244344444544644744844945045145245345445545645745845946046146246346446546646746846947047147247347447547647747847948048148248348448548648748848949049149249349449549649749849950050150250350450550650750850951051151251351451551651751851952052152252352452552652752852953053153253353453553653753853954054154254354454554654754854955055155255355455555655755855956056156256356456556656756856957057157257357457557657757857958058158258358458558658758858959059159259359459559659759859960060160260360460560660760860961061161261361461561661761861962062162262362462562662762862963063163263363463563663763863964064164264364464564664764864965065165265365465565665765865966066166266366466566666766866967067167267367467567667767867968068168268368468568668768868969069169269369469569669769869970070170270370470570670770870971071171271371471571671771871972072172272372472572672772872973073173273373473573673773873974074174274374474574674774874975075175275375475575675775875976076176276376476576676776876977077177277377477577677777877978078178278378478578678778878979079179279379479579679779879980080180280380480580680780880981081181281381481581681781881982082182282382482582682782882983083183283383483583683783883984084184284384484584684784884985085185285385485585685785885986086186286386486586686786886987087187287387487587687787887988088188288388488588688788888989089189289389489589689789889990090190290390490590690790890991091191291391491591691791891992092192292392492592692792892993093193293393493593693793893994094194294394494594694794894995095195295395495595695795895996096196296396496596696796896997097197297397497597697797897998098198298398498598698798898999099199299399499599699799899910001001100210031004100510061007100810091010101110121013101410151016101710181019102010211022102310241025102610271028102910301031103210331034103510361037103810391040104110421043104410451046104710481049105010511052105310541055105610571058105910601061106210631064106510661067106810691070107110721073107410751076107710781079108010811082108310841085108610871088108910901091109210931094109510961097109810991100110111021103110411051106110711081109111011111112111311141115111611171118111911201121112211231124112511261127112811291130113111321133113411351136113711381139114011411142114311441145114611471148114911501151115211531154115511561157115811591160116111621163116411651166116711681169 |
- {
- 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: longint;
- LabelDif: cardinal;
- { 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
- Result:=False; { unimplemented }
- 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
- Result:=False; { unimplemented }
- (*!!!!!!!!!!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
- Result:=False; { unimplemented }
- (*!!!!!!!!!!
- 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
- Result:=0; { unimplemented }
- //!!!! GetWState := Regs[Reg].WState
- End;
- Function TPaiProp.GetRState(Reg: TRegister): TStateInt; {$ifdef inl} inline;{$endif inl}
- Begin
- Result:=0; { unimplemented }
- //!!!! GetRState := Regs[Reg].RState
- End;
- Function TPaiProp.GetRegContentType(Reg: TRegister): Byte; {$ifdef inl} inline;{$endif inl}
- Begin
- Result:=0; { unimplemented }
- //!!!! 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 (int64(sym.labelnr) >= int64(labelinfo^.lowlabel)) and
- (int64(sym.labelnr) <= int64(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;
- tasmlabel(hp.oper[0]^.ref^.symbol).decrefs;
- 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
- hp2:=p;
- while GetNextInstruction(hp2, hp1) and
- (hp1.typ <> ait_label) do
- if not(hp1.typ in ([ait_label,ait_align]+skipinstr)) then
- begin
- if (hp1.typ = ait_instruction) and
- taicpu(hp1).is_jmp and
- (taicpu(hp1).oper[0]^.typ = top_ref) and
- assigned(taicpu(hp1).oper[0]^.ref^.symbol) and
- (taicpu(hp1).oper[0]^.ref^.symbol is TAsmLabel) then
- TAsmLabel(taicpu(hp1).oper[0]^.ref^.symbol).decrefs;
- { don't kill start/end of assembler block,
- no-line-info-start/end etc }
- if hp1.typ<>ait_marker then
- begin
- asml.remove(hp1);
- hp1.free;
- end
- else
- hp2:=hp1;
- 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
- { TODO: FIXME removing the first instruction fails}
- (p<>blockstart) then
- begin
- hp2:=tai(hp1.next);
- asml.remove(p);
- tasmlabel(taicpu(p).oper[0]^.ref^.symbol).decrefs;
- 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.
|