123456789101112131415161718192021222324252627282930313233343536373839404142434445464748495051525354555657585960616263646566676869707172737475767778798081828384858687888990919293949596979899100101102103104105106107108109110111112113114115116117118119120121122123124125126127128129130131132133134135136137138139140141142143144145146147148149150151152153154155156157158159160161162163164165166167168169170171172173174175176177178179180181182183184185186187188189190191192193194195196197198199200201202203204205206207208209210211212213214215216217218219220221222223224225226227228229230231232233234235236237238239240241242243244245246247248249250251252253254255256257258259260261262263264265266267268269270271272273274275276277278279280281282283284285286287288289290291292293294295296297298299300301302303304305306307308309310311312313314315316317318319320321322323324325326327328329330331332333334335336337338339340341342343344345346347348349350351352353354355356357358359360361362363364365366367368369370371372373374375376377378379380381382383384385386387388389390391392393394395396397398399400401402403404405406407408409410411412413414415416417418419420421422423424425426427428429430431432433434435436437438439440441442443444445446447448449450451452453454455456457458459460461462463464465466467468469470471472473474475476477478479480481482483484485486487488489490491492493494495496497498499500501502503504505506507508509510511512513514515516517518519520521522523524525526527528529530531532533534535536537538539540541542543544545546547548549550551552553554555556557558559560561562563564565566567568569570571572573574575576577578579580581582583584585586587588589590591592593594595596597598599600601602603604605606607608609610611612613614615616617618619620621622623624625626627628629630631632633634635636637638639640641642643644645646647648649650651652653654655656657658659660661662663664665666667668669670671672673674675676677678679680681682683684685686687688689690691692693694695696697698699700701702703704705706707708709710711712713714715716717718719720721722723724725726727728729730731732733734735736737738739740741742743744745746747748749750751752753754755756757758759760761762763764765766767768769770771772773774775776777778779780781782783784785786787788789790791792793794795796797798799800801802803804805806807808809810811812813814815816817818819820821822823824825826827828829830831832833834835836837838839840841842843844845846847848849850851852853854855856857858859860861862863864865866867868869870871872873874875876877878879880881882883884885886887888889890891892893894895896897898899900901902903904905906907908909910911912913914915916917918919920921922923924925926927928929930931932933934935936937938939940941942943944945946947948949950951952953954955956957958959960961962963964965966967968969970971972973974975976977978979980981982983984985986987988989990991992993994995996997998999100010011002100310041005100610071008100910101011101210131014101510161017101810191020102110221023102410251026102710281029103010311032103310341035103610371038103910401041104210431044104510461047104810491050105110521053105410551056105710581059106010611062106310641065106610671068106910701071107210731074107510761077107810791080108110821083108410851086108710881089109010911092109310941095109610971098109911001101110211031104110511061107110811091110111111121113111411151116111711181119112011211122112311241125112611271128112911301131113211331134113511361137113811391140114111421143114411451146114711481149115011511152115311541155115611571158115911601161116211631164116511661167116811691170117111721173117411751176117711781179118011811182118311841185118611871188118911901191119211931194119511961197119811991200120112021203120412051206120712081209121012111212121312141215121612171218121912201221122212231224122512261227122812291230123112321233123412351236123712381239124012411242124312441245124612471248124912501251125212531254125512561257125812591260126112621263126412651266126712681269127012711272127312741275127612771278127912801281128212831284128512861287128812891290129112921293129412951296129712981299130013011302130313041305130613071308130913101311131213131314131513161317131813191320132113221323132413251326132713281329133013311332133313341335133613371338133913401341134213431344134513461347134813491350135113521353135413551356135713581359136013611362136313641365136613671368136913701371137213731374137513761377137813791380138113821383138413851386138713881389139013911392139313941395139613971398139914001401140214031404140514061407140814091410141114121413141414151416141714181419142014211422142314241425142614271428142914301431143214331434143514361437143814391440144114421443144414451446144714481449145014511452145314541455145614571458145914601461146214631464146514661467146814691470147114721473147414751476147714781479148014811482148314841485148614871488148914901491149214931494149514961497149814991500150115021503150415051506150715081509151015111512151315141515151615171518151915201521152215231524152515261527152815291530153115321533153415351536153715381539154015411542154315441545154615471548154915501551155215531554155515561557155815591560156115621563156415651566156715681569157015711572157315741575157615771578157915801581158215831584158515861587158815891590159115921593159415951596159715981599160016011602160316041605160616071608160916101611161216131614161516161617161816191620162116221623162416251626162716281629163016311632163316341635163616371638163916401641164216431644164516461647164816491650165116521653165416551656165716581659166016611662166316641665166616671668166916701671167216731674167516761677167816791680168116821683168416851686168716881689169016911692169316941695169616971698169917001701170217031704170517061707170817091710171117121713171417151716171717181719172017211722172317241725172617271728172917301731173217331734173517361737173817391740174117421743174417451746174717481749175017511752175317541755175617571758175917601761176217631764176517661767176817691770177117721773177417751776177717781779178017811782178317841785178617871788178917901791179217931794179517961797179817991800180118021803180418051806180718081809181018111812181318141815181618171818181918201821182218231824182518261827182818291830183118321833183418351836183718381839184018411842184318441845184618471848184918501851185218531854185518561857185818591860186118621863186418651866186718681869187018711872187318741875187618771878187918801881188218831884188518861887188818891890189118921893189418951896189718981899190019011902190319041905190619071908190919101911191219131914191519161917191819191920192119221923192419251926192719281929193019311932193319341935193619371938193919401941194219431944194519461947194819491950195119521953195419551956195719581959196019611962196319641965196619671968196919701971197219731974197519761977197819791980198119821983198419851986198719881989199019911992199319941995199619971998199920002001200220032004200520062007200820092010201120122013201420152016201720182019202020212022202320242025202620272028202920302031203220332034203520362037203820392040204120422043204420452046204720482049205020512052205320542055205620572058205920602061206220632064206520662067206820692070207120722073207420752076207720782079208020812082208320842085208620872088208920902091209220932094209520962097209820992100210121022103210421052106210721082109211021112112211321142115211621172118211921202121212221232124212521262127212821292130213121322133213421352136213721382139214021412142214321442145214621472148214921502151215221532154215521562157215821592160216121622163216421652166216721682169217021712172217321742175217621772178217921802181218221832184218521862187218821892190219121922193219421952196219721982199220022012202220322042205220622072208220922102211221222132214221522162217221822192220222122222223222422252226222722282229223022312232223322342235223622372238223922402241224222432244224522462247224822492250225122522253225422552256225722582259226022612262226322642265226622672268226922702271227222732274227522762277227822792280228122822283228422852286228722882289229022912292229322942295229622972298229923002301230223032304230523062307230823092310231123122313231423152316231723182319232023212322232323242325232623272328232923302331233223332334233523362337233823392340234123422343234423452346234723482349235023512352235323542355235623572358235923602361236223632364236523662367236823692370237123722373237423752376237723782379238023812382238323842385238623872388238923902391239223932394239523962397239823992400240124022403240424052406240724082409241024112412241324142415241624172418241924202421242224232424242524262427242824292430243124322433243424352436243724382439244024412442244324442445244624472448244924502451245224532454245524562457245824592460246124622463246424652466246724682469247024712472247324742475247624772478247924802481248224832484248524862487248824892490249124922493249424952496249724982499250025012502250325042505250625072508250925102511251225132514251525162517251825192520252125222523252425252526252725282529253025312532253325342535253625372538253925402541254225432544254525462547254825492550255125522553255425552556255725582559256025612562256325642565256625672568256925702571257225732574257525762577257825792580258125822583258425852586258725882589259025912592259325942595259625972598259926002601260226032604260526062607260826092610261126122613261426152616261726182619262026212622262326242625262626272628262926302631263226332634263526362637263826392640264126422643264426452646264726482649265026512652265326542655265626572658265926602661266226632664266526662667266826692670267126722673267426752676267726782679268026812682268326842685268626872688268926902691269226932694269526962697269826992700270127022703270427052706270727082709271027112712271327142715271627172718271927202721272227232724272527262727272827292730273127322733273427352736273727382739274027412742274327442745274627472748274927502751275227532754275527562757275827592760276127622763 |
- {
- $Id$
- Copyright (c) 1998-2000 by Jonas Maebe, member of the Freepascal
- development team
- This unit contains the data flow analyzer and several helper procedures
- and functions.
- 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 DAOpt386;
- {$i defines.inc}
- Interface
- Uses
- GlobType,
- CClasses,Aasm,
- cpubase,cpuasm;
- {******************************* Constants *******************************}
- Const
- {Possible register content types}
- con_Unknown = 0;
- con_ref = 1;
- con_const = 2;
- { The contents aren't usable anymore for CSE, but they may still be }
- { usefull for detecting whether the result of a load is actually used }
- con_invalid = 3;
- { the reverse of the above (in case a (conditional) jump is encountered): }
- { CSE is still possible, but the original instruction can't be removed }
- con_noRemoveRef = 4;
- { same, but for constants }
- con_noRemoveConst = 5;
- {********************************* Types *********************************}
- type
- TRegArray = Array[R_EAX..R_BL] of TRegister;
- TRegSet = Set of R_EAX..R_BL;
- TRegInfo = Record
- NewRegsEncountered, OldRegsEncountered: TRegSet;
- RegsLoadedForRef: TRegSet;
- regsStillUsedAfterSeq: TRegSet;
- lastReload: array[R_EAX..R_EDI] of Tai;
- New2OldReg: TRegArray;
- End;
- {possible actions on an operand: read, write or modify (= read & write)}
- TOpAction = (OpAct_Read, OpAct_Write, OpAct_Modify, OpAct_Unknown);
- {the possible states of a flag}
- TFlagContents = (F_Unknown, F_NotSet, F_Set);
- TContent = Packed Record
- {start and end of block instructions that defines the
- content of this register.}
- StartMod: Tai;
- MemWrite: Taicpu;
- {how many instructions starting with StarMod does the block consist of}
- NrOfMods: Byte;
- {the type of the content of the register: unknown, memory, constant}
- Typ: Byte;
- case byte of
- {starts at 0, gets increased everytime the register is written to}
- 1: (WState: Byte;
- {starts at 0, gets increased everytime the register is read from}
- RState: Byte);
- { to compare both states in one operation }
- 2: (state: word);
- End;
- {Contents of the integer registers}
- TRegContent = Array[R_EAX..R_EDI] Of TContent;
- {contents of the FPU registers}
- TRegFPUContent = Array[R_ST..R_ST7] Of TContent;
- {$ifdef tempOpts}
- { linked list which allows searching/deleting based on value, no extra frills}
- PSearchLinkedListItem = ^TSearchLinkedListItem;
- TSearchLinkedListItem = object(TLinkedList_Item)
- constructor init;
- function equals(p: PSearchLinkedListItem): boolean; virtual;
- end;
- PSearchDoubleIntItem = ^TSearchDoubleInttem;
- TSearchDoubleIntItem = object(TLinkedList_Item)
- constructor init(_int1,_int2: longint);
- function equals(p: PSearchLinkedListItem): boolean; virtual;
- private
- int1, int2: longint;
- end;
- PSearchLinkedList = ^TSearchLinkedList;
- TSearchLinkedList = object(TLinkedList)
- function searchByValue(p: PSearchLinkedListItem): boolean;
- procedure removeByValue(p: PSearchLinkedListItem);
- end;
- {$endif tempOpts}
- {information record with the contents of every register. Every Tai object
- gets one of these assigned: a pointer to it is stored in the OptInfo field}
- TTaiProp = Record
- Regs: TRegContent;
- { FPURegs: TRegFPUContent;} {currently not yet used}
- { allocated Registers }
- UsedRegs: TRegSet;
- { status of the direction flag }
- DirFlag: TFlagContents;
- {$ifdef tempOpts}
- { currently used temps }
- tempAllocs: PSearchLinkedList;
- {$endif tempOpts}
- { can this instruction be removed? }
- CanBeRemoved: Boolean;
- { are the resultflags set by this instruction used? }
- FlagsUsed: Boolean;
- End;
- PTaiProp = ^TTaiProp;
- TTaiPropBlock = Array[1..250000] Of TTaiProp;
- PTaiPropBlock = ^TTaiPropBlock;
- TInstrSinceLastMod = Array[R_EAX..R_EDI] Of Byte;
- TLabelTableItem = Record
- TaiObj: Tai;
- {$IfDef JumpAnal}
- InstrNr: Longint;
- RefsFound: Word;
- JmpsProcessed: Word
- {$EndIf JumpAnal}
- End;
- TLabelTable = Array[0..2500000] Of TLabelTableItem;
- PLabelTable = ^TLabelTable;
- {*********************** Procedures and Functions ************************}
- Procedure InsertLLItem(AsmL: TAAsmOutput; prev, foll, new_one: TLinkedListItem);
- Function Reg32(Reg: TRegister): TRegister;
- Function RefsEquivalent(Const R1, R2: TReference; Var RegInfo: TRegInfo; OpAct: TOpAction): Boolean;
- Function RefsEqual(Const R1, R2: TReference): Boolean;
- Function IsGP32Reg(Reg: TRegister): Boolean;
- Function RegInRef(Reg: TRegister; Const Ref: TReference): Boolean;
- function RegReadByInstruction(reg: TRegister; hp: Tai): boolean;
- function RegModifiedByInstruction(Reg: TRegister; p1: Tai): Boolean;
- function RegInInstruction(Reg: TRegister; p1: Tai): Boolean;
- function RegInOp(Reg: TRegister; const o:toper): Boolean;
- function instrWritesFlags(p: Tai): boolean;
- function instrReadsFlags(p: Tai): boolean;
- function writeToMemDestroysContents(regWritten: tregister; const ref: treference;
- reg: tregister; const c: tcontent; var invalsmemwrite: boolean): boolean;
- function writeToRegDestroysContents(destReg: tregister; reg: tregister;
- const c: tcontent): boolean;
- function writeDestroysContents(const op: toper; reg: tregister;
- const c: tcontent): boolean;
- Function GetNextInstruction(Current: Tai; Var Next: Tai): Boolean;
- Function GetLastInstruction(Current: Tai; Var Last: Tai): Boolean;
- Procedure SkipHead(var P: Tai);
- function labelCanBeSkipped(p: Tai_label): boolean;
- Procedure RemoveLastDeallocForFuncRes(asmL: TAAsmOutput; p: Tai);
- Function regLoadedWithNewValue(reg: tregister; canDependOnPrevValue: boolean;
- hp: Tai): boolean;
- Procedure UpdateUsedRegs(Var UsedRegs: TRegSet; p: Tai);
- Procedure AllocRegBetween(AsmL: TAAsmOutput; Reg: TRegister; p1, p2: Tai);
- function FindRegDealloc(reg: tregister; p: Tai): boolean;
- Function RegsEquivalent(OldReg, NewReg: TRegister; Var RegInfo: TRegInfo; OpAct: TopAction): Boolean;
- Function InstructionsEquivalent(p1, p2: Tai; Var RegInfo: TRegInfo): Boolean;
- function sizescompatible(loadsize,newsize: topsize): boolean;
- Function OpsEqual(const o1,o2:toper): Boolean;
- Function DFAPass1(AsmL: TAAsmOutput; BlockStart: Tai): Tai;
- Function DFAPass2(
- {$ifdef statedebug}
- AsmL: TAAsmOutPut;
- {$endif statedebug}
- BlockStart, BlockEnd: Tai): Boolean;
- Procedure ShutDownDFA;
- Function FindLabel(L: tasmlabel; Var hp: Tai): Boolean;
- Procedure IncState(Var S: Byte; amount: longint);
- {******************************* Variables *******************************}
- Var
- {the amount of TaiObjects in the current assembler list}
- NrOfTaiObjs: Longint;
- {Array which holds all TTaiProps}
- TaiPropBlock: PTaiPropBlock;
- LoLab, HiLab, LabDif: Longint;
- LTable: PLabelTable;
- {*********************** End of Interface section ************************}
- Implementation
- Uses
- globals, systems, verbose, cgbase, symconst, symsym, tgcpu;
- Type
- TRefCompare = function(const r1, r2: TReference): Boolean;
- Var
- {How many instructions are between the current instruction and the last one
- that modified the register}
- NrOfInstrSinceLastMod: TInstrSinceLastMod;
- {$ifdef tempOpts}
- constructor TSearchLinkedListItem.init;
- begin
- end;
- function TSearchLinkedListItem.equals(p: PSearchLinkedListItem): boolean;
- begin
- equals := false;
- end;
- constructor TSearchDoubleIntItem.init(_int1,_int2: longint);
- begin
- int1 := _int1;
- int2 := _int2;
- end;
- function TSearchDoubleIntItem.equals(p: PSearchLinkedListItem): boolean;
- begin
- equals := (TSearchDoubleIntItem(p).int1 = int1) and
- (TSearchDoubleIntItem(p).int2 = int2);
- end;
- function TSearchLinkedList.searchByValue(p: PSearchLinkedListItem): boolean;
- var temp: PSearchLinkedListItem;
- begin
- temp := first;
- while (temp <> last.next) and
- not(temp.equals(p)) do
- temp := temp.next;
- searchByValue := temp <> last.next;
- end;
- procedure TSearchLinkedList.removeByValue(p: PSearchLinkedListItem);
- begin
- temp := first;
- while (temp <> last.next) and
- not(temp.equals(p)) do
- temp := temp.next;
- if temp <> last.next then
- begin
- remove(temp);
- dispose(temp,done);
- end;
- end;
- Procedure updateTempAllocs(Var UsedRegs: TRegSet; 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
- labelCanBeSkipped(Tai_label(current)))) Do
- p := Tai(p.next);
- While Assigned(p) And
- (p.typ=ait_RegAlloc) Do
- Begin
- if Tairegalloc(p).allocation then
- UsedRegs := UsedRegs + [TaiRegAlloc(p).Reg]
- else
- UsedRegs := UsedRegs - [TaiRegAlloc(p).Reg];
- p := Tai(p.next);
- End;
- Until Not(Assigned(p)) Or
- (Not(p.typ in SkipInstr) And
- Not((p.typ = ait_label) And
- labelCanBeSkipped(Tai_label(current))));
- End;
- {$endif tempOpts}
- {************************ Create the Label table ************************}
- Function FindLoHiLabels(Var LowLabel, HighLabel, LabelDif: Longint; BlockStart: Tai): Tai;
- {Walks through the TAAsmlist to find the lowest and highest label number}
- Var LabelFound: Boolean;
- P, lastP: Tai;
- Begin
- LabelFound := False;
- LowLabel := MaxLongint;
- HighLabel := 0;
- P := BlockStart;
- lastP := p;
- While Assigned(P) Do
- Begin
- If (Tai(p).typ = ait_label) Then
- If not labelCanBeSkipped(Tai_label(p))
- Then
- Begin
- LabelFound := True;
- If (Tai_Label(p).l.labelnr < LowLabel) Then
- LowLabel := Tai_Label(p).l.labelnr;
- If (Tai_Label(p).l.labelnr > HighLabel) Then
- HighLabel := Tai_Label(p).l.labelnr;
- End;
- lastP := p;
- GetNextInstruction(p, p);
- End;
- if (lastP.typ = ait_marker) and
- (Tai_marker(lastp).kind = asmBlockStart) then
- FindLoHiLabels := lastP
- else FindLoHiLabels := nil;
- If LabelFound
- Then LabelDif := HighLabel+1-LowLabel
- Else LabelDif := 0;
- End;
- Function FindRegAlloc(Reg: TRegister; StartTai: Tai; alloc: boolean): Boolean;
- { Returns true if a ait_alloc object for Reg is found in the block of Tai's }
- { starting with StartTai and ending with the next "real" instruction }
- Begin
- FindRegAlloc := false;
- Repeat
- While Assigned(StartTai) And
- ((StartTai.typ in (SkipInstr - [ait_regAlloc])) Or
- ((StartTai.typ = ait_label) and
- labelCanBeSkipped(Tai_label(startTai)))) Do
- StartTai := Tai(StartTai.Next);
- If Assigned(StartTai) and
- (StartTai.typ = ait_regAlloc) then
- begin
- if (TairegAlloc(StartTai).allocation = alloc) and
- (TairegAlloc(StartTai).Reg = Reg) then
- begin
- FindRegAlloc:=true;
- break;
- end;
- StartTai := Tai(StartTai.Next);
- end
- else
- break;
- Until false;
- End;
- Procedure RemoveLastDeallocForFuncRes(asmL: TAAsmOutput; p: Tai);
- Procedure DoRemoveLastDeallocForFuncRes(asmL: TAAsmOutput; reg: TRegister);
- var
- hp2: Tai;
- begin
- hp2 := p;
- repeat
- hp2 := Tai(hp2.previous);
- if assigned(hp2) and
- (hp2.typ = ait_regalloc) and
- not(Tairegalloc(hp2).allocation) and
- (Tairegalloc(hp2).reg = reg) then
- begin
- asml.remove(hp2);
- hp2.free;
- break;
- end;
- until not(assigned(hp2)) or
- regInInstruction(reg,hp2);
- end;
- begin
- case aktprocdef.rettype.def.deftype of
- arraydef,recorddef,pointerdef,
- stringdef,enumdef,procdef,objectdef,errordef,
- filedef,setdef,procvardef,
- classrefdef,forwarddef:
- DoRemoveLastDeallocForFuncRes(asmL,R_EAX);
- orddef:
- if aktprocdef.rettype.def.size <> 0 then
- begin
- DoRemoveLastDeallocForFuncRes(asmL,R_EAX);
- { for int64/qword }
- if aktprocdef.rettype.def.size = 8 then
- DoRemoveLastDeallocForFuncRes(asmL,R_EDX);
- end;
- end;
- end;
- procedure getNoDeallocRegs(var regs: TRegSet);
- var regCounter: TRegister;
- begin
- regs := [];
- case aktprocdef.rettype.def.deftype of
- arraydef,recorddef,pointerdef,
- stringdef,enumdef,procdef,objectdef,errordef,
- filedef,setdef,procvardef,
- classrefdef,forwarddef:
- regs := [R_EAX];
- orddef:
- if aktprocdef.rettype.def.size <> 0 then
- begin
- regs := [R_EAX];
- { for int64/qword }
- if aktprocdef.rettype.def.size = 8 then
- regs := regs + [R_EDX];
- end;
- end;
- for regCounter := R_EAX to R_EBX do
- if not(regCounter in usableregs) then
- regs := regs + [regCounter];
- end;
- Procedure AddRegDeallocFor(asmL: TAAsmOutput; reg: TRegister; p: Tai);
- var hp1: Tai;
- funcResRegs: TRegset;
- funcResReg: boolean;
- begin
- if not(reg in usableregs) then
- exit;
- getNoDeallocRegs(funcResRegs);
- funcResRegs := funcResRegs - usableregs;
- funcResReg := reg in funcResRegs;
- hp1 := p;
- while not(funcResReg and
- (p.typ = ait_instruction) and
- (Taicpu(p).opcode = A_JMP) and
- (tasmlabel(Taicpu(p).oper[0].sym) = aktexit2label)) and
- getLastInstruction(p, p) And
- not(regInInstruction(reg, p)) Do
- hp1 := p;
- { don't insert a dealloc for registers which contain the function result }
- { if they are followed by a jump to the exit label (for exit(...)) }
- if not(funcResReg) or
- not((hp1.typ = ait_instruction) and
- (Taicpu(hp1).opcode = A_JMP) and
- (tasmlabel(Taicpu(hp1).oper[0].sym) = aktexit2label)) then
- begin
- p := TaiRegAlloc.deAlloc(reg);
- insertLLItem(AsmL, hp1.previous, hp1, p);
- end;
- end;
- Procedure BuildLabelTableAndFixRegAlloc(asmL: TAAsmOutput; Var LabelTable: PLabelTable; LowLabel: Longint;
- Var LabelDif: Longint; BlockStart, BlockEnd: Tai);
- {Builds a table with the locations of the labels in the TAAsmoutput.
- Also fixes some RegDeallocs like "# %eax released; push (%eax)"}
- Var p, hp1, hp2, lastP: Tai;
- regCounter: TRegister;
- UsedRegs, noDeallocRegs: TRegSet;
- Begin
- UsedRegs := [];
- If (LabelDif <> 0) Then
- Begin
- GetMem(LabelTable, LabelDif*SizeOf(TLabelTableItem));
- FillChar(LabelTable^, LabelDif*SizeOf(TLabelTableItem), 0);
- End;
- p := BlockStart;
- lastP := p;
- While (P <> BlockEnd) Do
- Begin
- Case p.typ Of
- ait_Label:
- If not labelCanBeSkipped(Tai_label(p)) Then
- LabelTable^[Tai_Label(p).l.labelnr-LowLabel].TaiObj := p;
- ait_regAlloc:
- { ESI and EDI are (de)allocated manually, don't mess with them }
- if not(TaiRegAlloc(p).Reg in [R_EDI,R_ESI]) then
- begin
- if TairegAlloc(p).Allocation then
- Begin
- If Not(TaiRegAlloc(p).Reg in UsedRegs) Then
- UsedRegs := UsedRegs + [TaiRegAlloc(p).Reg]
- Else
- addRegDeallocFor(asmL, TaiRegAlloc(p).reg, p);
- End
- else
- begin
- UsedRegs := UsedRegs - [TaiRegAlloc(p).Reg];
- hp1 := p;
- hp2 := nil;
- While Not(FindRegAlloc(TaiRegAlloc(p).Reg, Tai(hp1.Next),true)) And
- GetNextInstruction(hp1, hp1) And
- RegInInstruction(TaiRegAlloc(p).Reg, hp1) Do
- hp2 := hp1;
- If hp2 <> nil Then
- Begin
- hp1 := Tai(p.previous);
- AsmL.Remove(p);
- InsertLLItem(AsmL, hp2, Tai(hp2.Next), p);
- p := hp1;
- end;
- end;
- end;
- end;
- repeat
- lastP := p;
- P := Tai(P.Next);
- until not(Assigned(p)) or
- not(p.typ in (SkipInstr - [ait_regalloc]));
- End;
- { don't add deallocation for function result variable or for regvars}
- getNoDeallocRegs(noDeallocRegs);
- usedRegs := usedRegs - noDeallocRegs;
- for regCounter := R_EAX to R_EDI do
- if regCounter in usedRegs then
- addRegDeallocFor(asmL,regCounter,lastP);
- End;
- {************************ Search the Label table ************************}
- Function FindLabel(L: tasmlabel; Var hp: Tai): Boolean;
- {searches for the specified label starting from hp as long as the
- encountered instructions are labels, to be able to optimize constructs like
- jne l2 jmp l2
- jmp l3 and l1:
- l1: l2:
- l2:}
- Var TempP: Tai;
- Begin
- TempP := hp;
- While Assigned(TempP) and
- (Tempp.typ In SkipInstr + [ait_label,ait_align]) Do
- If (Tempp.typ <> ait_Label) Or
- (Tai_label(Tempp).l <> L)
- Then GetNextInstruction(TempP, TempP)
- Else
- Begin
- hp := TempP;
- FindLabel := True;
- exit
- End;
- FindLabel := False;
- End;
- {************************ Some general functions ************************}
- Function TCh2Reg(Ch: TInsChange): TRegister;
- {converts a TChange variable to a TRegister}
- Begin
- If (Ch <= Ch_REDI) Then
- TCh2Reg := TRegister(Byte(Ch))
- Else
- If (Ch <= Ch_WEDI) Then
- TCh2Reg := TRegister(Byte(Ch) - Byte(Ch_REDI))
- Else
- If (Ch <= Ch_RWEDI) Then
- TCh2Reg := TRegister(Byte(Ch) - Byte(Ch_WEDI))
- Else
- If (Ch <= Ch_MEDI) Then
- TCh2Reg := TRegister(Byte(Ch) - Byte(Ch_RWEDI))
- Else InternalError($db)
- End;
- Function Reg32(Reg: TRegister): TRegister;
- {Returns the 32 bit component of Reg if it exists, otherwise Reg is returned}
- Begin
- Reg32 := Reg;
- If (Reg >= R_AX)
- Then
- If (Reg <= R_DI)
- Then Reg32 := Reg16ToReg32(Reg)
- Else
- If (Reg <= R_BL)
- Then Reg32 := Reg8toReg32(Reg);
- End;
- { inserts new_one between prev and foll }
- Procedure InsertLLItem(AsmL: TAAsmOutput; 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;
- Tai(new_one).fileinfo := Tai(foll).fileinfo;
- End;
- End
- Else asml.Concat(new_one)
- Else If Assigned(Foll) Then asml.Insert(new_one)
- End;
- {********************* Compare parts of Tai objects *********************}
- Function RegsSameSize(Reg1, Reg2: TRegister): Boolean;
- {returns true if Reg1 and Reg2 are of the same size (so if they're both
- 8bit, 16bit or 32bit)}
- Begin
- If (Reg1 <= R_EDI)
- Then RegsSameSize := (Reg2 <= R_EDI)
- Else
- If (Reg1 <= R_DI)
- Then RegsSameSize := (Reg2 in [R_AX..R_DI])
- Else
- If (Reg1 <= R_BL)
- Then RegsSameSize := (Reg2 in [R_AL..R_BL])
- Else RegsSameSize := False
- End;
- Procedure AddReg2RegInfo(OldReg, NewReg: TRegister; Var RegInfo: TRegInfo);
- {updates the ???RegsEncountered and ???2???Reg fields of RegInfo. Assumes that
- OldReg and NewReg have the same size (has to be chcked in advance with
- RegsSameSize) and that neither equals R_NO}
- Begin
- With RegInfo Do
- Begin
- NewRegsEncountered := NewRegsEncountered + [NewReg];
- OldRegsEncountered := OldRegsEncountered + [OldReg];
- New2OldReg[NewReg] := OldReg;
- Case OldReg Of
- R_EAX..R_EDI:
- Begin
- NewRegsEncountered := NewRegsEncountered + [Reg32toReg16(NewReg)];
- OldRegsEncountered := OldRegsEncountered + [Reg32toReg16(OldReg)];
- New2OldReg[Reg32toReg16(NewReg)] := Reg32toReg16(OldReg);
- If (NewReg in [R_EAX..R_EBX]) And
- (OldReg in [R_EAX..R_EBX]) Then
- Begin
- NewRegsEncountered := NewRegsEncountered + [Reg32toReg8(NewReg)];
- OldRegsEncountered := OldRegsEncountered + [Reg32toReg8(OldReg)];
- New2OldReg[Reg32toReg8(NewReg)] := Reg32toReg8(OldReg);
- End;
- End;
- R_AX..R_DI:
- Begin
- NewRegsEncountered := NewRegsEncountered + [Reg16toReg32(NewReg)];
- OldRegsEncountered := OldRegsEncountered + [Reg16toReg32(OldReg)];
- New2OldReg[Reg16toReg32(NewReg)] := Reg16toReg32(OldReg);
- If (NewReg in [R_AX..R_BX]) And
- (OldReg in [R_AX..R_BX]) Then
- Begin
- NewRegsEncountered := NewRegsEncountered + [Reg16toReg8(NewReg)];
- OldRegsEncountered := OldRegsEncountered + [Reg16toReg8(OldReg)];
- New2OldReg[Reg16toReg8(NewReg)] := Reg16toReg8(OldReg);
- End;
- End;
- R_AL..R_BL:
- Begin
- NewRegsEncountered := NewRegsEncountered + [Reg8toReg32(NewReg)]
- + [Reg8toReg16(NewReg)];
- OldRegsEncountered := OldRegsEncountered + [Reg8toReg32(OldReg)]
- + [Reg8toReg16(OldReg)];
- New2OldReg[Reg8toReg32(NewReg)] := Reg8toReg32(OldReg);
- End;
- End;
- End;
- End;
- Procedure AddOp2RegInfo(const o:Toper; Var RegInfo: TRegInfo);
- Begin
- Case o.typ Of
- Top_Reg:
- If (o.reg <> R_NO) Then
- AddReg2RegInfo(o.reg, o.reg, RegInfo);
- Top_Ref:
- Begin
- If o.ref^.base <> R_NO Then
- AddReg2RegInfo(o.ref^.base, o.ref^.base, RegInfo);
- If o.ref^.index <> R_NO Then
- AddReg2RegInfo(o.ref^.index, o.ref^.index, RegInfo);
- End;
- End;
- End;
- Function RegsEquivalent(OldReg, NewReg: TRegister; Var RegInfo: TRegInfo; OPAct: TOpAction): Boolean;
- Begin
- If Not((OldReg = R_NO) Or (NewReg = R_NO)) Then
- If RegsSameSize(OldReg, NewReg) Then
- With RegInfo Do
- {here we always check for the 32 bit component, because it is possible that
- the 8 bit component has not been set, event though NewReg already has been
- processed. This happens if it has been compared with a register that doesn't
- have an 8 bit component (such as EDI). In that case the 8 bit component is
- still set to R_NO and the comparison in the Else-part will fail}
- If (Reg32(OldReg) in OldRegsEncountered) Then
- If (Reg32(NewReg) in NewRegsEncountered) Then
- RegsEquivalent := (OldReg = New2OldReg[NewReg])
- { If we haven't encountered the new register yet, but we have encountered the
- old one already, the new one can only be correct if it's being written to
- (and consequently the old one is also being written to), otherwise
- movl -8(%ebp), %eax and movl -8(%ebp), %eax
- movl (%eax), %eax movl (%edx), %edx
- are considered equivalent}
- Else
- If (OpAct = OpAct_Write) Then
- Begin
- AddReg2RegInfo(OldReg, NewReg, RegInfo);
- RegsEquivalent := True
- End
- Else Regsequivalent := False
- Else
- If Not(Reg32(NewReg) in NewRegsEncountered) and
- ((OpAct = OpAct_Write) or
- (newReg = oldReg)) Then
- Begin
- AddReg2RegInfo(OldReg, NewReg, RegInfo);
- RegsEquivalent := True
- End
- Else RegsEquivalent := False
- Else RegsEquivalent := False
- Else RegsEquivalent := OldReg = NewReg
- End;
- Function RefsEquivalent(Const R1, R2: TReference; var RegInfo: TRegInfo; OpAct: TOpAction): Boolean;
- Begin
- If R1.is_immediate Then
- RefsEquivalent := R2.is_immediate and (R1.Offset = R2.Offset)
- Else
- RefsEquivalent := (R1.Offset+R1.OffsetFixup = R2.Offset+R2.OffsetFixup) And
- RegsEquivalent(R1.Base, R2.Base, RegInfo, OpAct) And
- RegsEquivalent(R1.Index, R2.Index, RegInfo, OpAct) And
- (R1.Segment = R2.Segment) And (R1.ScaleFactor = R2.ScaleFactor) And
- (R1.Symbol = R2.Symbol);
- End;
- Function RefsEqual(Const R1, R2: TReference): Boolean;
- Begin
- If R1.is_immediate Then
- RefsEqual := R2.is_immediate and (R1.Offset = R2.Offset)
- Else
- RefsEqual := (R1.Offset+R1.OffsetFixup = R2.Offset+R2.OffsetFixup) And
- (R1.Segment = R2.Segment) And (R1.Base = R2.Base) And
- (R1.Index = R2.Index) And (R1.ScaleFactor = R2.ScaleFactor) And
- (R1.Symbol=R2.Symbol);
- End;
- Function IsGP32Reg(Reg: TRegister): Boolean;
- {Checks if the register is a 32 bit general purpose register}
- Begin
- If (Reg >= R_EAX) and (Reg <= R_EBX)
- Then IsGP32Reg := True
- Else IsGP32reg := False
- End;
- Function RegInRef(Reg: TRegister; Const Ref: TReference): Boolean;
- Begin {checks whether Ref contains a reference to Reg}
- Reg := Reg32(Reg);
- RegInRef := (Ref.Base = Reg) Or (Ref.Index = Reg)
- End;
- function RegReadByInstruction(reg: TRegister; hp: Tai): boolean;
- var p: Taicpu;
- opCount: byte;
- begin
- RegReadByInstruction := false;
- reg := reg32(reg);
- p := Taicpu(hp);
- if hp.typ <> ait_instruction then
- exit;
- case p.opcode of
- A_IMUL:
- case p.ops of
- 1: regReadByInstruction := (reg = R_EAX) or reginOp(reg,p.oper[0]);
- 2,3:
- regReadByInstruction := regInOp(reg,p.oper[0]) or
- regInOp(reg,p.oper[1]);
- end;
- A_IDIV,A_DIV,A_MUL:
- begin
- regReadByInstruction :=
- regInOp(reg,p.oper[0]) or (reg = R_EAX);
- end;
- else
- begin
- for opCount := 0 to 2 do
- if (p.oper[opCount].typ = top_ref) and
- RegInRef(reg,p.oper[opCount].ref^) then
- begin
- RegReadByInstruction := true;
- exit
- end;
- for opCount := 1 to MaxCh do
- case InsProp[p.opcode].Ch[opCount] of
- Ch_REAX..CH_REDI,CH_RWEAX..Ch_MEDI:
- if reg = TCh2Reg(InsProp[p.opcode].Ch[opCount]) then
- begin
- RegReadByInstruction := true;
- exit
- end;
- Ch_RWOp1,Ch_ROp1,Ch_MOp1:
- if (p.oper[0].typ = top_reg) and
- (reg32(p.oper[0].reg) = reg) then
- begin
- RegReadByInstruction := true;
- exit
- end;
- Ch_RWOp2,Ch_ROp2,Ch_MOp2:
- if (p.oper[1].typ = top_reg) and
- (reg32(p.oper[1].reg) = reg) then
- begin
- RegReadByInstruction := true;
- exit
- end;
- Ch_RWOp3,Ch_ROp3,Ch_MOp3:
- if (p.oper[2].typ = top_reg) and
- (reg32(p.oper[2].reg) = reg) then
- begin
- RegReadByInstruction := true;
- exit
- end;
- end;
- end;
- end;
- end;
- function regInInstruction(Reg: TRegister; p1: Tai): Boolean;
- { Checks if Reg is used by the instruction p1 }
- { Difference with "regReadBysinstruction() or regModifiedByInstruction()": }
- { this one ignores CH_ALL opcodes, while regModifiedByInstruction doesn't }
- var p: Taicpu;
- opCount: byte;
- begin
- reg := reg32(reg);
- regInInstruction := false;
- p := Taicpu(p1);
- if p1.typ <> ait_instruction then
- exit;
- case p.opcode of
- A_IMUL:
- case p.ops of
- 1: regInInstruction := (reg = R_EAX) or reginOp(reg,p.oper[0]);
- 2,3:
- regInInstruction := regInOp(reg,p.oper[0]) or
- regInOp(reg,p.oper[1]) or regInOp(reg,p.oper[2]);
- end;
- A_IDIV,A_DIV,A_MUL:
- regInInstruction :=
- regInOp(reg,p.oper[0]) or
- (reg = R_EAX) or (reg = R_EDX)
- else
- begin
- for opCount := 1 to MaxCh do
- case InsProp[p.opcode].Ch[opCount] of
- CH_REAX..CH_MEDI:
- if tch2reg(InsProp[p.opcode].Ch[opCount]) = reg then
- begin
- regInInstruction := true;
- exit;
- end;
- Ch_ROp1..Ch_MOp1:
- if regInOp(reg,p.oper[0]) then
- begin
- regInInstruction := true;
- exit
- end;
- Ch_ROp2..Ch_MOp2:
- if regInOp(reg,p.oper[1]) then
- begin
- regInInstruction := true;
- exit
- end;
- Ch_ROp3..Ch_MOp3:
- if regInOp(reg,p.oper[2]) then
- begin
- regInInstruction := true;
- exit
- end;
- end;
- end;
- end;
- end;
- Function RegInOp(Reg: TRegister; const o:toper): Boolean;
- Begin
- RegInOp := False;
- reg := reg32(reg);
- Case o.typ Of
- top_reg: RegInOp := Reg = reg32(o.reg);
- top_ref: RegInOp := (Reg = o.ref^.Base) Or
- (Reg = o.ref^.Index);
- End;
- End;
- Function RegModifiedByInstruction(Reg: TRegister; p1: Tai): Boolean;
- Var InstrProp: TInsProp;
- TmpResult: Boolean;
- Cnt: Byte;
- Begin
- TmpResult := False;
- Reg := Reg32(Reg);
- If (p1.typ = ait_instruction) Then
- Case Taicpu(p1).opcode of
- A_IMUL:
- With Taicpu(p1) Do
- TmpResult :=
- ((ops = 1) and (reg in [R_EAX,R_EDX])) or
- ((ops = 2) and (Reg32(oper[1].reg) = reg)) or
- ((ops = 3) and (Reg32(oper[2].reg) = reg));
- A_DIV, A_IDIV, A_MUL:
- With Taicpu(p1) Do
- TmpResult :=
- (Reg = R_EAX) or
- (Reg = R_EDX);
- Else
- Begin
- Cnt := 1;
- InstrProp := InsProp[Taicpu(p1).OpCode];
- While (Cnt <= MaxCh) And
- (InstrProp.Ch[Cnt] <> Ch_None) And
- Not(TmpResult) Do
- Begin
- Case InstrProp.Ch[Cnt] Of
- Ch_WEAX..Ch_MEDI:
- TmpResult := Reg = TCh2Reg(InstrProp.Ch[Cnt]);
- Ch_RWOp1,Ch_WOp1,Ch_Mop1:
- TmpResult := (Taicpu(p1).oper[0].typ = top_reg) and
- (Reg32(Taicpu(p1).oper[0].reg) = reg);
- Ch_RWOp2,Ch_WOp2,Ch_Mop2:
- TmpResult := (Taicpu(p1).oper[1].typ = top_reg) and
- (Reg32(Taicpu(p1).oper[1].reg) = reg);
- Ch_RWOp3,Ch_WOp3,Ch_Mop3:
- TmpResult := (Taicpu(p1).oper[2].typ = top_reg) and
- (Reg32(Taicpu(p1).oper[2].reg) = reg);
- Ch_FPU: TmpResult := Reg in [R_ST..R_ST7,R_MM0..R_MM7];
- Ch_ALL: TmpResult := true;
- End;
- Inc(Cnt)
- End
- End
- End;
- RegModifiedByInstruction := TmpResult
- End;
- function instrWritesFlags(p: Tai): boolean;
- var
- l: longint;
- begin
- instrWritesFlags := true;
- case p.typ of
- ait_instruction:
- begin
- for l := 1 to MaxCh do
- if InsProp[Taicpu(p).opcode].Ch[l] in [Ch_WFlags,Ch_RWFlags,Ch_All] then
- exit;
- end;
- ait_label:
- exit;
- else
- instrWritesFlags := false;
- end;
- end;
- function instrReadsFlags(p: Tai): boolean;
- var
- l: longint;
- begin
- instrReadsFlags := true;
- case p.typ of
- ait_instruction:
- begin
- for l := 1 to MaxCh do
- if InsProp[Taicpu(p).opcode].Ch[l] in [Ch_RFlags,Ch_RWFlags,Ch_All] then
- exit;
- end;
- ait_label:
- exit;
- else
- instrReadsFlags := false;
- end;
- end;
- {********************* GetNext and GetLastInstruction *********************}
- Function GetNextInstruction(Current: Tai; Var Next: Tai): Boolean;
- { skips ait_regalloc, ait_regdealloc and ait_stab* objects and puts the }
- { next Tai object in Next. Returns false if there isn't any }
- Begin
- Repeat
- If (Current.typ = ait_marker) And
- (Tai_Marker(current).Kind = AsmBlockStart) Then
- Begin
- GetNextInstruction := False;
- Next := Nil;
- Exit
- End;
- Current := Tai(current.Next);
- While Assigned(Current) And
- ((current.typ In skipInstr) or
- ((current.typ = ait_label) and
- labelCanBeSkipped(Tai_label(current)))) do
- Current := Tai(current.Next);
- { If Assigned(Current) And
- (current.typ = ait_Marker) And
- (Tai_Marker(current).Kind = NoPropInfoStart) Then
- Begin
- While Assigned(Current) And
- ((current.typ <> ait_Marker) Or
- (Tai_Marker(current).Kind <> NoPropInfoEnd)) Do
- Current := Tai(current.Next);
- End;}
- Until Not(Assigned(Current)) Or
- (current.typ <> ait_Marker) Or
- not(Tai_Marker(current).Kind in [NoPropInfoStart,NoPropInfoEnd]);
- Next := Current;
- If Assigned(Current) And
- Not((current.typ In SkipInstr) or
- ((current.typ = ait_label) And
- labelCanBeSkipped(Tai_label(current))))
- Then
- GetNextInstruction :=
- not((current.typ = ait_marker) and
- (Tai_marker(current).kind = asmBlockStart))
- Else
- Begin
- GetNextInstruction := False;
- Next := nil;
- End;
- End;
- Function GetLastInstruction(Current: Tai; Var Last: Tai): Boolean;
- {skips the ait-types in SkipInstr puts the previous Tai object in
- Last. Returns false if there isn't any}
- Begin
- Repeat
- Current := Tai(current.previous);
- While Assigned(Current) And
- (((current.typ = ait_Marker) And
- Not(Tai_Marker(current).Kind in [AsmBlockEnd{,NoPropInfoEnd}])) or
- (current.typ In SkipInstr) or
- ((current.typ = ait_label) And
- labelCanBeSkipped(Tai_label(current)))) Do
- Current := Tai(current.previous);
- { If Assigned(Current) And
- (current.typ = ait_Marker) And
- (Tai_Marker(current).Kind = NoPropInfoEnd) Then
- Begin
- While Assigned(Current) And
- ((current.typ <> ait_Marker) Or
- (Tai_Marker(current).Kind <> NoPropInfoStart)) Do
- Current := Tai(current.previous);
- End;}
- Until Not(Assigned(Current)) Or
- (current.typ <> ait_Marker) Or
- not(Tai_Marker(current).Kind in [NoPropInfoStart,NoPropInfoEnd]);
- If Not(Assigned(Current)) or
- (current.typ In SkipInstr) or
- ((current.typ = ait_label) And
- labelCanBeSkipped(Tai_label(current))) or
- ((current.typ = ait_Marker) And
- (Tai_Marker(current).Kind = AsmBlockEnd))
- Then
- Begin
- Last := nil;
- GetLastInstruction := False
- End
- Else
- Begin
- Last := Current;
- GetLastInstruction := True;
- End;
- End;
- Procedure SkipHead(var P: Tai);
- Var OldP: Tai;
- Begin
- Repeat
- OldP := P;
- If (p.typ in SkipInstr) Or
- ((p.typ = ait_marker) And
- (Tai_Marker(p).Kind in [AsmBlockEnd,inlinestart,inlineend])) Then
- GetNextInstruction(P, P)
- Else If ((p.Typ = Ait_Marker) And
- (Tai_Marker(p).Kind = nopropinfostart)) Then
- {a marker of the NoPropInfoStart can't be the first instruction of a
- TAAsmoutput list}
- GetNextInstruction(Tai(p.Previous),P);
- Until P = OldP
- End;
- function labelCanBeSkipped(p: Tai_label): boolean;
- begin
- labelCanBeSkipped := not(p.l.is_used) or p.l.is_addr;
- end;
- {******************* The Data Flow Analyzer functions ********************}
- function regLoadedWithNewValue(reg: tregister; canDependOnPrevValue: boolean;
- hp: Tai): boolean;
- { assumes reg is a 32bit register }
- var p: Taicpu;
- begin
- p := Taicpu(hp);
- regLoadedWithNewValue :=
- assigned(hp) and
- (hp.typ = ait_instruction) and
- (((p.opcode = A_MOV) or
- (p.opcode = A_MOVZX) or
- (p.opcode = A_MOVSX) or
- (p.opcode = A_LEA)) and
- (p.oper[1].typ = top_reg) and
- (Reg32(p.oper[1].reg) = reg) and
- (canDependOnPrevValue or
- (p.oper[0].typ <> top_ref) or
- not regInRef(reg,p.oper[0].ref^)) or
- ((p.opcode = A_POP) and
- (Reg32(p.oper[0].reg) = reg)));
- end;
- Procedure UpdateUsedRegs(Var UsedRegs: TRegSet; 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
- labelCanBeSkipped(Tai_label(p)))) Do
- p := Tai(p.next);
- While Assigned(p) And
- (p.typ=ait_RegAlloc) Do
- Begin
- if Tairegalloc(p).allocation then
- UsedRegs := UsedRegs + [TaiRegAlloc(p).Reg]
- else
- UsedRegs := UsedRegs - [TaiRegAlloc(p).Reg];
- p := Tai(p.next);
- End;
- Until Not(Assigned(p)) Or
- (Not(p.typ in SkipInstr) And
- Not((p.typ = ait_label) And
- labelCanBeSkipped(Tai_label(p))));
- End;
- Procedure AllocRegBetween(AsmL: TAAsmOutput; Reg: TRegister; p1, p2: Tai);
- { allocates register Reg between (and including) instructions p1 and p2 }
- { the type of p1 and p2 must not be in SkipInstr }
- var
- hp, start: Tai;
- lastRemovedWasDealloc, firstRemovedWasAlloc, first: boolean;
- Begin
- If not(reg in usableregs+[R_EDI,R_ESI]) or
- not(assigned(p1)) then
- { this happens with registers which are loaded implicitely, outside the }
- { current block (e.g. esi with self) }
- exit;
- { make sure we allocate it for this instruction }
- if p1 = p2 then
- getnextinstruction(p2,p2);
- lastRemovedWasDealloc := false;
- firstRemovedWasAlloc := false;
- first := true;
- {$ifdef allocregdebug}
- hp := Tai_asm_comment.Create(strpnew('allocating '+att_reg2str[reg]+
- ' from here...')));
- insertllitem(asml,p1.previous,p1,hp);
- hp := Tai_asm_comment.Create(strpnew('allocated '+att_reg2str[reg]+
- ' till here...')));
- insertllitem(asml,p2,p1.next,hp);
- {$endif allocregdebug}
- start := p1;
- Repeat
- If Assigned(p1.OptInfo) Then
- Include(PTaiProp(p1.OptInfo)^.UsedRegs,Reg);
- p1 := Tai(p1.next);
- Repeat
- While assigned(p1) and
- (p1.typ in (SkipInstr-[ait_regalloc])) Do
- p1 := Tai(p1.next);
- { remove all allocation/deallocation info about the register in between }
- If assigned(p1) and
- (p1.typ = ait_regalloc) Then
- If (TaiRegAlloc(p1).Reg = Reg) Then
- Begin
- if first then
- begin
- firstRemovedWasAlloc := TaiRegAlloc(p1).allocation;
- first := false;
- end;
- lastRemovedWasDealloc := not TaiRegAlloc(p1).allocation;
- hp := Tai(p1.Next);
- asml.Remove(p1);
- p1.free;
- p1 := hp;
- End
- Else p1 := Tai(p1.next);
- Until not(assigned(p1)) or
- Not(p1.typ in SkipInstr);
- Until not(assigned(p1)) or
- (p1 = p2);
- if assigned(p1) then
- begin
- if assigned(p1.optinfo) then
- include(PTaiProp(p1.OptInfo)^.UsedRegs,Reg);
- if lastRemovedWasDealloc then
- begin
- hp := TaiRegalloc.DeAlloc(reg);
- insertLLItem(asmL,p1,p1.next,hp);
- end;
- end;
- if firstRemovedWasAlloc then
- begin
- hp := TaiRegalloc.Alloc(reg);
- insertLLItem(asmL,start.previous,start,hp);
- end;
- End;
- function FindRegDealloc(reg: tregister; p: Tai): boolean;
- { assumes reg is a 32bit register }
- var
- hp: Tai;
- first: boolean;
- begin
- findregdealloc := false;
- first := true;
- while assigned(p.previous) and
- ((Tai(p.previous).typ in (skipinstr+[ait_align])) or
- ((Tai(p.previous).typ = ait_label) and
- labelCanBeSkipped(Tai_label(p.previous)))) do
- begin
- p := Tai(p.previous);
- if (p.typ = ait_regalloc) and
- (Tairegalloc(p).reg = reg) then
- if not(Tairegalloc(p).allocation) then
- if first then
- begin
- findregdealloc := true;
- break;
- end
- else
- begin
- findRegDealloc :=
- getNextInstruction(p,hp) and
- regLoadedWithNewValue(reg,false,hp);
- break
- end
- else
- first := false;
- end
- end;
- Procedure IncState(Var S: Byte; amount: longint);
- {Increases S by 1, wraps around at $ffff to 0 (so we won't get overflow
- errors}
- Begin
- if (s <= $ff - amount) then
- inc(s, amount)
- else s := longint(s) + amount - $ff;
- End;
- Function sequenceDependsonReg(Const Content: TContent; seqReg, Reg: TRegister): Boolean;
- { Content is the sequence of instructions that describes the contents of }
- { seqReg. Reg is being overwritten by the current instruction. If the }
- { content of seqReg depends on reg (ie. because of a }
- { "movl (seqreg,reg), seqReg" instruction), this function returns true }
- Var p: Tai;
- Counter: Byte;
- TmpResult: Boolean;
- RegsChecked: TRegSet;
- Begin
- RegsChecked := [];
- p := Content.StartMod;
- TmpResult := False;
- Counter := 1;
- While Not(TmpResult) And
- (Counter <= Content.NrOfMods) Do
- Begin
- If (p.typ = ait_instruction) and
- ((Taicpu(p).opcode = A_MOV) or
- (Taicpu(p).opcode = A_MOVZX) or
- (Taicpu(p).opcode = A_MOVSX) or
- (Taicpu(p).opcode = A_LEA)) and
- (Taicpu(p).oper[0].typ = top_ref) Then
- With Taicpu(p).oper[0].ref^ Do
- If ((Base = procinfo^.FramePointer) or
- (assigned(symbol) and (base = R_NO))) And
- (Index = R_NO) Then
- Begin
- RegsChecked := RegsChecked + [Reg32(Taicpu(p).oper[1].reg)];
- If Reg = Reg32(Taicpu(p).oper[1].reg) Then
- Break;
- End
- Else
- tmpResult :=
- regReadByInstruction(reg,p) and
- regModifiedByInstruction(seqReg,p)
- Else
- tmpResult :=
- regReadByInstruction(reg,p) and
- regModifiedByInstruction(seqReg,p);
- Inc(Counter);
- GetNextInstruction(p,p)
- End;
- sequenceDependsonReg := TmpResult
- End;
- procedure invalidateDependingRegs(p1: pTaiProp; reg: tregister);
- var
- counter: tregister;
- begin
- for counter := R_EAX to R_EDI Do
- if counter <> reg then
- with p1^.regs[counter] Do
- begin
- if (typ in [con_ref,con_noRemoveRef]) and
- sequenceDependsOnReg(p1^.Regs[counter],counter,reg) then
- if typ in [con_ref,con_invalid] then
- typ := con_invalid
- { con_invalid and con_noRemoveRef = con_unknown }
- else typ := con_unknown;
- if assigned(memwrite) and
- regInRef(counter,memwrite.oper[1].ref^) then
- memwrite := nil;
- end;
- end;
- Procedure DestroyReg(p1: PTaiProp; Reg: TRegister; doIncState:Boolean);
- {Destroys the contents of the register Reg in the PTaiProp p1, as well as the
- contents of registers are loaded with a memory location based on Reg.
- doIncState is false when this register has to be destroyed not because
- it's contents are directly modified/overwritten, but because of an indirect
- action (e.g. this register holds the contents of a variable and the value
- of the variable in memory is changed) }
- Begin
- Reg := Reg32(Reg);
- { the following happens for fpu registers }
- if (reg < low(NrOfInstrSinceLastMod)) or
- (reg > high(NrOfInstrSinceLastMod)) then
- exit;
- NrOfInstrSinceLastMod[Reg] := 0;
- if (reg >= R_EAX) and (reg <= R_EDI) then
- begin
- with p1^.regs[reg] do
- begin
- if doIncState then
- begin
- incState(wstate,1);
- typ := con_unknown;
- end
- else
- if typ in [con_ref,con_invalid] then
- typ := con_invalid
- { con_invalid and con_noRemoveRef = con_unknown }
- else typ := con_unknown;
- memwrite := nil;
- end;
- invalidateDependingRegs(p1,reg);
- end;
- End;
- {Procedure AddRegsToSet(p: Tai; Var RegSet: TRegSet);
- Begin
- If (p.typ = ait_instruction) Then
- Begin
- Case Taicpu(p).oper[0].typ Of
- top_reg:
- If Not(Taicpu(p).oper[0].reg in [R_NO,R_ESP,procinfo^.FramePointer]) Then
- RegSet := RegSet + [Taicpu(p).oper[0].reg];
- top_ref:
- With TReference(Taicpu(p).oper[0]^) Do
- Begin
- If Not(Base in [procinfo^.FramePointer,R_NO,R_ESP])
- Then RegSet := RegSet + [Base];
- If Not(Index in [procinfo^.FramePointer,R_NO,R_ESP])
- Then RegSet := RegSet + [Index];
- End;
- End;
- Case Taicpu(p).oper[1].typ Of
- top_reg:
- If Not(Taicpu(p).oper[1].reg in [R_NO,R_ESP,procinfo^.FramePointer]) Then
- If RegSet := RegSet + [TRegister(TwoWords(Taicpu(p).oper[1]).Word1];
- top_ref:
- With TReference(Taicpu(p).oper[1]^) Do
- Begin
- If Not(Base in [procinfo^.FramePointer,R_NO,R_ESP])
- Then RegSet := RegSet + [Base];
- If Not(Index in [procinfo^.FramePointer,R_NO,R_ESP])
- Then RegSet := RegSet + [Index];
- End;
- End;
- End;
- End;}
- Function OpsEquivalent(const o1, o2: toper; Var RegInfo: TRegInfo; OpAct: TopAction): Boolean;
- Begin {checks whether the two ops are equivalent}
- OpsEquivalent := False;
- if o1.typ=o2.typ then
- Case o1.typ Of
- Top_Reg:
- OpsEquivalent :=RegsEquivalent(o1.reg,o2.reg, RegInfo, OpAct);
- Top_Ref:
- OpsEquivalent := RefsEquivalent(o1.ref^, o2.ref^, RegInfo, OpAct);
- Top_Const:
- OpsEquivalent := o1.val = o2.val;
- Top_None:
- OpsEquivalent := True
- End;
- End;
- Function OpsEqual(const o1,o2:toper): Boolean;
- Begin {checks whether the two ops are equal}
- OpsEqual := False;
- if o1.typ=o2.typ then
- Case o1.typ Of
- Top_Reg :
- OpsEqual:=o1.reg=o2.reg;
- Top_Ref :
- OpsEqual := RefsEqual(o1.ref^, o2.ref^);
- Top_Const :
- OpsEqual:=o1.val=o2.val;
- Top_Symbol :
- OpsEqual:=(o1.sym=o2.sym) and (o1.symofs=o2.symofs);
- Top_None :
- OpsEqual := True
- End;
- End;
- function sizescompatible(loadsize,newsize: topsize): boolean;
- begin
- case loadsize of
- S_B,S_BW,S_BL:
- sizescompatible := (newsize = loadsize) or (newsize = S_B);
- S_W,S_WL:
- sizescompatible := (newsize = loadsize) or (newsize = S_W);
- else
- sizescompatible := newsize = S_L;
- end;
- end;
- function opscompatible(p1,p2: Taicpu): boolean;
- begin
- case p1.opcode of
- A_MOVZX,A_MOVSX:
- opscompatible :=
- ((p2.opcode = p1.opcode) or (p2.opcode = A_MOV)) and
- sizescompatible(p1.opsize,p2.opsize);
- else
- opscompatible :=
- (p1.opcode = p2.opcode) and
- (p1.opsize = p2.opsize);
- end;
- end;
- Function InstructionsEquivalent(p1, p2: Tai; Var RegInfo: TRegInfo): Boolean;
- {$ifdef csdebug}
- var
- hp: Tai;
- {$endif csdebug}
- Begin {checks whether two Taicpu instructions are equal}
- If Assigned(p1) And Assigned(p2) And
- (Tai(p1).typ = ait_instruction) And
- (Tai(p1).typ = ait_instruction) And
- opscompatible(Taicpu(p1),Taicpu(p2)) and
- (Taicpu(p1).oper[0].typ = Taicpu(p2).oper[0].typ) And
- (Taicpu(p1).oper[1].typ = Taicpu(p2).oper[1].typ) And
- (Taicpu(p1).oper[2].typ = Taicpu(p2).oper[2].typ)
- Then
- {both instructions have the same structure:
- "<operator> <operand of type1>, <operand of type 2>"}
- If ((Taicpu(p1).opcode = A_MOV) or
- (Taicpu(p1).opcode = A_MOVZX) or
- (Taicpu(p1).opcode = A_MOVSX) or
- (Taicpu(p1).opcode = A_LEA)) And
- (Taicpu(p1).oper[0].typ = top_ref) {then .oper[1]t = top_reg} Then
- If Not(RegInRef(Taicpu(p1).oper[1].reg, Taicpu(p1).oper[0].ref^)) Then
- {the "old" instruction is a load of a register with a new value, not with
- a value based on the contents of this register (so no "mov (reg), reg")}
- If Not(RegInRef(Taicpu(p2).oper[1].reg, Taicpu(p2).oper[0].ref^)) And
- RefsEqual(Taicpu(p1).oper[0].ref^, Taicpu(p2).oper[0].ref^)
- Then
- {the "new" instruction is also a load of a register with a new value, and
- this value is fetched from the same memory location}
- Begin
- With Taicpu(p2).oper[0].ref^ Do
- Begin
- If Not(Base in [procinfo^.FramePointer, R_NO, R_ESP]) Then
- RegInfo.RegsLoadedForRef := RegInfo.RegsLoadedForRef + [Base];
- If Not(Index in [procinfo^.FramePointer, R_NO, R_ESP]) Then
- RegInfo.RegsLoadedForRef := RegInfo.RegsLoadedForRef + [Index];
- End;
- {add the registers from the reference (.oper[0]) to the RegInfo, all registers
- from the reference are the same in the old and in the new instruction
- sequence}
- AddOp2RegInfo(Taicpu(p1).oper[0], RegInfo);
- {the registers from .oper[1] have to be equivalent, but not necessarily equal}
- InstructionsEquivalent :=
- RegsEquivalent(reg32(Taicpu(p1).oper[1].reg),
- reg32(Taicpu(p2).oper[1].reg), RegInfo, OpAct_Write);
- End
- {the registers are loaded with values from different memory locations. If
- this was allowed, the instructions "mov -4(esi),eax" and "mov -4(ebp),eax"
- would be considered equivalent}
- Else InstructionsEquivalent := False
- Else
- {load register with a value based on the current value of this register}
- Begin
- With Taicpu(p2).oper[0].ref^ Do
- Begin
- If Not(Base in [procinfo^.FramePointer,
- Reg32(Taicpu(p2).oper[1].reg),R_NO,R_ESP]) Then
- {it won't do any harm if the register is already in RegsLoadedForRef}
- Begin
- RegInfo.RegsLoadedForRef := RegInfo.RegsLoadedForRef + [Base];
- {$ifdef csdebug}
- Writeln(att_reg2str[base], ' added');
- {$endif csdebug}
- end;
- If Not(Index in [procinfo^.FramePointer,
- Reg32(Taicpu(p2).oper[1].reg),R_NO,R_ESP]) Then
- Begin
- RegInfo.RegsLoadedForRef := RegInfo.RegsLoadedForRef + [Index];
- {$ifdef csdebug}
- Writeln(att_reg2str[index], ' added');
- {$endif csdebug}
- end;
- End;
- If Not(Reg32(Taicpu(p2).oper[1].reg) In [procinfo^.FramePointer,R_NO,R_ESP])
- Then
- Begin
- RegInfo.RegsLoadedForRef := RegInfo.RegsLoadedForRef -
- [Reg32(Taicpu(p2).oper[1].reg)];
- {$ifdef csdebug}
- Writeln(att_reg2str[Reg32(Taicpu(p2).oper[1].reg)], ' removed');
- {$endif csdebug}
- end;
- InstructionsEquivalent :=
- OpsEquivalent(Taicpu(p1).oper[0], Taicpu(p2).oper[0], RegInfo, OpAct_Read) And
- OpsEquivalent(Taicpu(p1).oper[1], Taicpu(p2).oper[1], RegInfo, OpAct_Write)
- End
- Else
- {an instruction <> mov, movzx, movsx}
- begin
- {$ifdef csdebug}
- hp := Tai_asm_comment.Create(strpnew('checking if equivalent'));
- hp.previous := p2;
- hp.next := p2^.next;
- p2^.next^.previous := hp;
- p2^.next := hp;
- {$endif csdebug}
- InstructionsEquivalent :=
- OpsEquivalent(Taicpu(p1).oper[0], Taicpu(p2).oper[0], RegInfo, OpAct_Unknown) And
- OpsEquivalent(Taicpu(p1).oper[1], Taicpu(p2).oper[1], RegInfo, OpAct_Unknown) And
- OpsEquivalent(Taicpu(p1).oper[2], Taicpu(p2).oper[2], RegInfo, OpAct_Unknown)
- end
- {the instructions haven't even got the same structure, so they're certainly
- not equivalent}
- Else
- begin
- {$ifdef csdebug}
- hp := Tai_asm_comment.Create(strpnew('different opcodes/format'));
- hp.previous := p2;
- hp.next := p2^.next;
- p2^.next^.previous := hp;
- p2^.next := hp;
- {$endif csdebug}
- InstructionsEquivalent := False;
- end;
- {$ifdef csdebug}
- hp := Tai_asm_comment.Create(strpnew('instreq: '+tostr(byte(instructionsequivalent))));
- hp.previous := p2;
- hp.next := p2^.next;
- p2^.next^.previous := hp;
- p2^.next := hp;
- {$endif csdebug}
- End;
- (*
- Function InstructionsEqual(p1, p2: Tai): Boolean;
- Begin {checks whether two Taicpu instructions are equal}
- InstructionsEqual :=
- Assigned(p1) And Assigned(p2) And
- ((Tai(p1).typ = ait_instruction) And
- (Tai(p1).typ = ait_instruction) And
- (Taicpu(p1).opcode = Taicpu(p2).opcode) And
- (Taicpu(p1).oper[0].typ = Taicpu(p2).oper[0].typ) And
- (Taicpu(p1).oper[1].typ = Taicpu(p2).oper[1].typ) And
- OpsEqual(Taicpu(p1).oper[0].typ, Taicpu(p1).oper[0], Taicpu(p2).oper[0]) And
- OpsEqual(Taicpu(p1).oper[1].typ, Taicpu(p1).oper[1], Taicpu(p2).oper[1]))
- End;
- *)
- Procedure ReadReg(p: PTaiProp; Reg: TRegister);
- Begin
- Reg := Reg32(Reg);
- If Reg in [R_EAX..R_EDI] Then
- incState(p^.regs[Reg].rstate,1)
- End;
- Procedure ReadRef(p: PTaiProp; Ref: PReference);
- Begin
- If Ref^.Base <> R_NO Then
- ReadReg(p, Ref^.Base);
- If Ref^.Index <> R_NO Then
- ReadReg(p, Ref^.Index);
- End;
- Procedure ReadOp(P: PTaiProp;const o:toper);
- Begin
- Case o.typ Of
- top_reg: ReadReg(P, o.reg);
- top_ref: ReadRef(P, o.ref);
- top_symbol : ;
- End;
- End;
- Function RefInInstruction(Const Ref: TReference; p: Tai;
- RefsEq: TRefCompare): Boolean;
- {checks whehter Ref is used in P}
- Var TmpResult: Boolean;
- Begin
- TmpResult := False;
- If (p.typ = ait_instruction) Then
- Begin
- If (Taicpu(p).oper[0].typ = Top_Ref) Then
- TmpResult := RefsEq(Ref, Taicpu(p).oper[0].ref^);
- If Not(TmpResult) And (Taicpu(p).oper[1].typ = Top_Ref) Then
- TmpResult := RefsEq(Ref, Taicpu(p).oper[1].ref^);
- If Not(TmpResult) And (Taicpu(p).oper[2].typ = Top_Ref) Then
- TmpResult := RefsEq(Ref, Taicpu(p).oper[2].ref^);
- End;
- RefInInstruction := TmpResult;
- End;
- Function RefInSequence(Const Ref: TReference; Content: TContent;
- RefsEq: TRefCompare): Boolean;
- {checks the whole sequence of Content (so StartMod and and the next NrOfMods
- Tai objects) to see whether Ref is used somewhere}
- 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, RefsEq)
- Then TmpResult := True;
- Inc(Counter);
- GetNextInstruction(p,p)
- End;
- RefInSequence := TmpResult
- End;
- Function ArrayRefsEq(const r1, r2: TReference): Boolean;
- Begin
- ArrayRefsEq := (R1.Offset+R1.OffsetFixup = R2.Offset+R2.OffsetFixup) And
- (R1.Segment = R2.Segment) And
- (R1.Symbol=R2.Symbol) And
- (R1.Base = R2.Base)
- End;
- function isSimpleRef(const ref: treference): boolean;
- { returns true if ref is reference to a local or global variable, to a }
- { parameter or to an object field (this includes arrays). Returns false }
- { otherwise. }
- begin
- isSimpleRef :=
- assigned(ref.symbol) or
- (ref.base = procinfo^.framepointer) or
- (assigned(procinfo^._class) and
- (ref.base = R_ESI));
- end;
- function containsPointerRef(p: Tai): boolean;
- { checks if an instruction contains a reference which is a pointer location }
- var
- hp: Taicpu;
- count: longint;
- begin
- containsPointerRef := false;
- if p.typ <> ait_instruction then
- exit;
- hp := Taicpu(p);
- for count := low(hp.oper) to high(hp.oper) do
- begin
- case hp.oper[count].typ of
- top_ref:
- if not isSimpleRef(hp.oper[count].ref^) then
- begin
- containsPointerRef := true;
- exit;
- end;
- top_none:
- exit;
- end;
- end;
- end;
- function containsPointerLoad(c: tcontent): boolean;
- { checks whether the contents of a register contain a pointer reference }
- var
- p: Tai;
- count: longint;
- begin
- containsPointerLoad := false;
- p := c.startmod;
- for count := c.nrOfMods downto 1 do
- begin
- if containsPointerRef(p) then
- begin
- containsPointerLoad := true;
- exit;
- end;
- getnextinstruction(p,p);
- end;
- end;
- function writeToMemDestroysContents(regWritten: tregister; const ref: treference;
- reg: tregister; const c: tcontent; var invalsmemwrite: boolean): boolean;
- { returns whether the contents c of reg are invalid after regWritten is }
- { is written to ref }
- var
- refsEq: trefCompare;
- begin
- reg := reg32(reg);
- regWritten := reg32(regWritten);
- if isSimpleRef(ref) then
- begin
- if (ref.index <> R_NO) or
- (assigned(ref.symbol) and
- (ref.base <> R_NO)) then
- { local/global variable or parameter which is an array }
- refsEq := {$ifdef fpc}@{$endif}arrayRefsEq
- else
- { local/global variable or parameter which is not an array }
- refsEq := {$ifdef fpc}@{$endif}refsEqual;
- invalsmemwrite :=
- assigned(c.memwrite) and
- ((not(cs_uncertainOpts in aktglobalswitches) and
- containsPointerRef(c.memwrite)) or
- refsEq(c.memwrite.oper[1].ref^,ref));
- if not(c.typ in [con_ref,con_noRemoveRef,con_invalid]) then
- begin
- writeToMemDestroysContents := false;
- exit;
- end;
- { 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 }
- { expression based on Ref) }
- { * with uncertain optimizations off: }
- { - also destroy registers that contain any pointer }
- with c do
- writeToMemDestroysContents :=
- (typ in [con_ref,con_noRemoveRef]) and
- ((not(cs_uncertainOpts in aktglobalswitches) and
- containsPointerLoad(c)
- ) or
- (refInSequence(ref,c,refsEq) and
- ((reg <> regWritten) or
- not((nrOfMods = 1) and
- {StarMod is always of the type ait_instruction}
- (Taicpu(StartMod).oper[0].typ = top_ref) and
- refsEq(Taicpu(StartMod).oper[0].ref^, ref)
- )
- )
- )
- );
- 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 }
- begin
- invalsmemwrite :=
- assigned(c.memwrite) and
- (not(cs_UncertainOpts in aktglobalswitches) or
- containsPointerRef(c.memwrite));
- if not(c.typ in [con_ref,con_noRemoveRef,con_invalid]) then
- begin
- writeToMemDestroysContents := false;
- exit;
- end;
- with c do
- writeToMemDestroysContents :=
- (typ in [con_ref,con_noRemoveRef]) and
- (not(cs_UncertainOpts in aktglobalswitches) or
- { for movsl }
- ((ref.base = R_EDI) and (ref.index = R_EDI)) or
- { don't destroy if reg contains a parameter, local or global variable }
- containsPointerLoad(c)
- );
- end;
- end;
- function writeToRegDestroysContents(destReg: tregister; reg: tregister;
- const c: tcontent): boolean;
- { returns whether the contents c of reg are invalid after destReg is }
- { modified }
- begin
- writeToRegDestroysContents :=
- (c.typ in [con_ref,con_noRemoveRef,con_invalid]) and
- sequenceDependsOnReg(c,reg,reg32(destReg));
- end;
- function writeDestroysContents(const op: toper; reg: tregister;
- const c: tcontent): boolean;
- { returns whether the contents c of reg are invalid after regWritten is }
- { is written to op }
- var
- dummy: boolean;
- begin
- reg := reg32(reg);
- case op.typ of
- top_reg:
- writeDestroysContents :=
- writeToRegDestroysContents(op.reg,reg,c);
- top_ref:
- writeDestroysContents :=
- writeToMemDestroysContents(R_NO,op.ref^,reg,c,dummy);
- else
- writeDestroysContents := false;
- end;
- end;
- procedure destroyRefs(p: Tai; const ref: treference; regWritten: tregister);
- { destroys all registers which possibly contain a reference to Ref, regWritten }
- { is the register whose contents are being written to memory (if this proc }
- { is called because of a "mov?? %reg, (mem)" instruction) }
- var
- counter: TRegister;
- destroymemwrite: boolean;
- begin
- for counter := R_EAX to R_EDI Do
- begin
- if writeToMemDestroysContents(regWritten,ref,counter,
- pTaiProp(p.optInfo)^.regs[counter],destroymemwrite) then
- destroyReg(pTaiProp(p.optInfo), counter, false)
- else if destroymemwrite then
- pTaiProp(p.optinfo)^.regs[counter].MemWrite := nil;
- end;
- End;
- Procedure DestroyAllRegs(p: PTaiProp);
- Var Counter: TRegister;
- Begin {initializes/desrtoys all registers}
- For Counter := R_EAX To R_EDI Do
- Begin
- ReadReg(p, Counter);
- DestroyReg(p, Counter, true);
- p^.regs[counter].MemWrite := nil;
- End;
- p^.DirFlag := F_Unknown;
- End;
- Procedure DestroyOp(TaiObj: Tai; const o:Toper);
- {$ifdef statedebug}
- var hp: Tai;
- {$endif statedebug}
- Begin
- Case o.typ Of
- top_reg:
- begin
- {$ifdef statedebug}
- hp := Tai_asm_comment.Create(strpnew('destroying '+att_reg2str[o.reg]));
- hp.next := Taiobj^.next;
- hp.previous := Taiobj;
- Taiobj^.next := hp;
- if assigned(hp.next) then
- hp.next^.previous := hp;
- {$endif statedebug}
- DestroyReg(PTaiProp(TaiObj.OptInfo), reg32(o.reg), true);
- end;
- top_ref:
- Begin
- ReadRef(PTaiProp(TaiObj.OptInfo), o.ref);
- DestroyRefs(TaiObj, o.ref^, R_NO);
- End;
- top_symbol:;
- End;
- End;
- Function DFAPass1(AsmL: TAAsmOutput; BlockStart: Tai): Tai;
- {gathers the RegAlloc data... still need to think about where to store it to
- avoid global vars}
- Var BlockEnd: Tai;
- Begin
- BlockEnd := FindLoHiLabels(LoLab, HiLab, LabDif, BlockStart);
- BuildLabelTableAndFixRegAlloc(AsmL, LTable, LoLab, LabDif, BlockStart, BlockEnd);
- DFAPass1 := BlockEnd;
- End;
- Procedure AddInstr2RegContents({$ifdef statedebug} asml: TAAsmoutput; {$endif}
- p: Taicpu; reg: TRegister);
- {$ifdef statedebug}
- var hp: Tai;
- {$endif statedebug}
- Begin
- Reg := Reg32(Reg);
- With PTaiProp(p.optinfo)^.Regs[reg] Do
- if (typ in [con_ref,con_noRemoveRef])
- Then
- Begin
- incState(wstate,1);
- {also store how many instructions are part of the sequence in the first
- instructions PTaiProp, so it can be easily accessed from within
- CheckSequence}
- Inc(NrOfMods, NrOfInstrSinceLastMod[Reg]);
- PTaiProp(Tai(StartMod).OptInfo)^.Regs[Reg].NrOfMods := NrOfMods;
- NrOfInstrSinceLastMod[Reg] := 0;
- invalidateDependingRegs(p.optinfo,reg);
- pTaiprop(p.optinfo)^.regs[reg].memwrite := nil;
- {$ifdef StateDebug}
- hp := Tai_asm_comment.Create(strpnew(att_reg2str[reg]+': '+tostr(PTaiProp(p.optinfo)^.Regs[reg].WState)
- + ' -- ' + tostr(PTaiProp(p.optinfo)^.Regs[reg].nrofmods))));
- InsertLLItem(AsmL, p, p.next, hp);
- {$endif StateDebug}
- End
- Else
- Begin
- {$ifdef statedebug}
- hp := Tai_asm_comment.Create(strpnew('destroying '+att_reg2str[reg]));
- insertllitem(asml,p,p.next,hp);
- {$endif statedebug}
- DestroyReg(PTaiProp(p.optinfo), Reg, true);
- {$ifdef StateDebug}
- hp := Tai_asm_comment.Create(strpnew(att_reg2str[reg]+': '+tostr(PTaiProp(p.optinfo)^.Regs[reg].WState)));
- InsertLLItem(AsmL, p, p.next, hp);
- {$endif StateDebug}
- End
- End;
- Procedure AddInstr2OpContents({$ifdef statedebug} asml: TAAsmoutput; {$endif}
- p: Taicpu; const oper: TOper);
- Begin
- If oper.typ = top_reg Then
- AddInstr2RegContents({$ifdef statedebug} asml, {$endif}p, oper.reg)
- Else
- Begin
- ReadOp(PTaiProp(p.optinfo), oper);
- DestroyOp(p, oper);
- End
- End;
- Procedure DoDFAPass2(
- {$Ifdef StateDebug}
- AsmL: TAAsmOutput;
- {$endif statedebug}
- BlockStart, BlockEnd: Tai);
- {Analyzes the Data Flow of an assembler list. Starts creating the reg
- contents for the instructions starting with p. Returns the last Tai which has
- been processed}
- Var
- CurProp, LastFlagsChangeProp: PTaiProp;
- Cnt, InstrCnt : Longint;
- InstrProp: TInsProp;
- UsedRegs: TRegSet;
- prev, p, hp : Tai;
- TmpRef: TReference;
- TmpReg: TRegister;
- {$ifdef AnalyzeLoops}
- TmpState: Byte;
- {$endif AnalyzeLoops}
- Begin
- p := BlockStart;
- LastFlagsChangeProp := nil;
- prev := nil;
- UsedRegs := [];
- UpdateUsedregs(UsedRegs, p);
- SkipHead(P);
- BlockStart := p;
- InstrCnt := 1;
- FillChar(NrOfInstrSinceLastMod, SizeOf(NrOfInstrSinceLastMod), 0);
- While (P <> BlockEnd) Do
- Begin
- CurProp := @TaiPropBlock^[InstrCnt];
- If assigned(prev)
- Then
- Begin
- {$ifdef JumpAnal}
- If (p.Typ <> ait_label) Then
- {$endif JumpAnal}
- Begin
- CurProp^.regs := PTaiProp(prev.OptInfo)^.Regs;
- CurProp^.DirFlag := PTaiProp(prev.OptInfo)^.DirFlag;
- CurProp^.FlagsUsed := false;
- End
- End
- Else
- Begin
- FillChar(CurProp^, SizeOf(CurProp^), 0);
- { For TmpReg := R_EAX to R_EDI Do
- CurProp^.regs[TmpReg].WState := 1;}
- End;
- CurProp^.UsedRegs := UsedRegs;
- CurProp^.CanBeRemoved := False;
- UpdateUsedRegs(UsedRegs, Tai(p.Next));
- For TmpReg := R_EAX To R_EDI Do
- if NrOfInstrSinceLastMod[TmpReg] < 255 then
- Inc(NrOfInstrSinceLastMod[TmpReg])
- else
- begin
- NrOfInstrSinceLastMod[TmpReg] := 0;
- curprop^.regs[TmpReg].typ := con_unknown;
- end;
- Case p.typ Of
- ait_marker:;
- ait_label:
- {$Ifndef JumpAnal}
- If not labelCanBeSkipped(Tai_label(p)) Then
- DestroyAllRegs(CurProp);
- {$Else JumpAnal}
- Begin
- If not labelCanBeSkipped(Tai_label(p)) Then
- With LTable^[Tai_Label(p).l^.labelnr-LoLab] Do
- {$IfDef AnalyzeLoops}
- If (RefsFound = Tai_Label(p).l^.RefCount)
- {$Else AnalyzeLoops}
- If (JmpsProcessed = Tai_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
- (Taicpu_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 <>
- PTaiProp(hp.OptInfo)^.Regs[TmpReg].WState)
- Then DestroyReg(CurProp, TmpReg, true)
- 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
- (Taicpu_labeled(hp).opcode = A_JMP))
- Then
- {previous instruction not a jmp, so keep all the registers' contents from the
- previous instruction}
- Begin
- CurProp^.regs := PTaiProp(hp.OptInfo)^.Regs;
- CurProp.DirFlag := PTaiProp(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
- (Taicpu(hp).is_jmp) and
- (tasmlabel(Taicpu(hp).oper[0].sym).labelnr = Tai_Label(p).l^.labelnr)) And
- Not((hp.typ = ait_label) And
- (LTable^[Tai_Label(hp).l^.labelnr-LoLab].RefsFound
- = Tai_Label(hp).l^.RefCount) And
- (LTable^[Tai_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 := TaiPropBlock^[Cnt].Regs;
- CurProp.DirFlag := TaiPropBlock^[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 := PTaiProp(hp.OptInfo)^.Regs;
- CurProp.DirFlag := PTaiProp(hp.OptInfo)^.DirFlag;
- DestroyAllRegs(PTaiProp(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 := PTaiProp(hp.OptInfo)^.Regs;
- CurProp.DirFlag := PTaiProp(hp.OptInfo)^.DirFlag;
- DestroyAllRegs(CurProp)
- End;
- End;
- {$EndIf JumpAnal}
- {$ifdef GDB}
- ait_stabs, ait_stabn, ait_stab_function_name:;
- {$endif GDB}
- ait_align: ; { may destroy flags !!! }
- ait_instruction:
- Begin
- if Taicpu(p).is_jmp then
- begin
- {$IfNDef JumpAnal}
- for tmpReg := R_EAX to R_EDI do
- with curProp^.regs[tmpReg] do
- case typ of
- con_ref: typ := con_noRemoveRef;
- con_const: typ := con_noRemoveConst;
- con_invalid: typ := con_unknown;
- end;
- {$Else JumpAnal}
- With LTable^[tasmlabel(Taicpu(p).oper[0].sym).labelnr-LoLab] Do
- If (RefsFound = tasmlabel(Taicpu(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
- TaiPropBlock^[InstrNr].Regs := CurProp^.regs;
- TaiPropBlock^[InstrNr].DirFlag := CurProp.DirFlag;
- Inc(JmpsProcessed);
- End
- Else
- Begin
- For TmpReg := R_EAX to R_EDI Do
- If (TaiPropBlock^[InstrNr].Regs[TmpReg].WState <>
- CurProp^.regs[TmpReg].WState) Then
- DestroyReg(@TaiPropBlock^[InstrNr], TmpReg, true);
- Inc(JmpsProcessed);
- End
- {$ifdef AnalyzeLoops}
- Else
- { backward jump, a loop for example}
- { If (JmpsProcessed > 0) Or
- Not(GetLastInstruction(TaiObj, hp) And
- (hp.typ = ait_labeled_instruction) And
- (Taicpu_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 (TaiPropBlock^[InstrNr].Regs[TmpReg].WState <>
- CurProp^.regs[TmpReg].WState)
- Then
- Begin
- TmpState := TaiPropBlock^[InstrNr].Regs[TmpReg].WState;
- Cnt := InstrNr;
- While (TmpState = TaiPropBlock^[Cnt].Regs[TmpReg].WState) Do
- Begin
- DestroyReg(@TaiPropBlock^[Cnt], TmpReg, true);
- Inc(Cnt);
- End;
- While (Cnt <= InstrCnt) Do
- Begin
- Inc(TaiPropBlock^[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 := TaiPropBlock^[InstrNr].Regs[TmpReg].WState;
- Cnt := InstrNr;
- While (TmpState = TaiPropBlock^[Cnt].Regs[TmpReg].WState) Do
- Begin
- TaiPropBlock^[Cnt].Regs[TmpReg] := CurProp^.regs[TmpReg];
- Inc(Cnt);
- End;
- TmpState := TaiPropBlock^[InstrNr].Regs[TmpReg].WState;
- While (TmpState = TaiPropBlock^[Cnt].Regs[TmpReg].WState) Do
- Begin
- DestroyReg(@TaiPropBlock^[Cnt], TmpReg, true);
- Inc(Cnt);
- End;
- While (Cnt <= InstrCnt) Do
- Begin
- Inc(TaiPropBlock^[Cnt].Regs[TmpReg].WState);
- Inc(Cnt)
- End
- End
- End}
- {$endif AnalyzeLoops}
- End;
- {$EndIf JumpAnal}
- end
- else
- begin
- InstrProp := InsProp[Taicpu(p).opcode];
- Case Taicpu(p).opcode Of
- A_MOV, A_MOVZX, A_MOVSX:
- Begin
- Case Taicpu(p).oper[0].typ Of
- top_ref, top_reg:
- case Taicpu(p).oper[1].typ Of
- top_reg:
- Begin
- {$ifdef statedebug}
- hp := Tai_asm_comment.Create(strpnew('destroying '+
- att_reg2str[Taicpu(p).oper[1].reg])));
- insertllitem(asml,p,p.next,hp);
- {$endif statedebug}
- readOp(curprop, Taicpu(p).oper[0]);
- tmpreg := reg32(Taicpu(p).oper[1].reg);
- if regInOp(tmpreg, Taicpu(p).oper[0]) and
- (curProp^.regs[tmpReg].typ in [con_ref,con_noRemoveRef]) then
- begin
- with curprop^.regs[tmpreg] Do
- begin
- incState(wstate,1);
- { also store how many instructions are part of the sequence in the first }
- { instruction's PTaiProp, so it can be easily accessed from within }
- { CheckSequence }
- inc(nrOfMods, nrOfInstrSinceLastMod[tmpreg]);
- pTaiprop(startmod.optinfo)^.regs[tmpreg].nrOfMods := nrOfMods;
- nrOfInstrSinceLastMod[tmpreg] := 0;
- { Destroy the contents of the registers }
- { that depended on the previous value of }
- { this register }
- invalidateDependingRegs(curprop,tmpreg);
- curprop^.regs[tmpreg].memwrite := nil;
- end;
- end
- else
- begin
- {$ifdef statedebug}
- hp := Tai_asm_comment.Create(strpnew('destroying & initing '+att_reg2str[tmpreg]));
- insertllitem(asml,p,p.next,hp);
- {$endif statedebug}
- destroyReg(curprop, tmpreg, true);
- if not(reginop(tmpreg, Taicpu(p).oper[0])) then
- with curprop^.regs[tmpreg] Do
- begin
- typ := con_ref;
- startmod := p;
- nrOfMods := 1;
- end
- end;
- {$ifdef StateDebug}
- hp := Tai_asm_comment.Create(strpnew(att_reg2str[TmpReg]+': '+tostr(CurProp^.regs[TmpReg].WState)));
- InsertLLItem(AsmL, p, p.next, hp);
- {$endif StateDebug}
- End;
- Top_Ref:
- Begin
- ReadRef(CurProp, Taicpu(p).oper[1].ref);
- if taicpu(p).oper[0].typ = top_reg then
- begin
- ReadReg(CurProp, Taicpu(p).oper[0].reg);
- DestroyRefs(p, Taicpu(p).oper[1].ref^, Taicpu(p).oper[0].reg);
- pTaiProp(p.optinfo)^.regs[reg32(Taicpu(p).oper[0].reg)].memwrite :=
- Taicpu(p);
- end
- else
- DestroyRefs(p, Taicpu(p).oper[1].ref^, R_NO);
- End;
- End;
- top_symbol,Top_Const:
- Begin
- Case Taicpu(p).oper[1].typ Of
- Top_Reg:
- Begin
- TmpReg := Reg32(Taicpu(p).oper[1].reg);
- {$ifdef statedebug}
- hp := Tai_asm_comment.Create(strpnew('destroying '+att_reg2str[tmpreg]));
- insertllitem(asml,p,p.next,hp);
- {$endif statedebug}
- With CurProp^.regs[TmpReg] Do
- Begin
- DestroyReg(CurProp, TmpReg, true);
- typ := Con_Const;
- StartMod := p;
- End
- End;
- Top_Ref:
- Begin
- ReadRef(CurProp, Taicpu(p).oper[1].ref);
- DestroyRefs(P, Taicpu(p).oper[1].ref^, R_NO);
- End;
- End;
- End;
- End;
- End;
- A_DIV, A_IDIV, A_MUL:
- Begin
- ReadOp(Curprop, Taicpu(p).oper[0]);
- ReadReg(CurProp,R_EAX);
- If (Taicpu(p).OpCode = A_IDIV) or
- (Taicpu(p).OpCode = A_DIV) Then
- ReadReg(CurProp,R_EDX);
- {$ifdef statedebug}
- hp := Tai_asm_comment.Create(strpnew('destroying eax and edx'));
- insertllitem(asml,p,p.next,hp);
- {$endif statedebug}
- { DestroyReg(CurProp, R_EAX, true);}
- AddInstr2RegContents({$ifdef statedebug}asml,{$endif}
- Taicpu(p), R_EAX);
- DestroyReg(CurProp, R_EDX, true)
- End;
- A_IMUL:
- Begin
- ReadOp(CurProp,Taicpu(p).oper[0]);
- ReadOp(CurProp,Taicpu(p).oper[1]);
- If (Taicpu(p).oper[2].typ = top_none) Then
- If (Taicpu(p).oper[1].typ = top_none) Then
- Begin
- ReadReg(CurProp,R_EAX);
- {$ifdef statedebug}
- hp := Tai_asm_comment.Create(strpnew('destroying eax and edx'));
- insertllitem(asml,p,p.next,hp);
- {$endif statedebug}
- { DestroyReg(CurProp, R_EAX, true); }
- AddInstr2RegContents({$ifdef statedebug}asml,{$endif}
- Taicpu(p), R_EAX);
- DestroyReg(CurProp, R_EDX, true)
- End
- Else
- AddInstr2OpContents(
- {$ifdef statedebug}asml,{$endif}
- Taicpu(p), Taicpu(p).oper[1])
- Else
- AddInstr2OpContents({$ifdef statedebug}asml,{$endif}
- Taicpu(p), Taicpu(p).oper[2]);
- End;
- A_LEA:
- begin
- readop(curprop,Taicpu(p).oper[0]);
- if reginref(Taicpu(p).oper[1].reg,Taicpu(p).oper[0].ref^) then
- AddInstr2RegContents({$ifdef statedebug}asml,{$endif}
- Taicpu(p), Taicpu(p).oper[1].reg)
- else
- begin
- {$ifdef statedebug}
- hp := Tai_asm_comment.Create(strpnew('destroying & initing'+
- att_reg2str[Taicpu(p).oper[1].reg])));
- insertllitem(asml,p,p.next,hp);
- {$endif statedebug}
- destroyreg(curprop,Taicpu(p).oper[1].reg,true);
- with curprop^.regs[Taicpu(p).oper[1].reg] Do
- begin
- typ := con_ref;
- startmod := p;
- nrOfMods := 1;
- end
- end;
- end;
- Else
- Begin
- Cnt := 1;
- While (Cnt <= MaxCh) And
- (InstrProp.Ch[Cnt] <> Ch_None) Do
- Begin
- Case InstrProp.Ch[Cnt] Of
- Ch_REAX..Ch_REDI: ReadReg(CurProp,TCh2Reg(InstrProp.Ch[Cnt]));
- Ch_WEAX..Ch_RWEDI:
- Begin
- If (InstrProp.Ch[Cnt] >= Ch_RWEAX) Then
- ReadReg(CurProp, TCh2Reg(InstrProp.Ch[Cnt]));
- {$ifdef statedebug}
- hp := Tai_asm_comment.Create(strpnew('destroying '+
- att_reg2str[TCh2Reg(InstrProp.Ch[Cnt])])));
- insertllitem(asml,p,p.next,hp);
- {$endif statedebug}
- DestroyReg(CurProp, TCh2Reg(InstrProp.Ch[Cnt]), true);
- End;
- Ch_MEAX..Ch_MEDI:
- AddInstr2RegContents({$ifdef statedebug} asml,{$endif}
- Taicpu(p),TCh2Reg(InstrProp.Ch[Cnt]));
- Ch_CDirFlag: CurProp^.DirFlag := F_NotSet;
- Ch_SDirFlag: CurProp^.DirFlag := F_Set;
- Ch_Rop1: ReadOp(CurProp, Taicpu(p).oper[0]);
- Ch_Rop2: ReadOp(CurProp, Taicpu(p).oper[1]);
- Ch_ROp3: ReadOp(CurProp, Taicpu(p).oper[2]);
- Ch_Wop1..Ch_RWop1:
- Begin
- If (InstrProp.Ch[Cnt] in [Ch_RWop1]) Then
- ReadOp(CurProp, Taicpu(p).oper[0]);
- DestroyOp(p, Taicpu(p).oper[0]);
- End;
- Ch_Mop1:
- AddInstr2OpContents({$ifdef statedebug} asml, {$endif}
- Taicpu(p), Taicpu(p).oper[0]);
- Ch_Wop2..Ch_RWop2:
- Begin
- If (InstrProp.Ch[Cnt] = Ch_RWop2) Then
- ReadOp(CurProp, Taicpu(p).oper[1]);
- DestroyOp(p, Taicpu(p).oper[1]);
- End;
- Ch_Mop2:
- AddInstr2OpContents({$ifdef statedebug} asml, {$endif}
- Taicpu(p), Taicpu(p).oper[1]);
- Ch_WOp3..Ch_RWOp3:
- Begin
- If (InstrProp.Ch[Cnt] = Ch_RWOp3) Then
- ReadOp(CurProp, Taicpu(p).oper[2]);
- DestroyOp(p, Taicpu(p).oper[2]);
- End;
- Ch_Mop3:
- AddInstr2OpContents({$ifdef statedebug} asml, {$endif}
- Taicpu(p), Taicpu(p).oper[2]);
- Ch_WMemEDI:
- Begin
- ReadReg(CurProp, R_EDI);
- FillChar(TmpRef, SizeOf(TmpRef), 0);
- TmpRef.Base := R_EDI;
- tmpRef.index := R_EDI;
- DestroyRefs(p, TmpRef, R_NO)
- End;
- Ch_RFlags:
- if assigned(LastFlagsChangeProp) then
- LastFlagsChangeProp^.FlagsUsed := true;
- Ch_WFlags:
- LastFlagsChangeProp := CurProp;
- Ch_RWFlags:
- begin
- if assigned(LastFlagsChangeProp) then
- LastFlagsChangeProp^.FlagsUsed := true;
- LastFlagsChangeProp := CurProp;
- end;
- Ch_FPU:;
- Else
- Begin
- {$ifdef statedebug}
- hp := Tai_asm_comment.Create(strpnew(
- 'destroying all regs for prev instruction')));
- insertllitem(asml,p, p.next,hp);
- {$endif statedebug}
- DestroyAllRegs(CurProp);
- LastFlagsChangeProp := CurProp;
- End;
- End;
- Inc(Cnt);
- End
- End;
- end;
- End;
- End
- Else
- Begin
- {$ifdef statedebug}
- hp := Tai_asm_comment.Create(strpnew(
- 'destroying all regs: unknown Tai: '+tostr(ord(p.typ)))));
- insertllitem(asml,p, p.next,hp);
- {$endif statedebug}
- DestroyAllRegs(CurProp);
- End;
- End;
- Inc(InstrCnt);
- prev := p;
- GetNextInstruction(p, p);
- End;
- End;
- Function InitDFAPass2(BlockStart, BlockEnd: Tai): Boolean;
- {reserves memory for the PTaiProps in one big memory block when not using
- TP, returns False if not enough memory is available for the optimizer in all
- cases}
- Var p: Tai;
- Count: Longint;
- { TmpStr: String; }
- Begin
- P := BlockStart;
- SkipHead(P);
- NrOfTaiObjs := 0;
- While (P <> BlockEnd) Do
- Begin
- {$IfDef JumpAnal}
- Case p.Typ Of
- ait_label:
- Begin
- If not labelCanBeSkipped(Tai_label(p)) Then
- LTable^[Tai_Label(p).l^.labelnr-LoLab].InstrNr := NrOfTaiObjs
- End;
- ait_instruction:
- begin
- if Taicpu(p).is_jmp then
- begin
- If (tasmlabel(Taicpu(p).oper[0].sym).labelnr >= LoLab) And
- (tasmlabel(Taicpu(p).oper[0].sym).labelnr <= HiLab) Then
- Inc(LTable^[tasmlabel(Taicpu(p).oper[0].sym).labelnr-LoLab].RefsFound);
- end;
- end;
- { ait_instruction:
- Begin
- If (Taicpu(p).opcode = A_PUSH) And
- (Taicpu(p).oper[0].typ = top_symbol) And
- (PCSymbol(Taicpu(p).oper[0])^.offset = 0) Then
- Begin
- TmpStr := StrPas(PCSymbol(Taicpu(p).oper[0])^.symbol);
- If}
- End;
- {$EndIf JumpAnal}
- Inc(NrOfTaiObjs);
- GetNextInstruction(p, p);
- End;
- {Uncomment the next line to see how much memory the reloading optimizer needs}
- { Writeln(NrOfTaiObjs*SizeOf(TTaiProp));}
- {no need to check mem/maxavail, we've got as much virtual memory as we want}
- If NrOfTaiObjs <> 0 Then
- Begin
- InitDFAPass2 := True;
- GetMem(TaiPropBlock, NrOfTaiObjs*SizeOf(TTaiProp));
- fillchar(TaiPropBlock^,NrOfTaiObjs*SizeOf(TTaiProp),0);
- p := BlockStart;
- SkipHead(p);
- For Count := 1 To NrOfTaiObjs Do
- Begin
- PTaiProp(p.OptInfo) := @TaiPropBlock^[Count];
- GetNextInstruction(p, p);
- End;
- End
- Else InitDFAPass2 := False;
- End;
- Function DFAPass2(
- {$ifdef statedebug}
- AsmL: TAAsmOutPut;
- {$endif statedebug}
- BlockStart, BlockEnd: Tai): Boolean;
- Begin
- If InitDFAPass2(BlockStart, BlockEnd) Then
- Begin
- DoDFAPass2(
- {$ifdef statedebug}
- asml,
- {$endif statedebug}
- BlockStart, BlockEnd);
- DFAPass2 := True
- End
- Else DFAPass2 := False;
- End;
- Procedure ShutDownDFA;
- Begin
- If LabDif <> 0 Then
- FreeMem(LTable, LabDif*SizeOf(TLabelTableItem));
- End;
- End.
- {
- $Log$
- Revision 1.24 2001-11-02 22:58:09 peter
- * procsym definition rewrite
- Revision 1.23 2001/10/27 10:20:43 jonas
- + replace mem accesses to locations to which a reg was stored recently with that reg
- Revision 1.22 2001/10/12 13:58:05 jonas
- + memory references are now replaced by register reads in "regular"
- instructions (e.g. "addl ref1,%eax" will be replaced by "addl %ebx,%eax"
- if %ebx contains ref1). Previously only complete load sequences were
- optimized away, but not such small accesses in other instructions than
- mov/movzx/movsx
- Revision 1.21 2001/09/04 14:01:04 jonas
- * commented out some inactive code in csopt386
- + small improvement: lea is now handled the same as mov/zx/sx
- Revision 1.20 2001/08/29 14:07:43 jonas
- * the optimizer now keeps track of flags register usage. This fixes some
- optimizer bugs with int64 calculations (because of the carry flag usage)
- * fixed another bug which caused wrong optimizations with complex
- array expressions
- Revision 1.19 2001/08/26 13:36:55 florian
- * some cg reorganisation
- * some PPC updates
- Revision 1.18 2001/08/06 21:40:50 peter
- * funcret moved from tprocinfo to tprocdef
- Revision 1.17 2001/04/13 01:22:18 peter
- * symtable change to classes
- * range check generation and errors fixed, make cycle DEBUG=1 works
- * memory leaks fixed
- Revision 1.16 2001/04/02 21:20:36 peter
- * resulttype rewrite
- Revision 1.15 2000/12/31 11:00:31 jonas
- * fixed potential bug in writeToMemDestroysContents
- Revision 1.14 2000/12/25 00:07:32 peter
- + new tlinkedlist class (merge of old tstringqueue,tcontainer and
- tlinkedlist objects)
- Revision 1.13 2000/12/21 12:22:53 jonas
- * fixed range error
- Revision 1.12 2000/12/04 17:00:09 jonas
- * invalidate regs that depend on a modified register
- Revision 1.11 2000/11/29 00:30:44 florian
- * unused units removed from uses clause
- * some changes for widestrings
- Revision 1.10 2000/11/28 16:32:11 jonas
- + support for optimizing simple sequences with div/idiv/mul opcodes
- Revision 1.9 2000/11/23 14:20:18 jonas
- * fixed stupid bug in previous commit
- Revision 1.8 2000/11/23 13:26:33 jonas
- * fix for webbug 1066/1126
- Revision 1.7 2000/11/17 15:22:04 jonas
- * fixed another bug in allocregbetween (introduced by the previous fix)
- ("merged")
- Revision 1.6 2000/11/14 13:26:10 jonas
- * fixed bug in allocregbetween
- Revision 1.5 2000/11/08 16:04:34 sg
- * Fix for containsPointerRef: Loop now runs in the correct range
- Revision 1.4 2000/11/03 18:06:26 jonas
- * fixed bug in arrayRefsEq
- * object/class fields are now handled the same as local/global vars and
- parameters (ie. a write to a local var can now never destroy a class
- field)
- Revision 1.3 2000/10/24 10:40:53 jonas
- + register renaming ("fixes" bug1088)
- * changed command line options meanings for optimizer:
- O2 now means peepholopts, CSE and register renaming in 1 pass
- O3 is the same, but repeated until no further optimizations are
- possible or until 5 passes have been done (to avoid endless loops)
- * changed aopt386 so it does this looping
- * added some procedures from csopt386 to the interface because they're
- used by rropt386 as well
- * some changes to csopt386 and daopt386 so that newly added instructions
- by the CSE get optimizer info (they were simply skipped previously),
- this fixes some bugs
- Revision 1.2 2000/10/19 15:59:40 jonas
- * fixed bug in allocregbetween (the register wasn't added to the
- usedregs set of the last instruction of the chain) ("merged")
- Revision 1.1 2000/10/15 09:47:43 peter
- * moved to i386/
- Revision 1.16 2000/10/14 10:14:47 peter
- * moehrendorf oct 2000 rewrite
- Revision 1.15 2000/09/30 13:07:23 jonas
- * fixed support for -Or with new features of CSE
- Revision 1.14 2000/09/29 23:14:11 jonas
- + writeToMemDestroysContents() and writeDestroysContents() to support the
- new features of the CSE
- Revision 1.13 2000/09/25 09:50:30 jonas
- - removed TP conditional code
- Revision 1.12 2000/09/24 21:19:50 peter
- * delphi compile fixes
- Revision 1.11 2000/09/24 15:06:15 peter
- * use defines.inc
- Revision 1.10 2000/09/22 15:00:20 jonas
- * fixed bug in regsEquivalent (in some rare cases, registers with
- completely unrelated content were considered equivalent) (merged
- from fixes branch)
- Revision 1.9 2000/09/20 15:00:58 jonas
- + much improved CSE: the CSE now searches further back for sequences it
- can reuse. After I've also implemented register renaming, the effect
- should be even better (afaik web bug 1088 will then even be optimized
- properly). I don't know about the slow down factor this adds. Maybe
- a new optimization level should be introduced?
- Revision 1.8 2000/08/25 19:39:18 jonas
- * bugfix to FindRegAlloc function (caused wrong regalloc info in
- some cases) (merged from fixes branch)
- Revision 1.7 2000/08/23 12:55:10 jonas
- * fix for web bug 1112 and a bit of clean up in csopt386 (merged from
- fixes branch)
- Revision 1.6 2000/08/19 17:53:29 jonas
- * fixed a potential bug in destroyregs regarding the removal of
- unused loads
- * added destroyDependingRegs() procedure and use it for the fix in
- the previous commit (safer/more complete than what was done before)
- Revision 1.5 2000/08/19 09:08:59 jonas
- * fixed bug where the contents of a register would not be destroyed
- if another register on which these contents depend is modified
- (not really merged, but same idea as fix in fixes branch,
- LAST_MERGE tag is updated)
- Revision 1.4 2000/07/21 15:19:54 jonas
- * daopt386: changes to getnextinstruction/getlastinstruction so they
- ignore labels who have is_addr set
- + daopt386/csopt386: remove loads of registers which are overwritten
- before their contents are used (especially usefull for removing superfluous
- maybe_loadself outputs and push/pops transformed by below optimization
- + popt386: transform pop/pop/pop/.../push/push/push to sequences of
- 'movl x(%esp),%reg' (only active when compiling a go32v2 compiler
- currently because I don't know whether it's safe to do this under Win32/
- Linux (because of problems we had when using esp as frame pointer on
- those os'es)
- Revision 1.3 2000/07/14 05:11:48 michael
- + Patch to 1.1
- Revision 1.2 2000/07/13 11:32:40 michael
- + removed logs
- }
|