1234567891011121314151617181920212223242526272829303132333435363738394041424344454647484950515253545556575859606162636465666768697071727374757677787980818283848586878889909192939495969798991001011021031041051061071081091101111121131141151161171181191201211221231241251261271281291301311321331341351361371381391401411421431441451461471481491501511521531541551561571581591601611621631641651661671681691701711721731741751761771781791801811821831841851861871881891901911921931941951961971981992002012022032042052062072082092102112122132142152162172182192202212222232242252262272282292302312322332342352362372382392402412422432442452462472482492502512522532542552562572582592602612622632642652662672682692702712722732742752762772782792802812822832842852862872882892902912922932942952962972982993003013023033043053063073083093103113123133143153163173183193203213223233243253263273283293303313323333343353363373383393403413423433443453463473483493503513523533543553563573583593603613623633643653663673683693703713723733743753763773783793803813823833843853863873883893903913923933943953963973983994004014024034044054064074084094104114124134144154164174184194204214224234244254264274284294304314324334344354364374384394404414424434444454464474484494504514524534544554564574584594604614624634644654664674684694704714724734744754764774784794804814824834844854864874884894904914924934944954964974984995005015025035045055065075085095105115125135145155165175185195205215225235245255265275285295305315325335345355365375385395405415425435445455465475485495505515525535545555565575585595605615625635645655665675685695705715725735745755765775785795805815825835845855865875885895905915925935945955965975985996006016026036046056066076086096106116126136146156166176186196206216226236246256266276286296306316326336346356366376386396406416426436446456466476486496506516526536546556566576586596606616626636646656666676686696706716726736746756766776786796806816826836846856866876886896906916926936946956966976986997007017027037047057067077087097107117127137147157167177187197207217227237247257267277287297307317327337347357367377387397407417427437447457467477487497507517527537547557567577587597607617627637647657667677687697707717727737747757767777787797807817827837847857867877887897907917927937947957967977987998008018028038048058068078088098108118128138148158168178188198208218228238248258268278288298308318328338348358368378388398408418428438448458468478488498508518528538548558568578588598608618628638648658668678688698708718728738748758768778788798808818828838848858868878888898908918928938948958968978988999009019029039049059069079089099109119129139149159169179189199209219229239249259269279289299309319329339349359369379389399409419429439449459469479489499509519529539549559569579589599609619629639649659669679689699709719729739749759769779789799809819829839849859869879889899909919929939949959969979989991000100110021003100410051006100710081009101010111012101310141015101610171018101910201021102210231024102510261027102810291030103110321033103410351036103710381039104010411042104310441045104610471048104910501051105210531054105510561057105810591060106110621063106410651066106710681069107010711072107310741075107610771078107910801081108210831084108510861087108810891090109110921093109410951096109710981099110011011102110311041105110611071108110911101111111211131114111511161117111811191120112111221123112411251126112711281129113011311132113311341135113611371138113911401141114211431144114511461147114811491150115111521153115411551156115711581159116011611162116311641165116611671168116911701171117211731174117511761177117811791180118111821183118411851186118711881189119011911192119311941195119611971198119912001201120212031204120512061207120812091210121112121213121412151216121712181219122012211222122312241225122612271228122912301231123212331234123512361237123812391240124112421243124412451246124712481249125012511252125312541255125612571258125912601261126212631264126512661267126812691270127112721273127412751276127712781279128012811282128312841285128612871288128912901291129212931294129512961297129812991300130113021303130413051306130713081309131013111312131313141315131613171318131913201321132213231324132513261327132813291330133113321333133413351336133713381339134013411342134313441345134613471348134913501351135213531354135513561357135813591360136113621363136413651366136713681369137013711372137313741375137613771378137913801381138213831384138513861387138813891390139113921393139413951396139713981399140014011402140314041405140614071408140914101411141214131414141514161417141814191420142114221423142414251426142714281429143014311432143314341435143614371438143914401441144214431444144514461447144814491450145114521453145414551456145714581459146014611462146314641465146614671468146914701471147214731474147514761477147814791480148114821483148414851486148714881489149014911492149314941495149614971498149915001501150215031504150515061507150815091510151115121513151415151516151715181519152015211522152315241525152615271528152915301531153215331534153515361537153815391540154115421543154415451546154715481549155015511552155315541555155615571558155915601561156215631564156515661567156815691570157115721573157415751576157715781579158015811582158315841585158615871588158915901591159215931594159515961597159815991600160116021603160416051606160716081609161016111612161316141615161616171618161916201621162216231624162516261627162816291630163116321633163416351636163716381639164016411642164316441645164616471648164916501651165216531654165516561657165816591660166116621663166416651666166716681669167016711672167316741675167616771678167916801681168216831684168516861687168816891690169116921693169416951696169716981699170017011702170317041705170617071708170917101711171217131714171517161717171817191720172117221723172417251726172717281729173017311732173317341735173617371738173917401741174217431744174517461747174817491750175117521753175417551756175717581759176017611762176317641765176617671768176917701771177217731774177517761777177817791780178117821783178417851786178717881789179017911792179317941795179617971798179918001801180218031804180518061807180818091810181118121813181418151816181718181819182018211822182318241825182618271828182918301831183218331834183518361837183818391840184118421843184418451846184718481849185018511852185318541855185618571858185918601861186218631864186518661867186818691870187118721873187418751876187718781879188018811882188318841885188618871888188918901891189218931894189518961897189818991900190119021903190419051906190719081909191019111912191319141915191619171918191919201921192219231924192519261927192819291930193119321933193419351936193719381939194019411942194319441945194619471948194919501951195219531954195519561957195819591960196119621963196419651966196719681969197019711972197319741975197619771978197919801981198219831984198519861987198819891990199119921993199419951996199719981999200020012002200320042005200620072008200920102011201220132014201520162017201820192020202120222023202420252026202720282029203020312032203320342035203620372038203920402041204220432044204520462047204820492050205120522053205420552056205720582059206020612062206320642065206620672068206920702071207220732074207520762077207820792080208120822083208420852086208720882089209020912092209320942095209620972098209921002101210221032104210521062107210821092110211121122113211421152116211721182119212021212122212321242125212621272128212921302131213221332134213521362137213821392140214121422143214421452146214721482149215021512152215321542155215621572158215921602161216221632164216521662167216821692170217121722173217421752176217721782179218021812182218321842185218621872188218921902191219221932194219521962197219821992200220122022203220422052206220722082209221022112212221322142215221622172218221922202221222222232224222522262227222822292230223122322233223422352236223722382239224022412242224322442245224622472248224922502251225222532254225522562257225822592260226122622263226422652266226722682269227022712272227322742275227622772278227922802281228222832284228522862287228822892290229122922293229422952296229722982299230023012302230323042305230623072308230923102311231223132314231523162317231823192320232123222323232423252326232723282329233023312332233323342335233623372338233923402341234223432344234523462347234823492350235123522353235423552356235723582359236023612362236323642365236623672368236923702371237223732374237523762377237823792380238123822383238423852386238723882389239023912392239323942395239623972398239924002401240224032404240524062407240824092410241124122413241424152416241724182419242024212422242324242425242624272428242924302431243224332434243524362437243824392440244124422443244424452446244724482449245024512452245324542455245624572458245924602461246224632464246524662467246824692470247124722473247424752476247724782479248024812482248324842485248624872488248924902491249224932494249524962497249824992500250125022503250425052506250725082509251025112512251325142515251625172518251925202521252225232524252525262527252825292530253125322533253425352536253725382539254025412542254325442545254625472548254925502551255225532554255525562557255825592560256125622563256425652566256725682569257025712572257325742575257625772578257925802581258225832584258525862587258825892590259125922593259425952596259725982599260026012602260326042605260626072608260926102611261226132614261526162617261826192620262126222623262426252626262726282629263026312632263326342635263626372638263926402641264226432644264526462647264826492650265126522653265426552656265726582659266026612662266326642665266626672668266926702671267226732674267526762677267826792680268126822683268426852686268726882689269026912692269326942695269626972698269927002701270227032704270527062707270827092710271127122713271427152716271727182719272027212722272327242725272627272728272927302731273227332734273527362737273827392740274127422743274427452746274727482749275027512752275327542755275627572758275927602761276227632764276527662767276827692770277127722773277427752776277727782779278027812782278327842785278627872788278927902791279227932794279527962797279827992800280128022803280428052806280728082809281028112812281328142815281628172818281928202821282228232824282528262827 |
- {
- Copyright (c) 1998-2002 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 fpcdefs.inc}
- interface
- uses
- globtype,
- cclasses,aasmbase,aasmtai,aasmdata,aasmcpu,cgbase,cgutils,
- cpubase;
- {******************************* 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;
- const
- topsize2tcgsize: array[topsize] of tcgsize = (OS_NO,
- OS_8,OS_16,OS_32,OS_64,OS_16,OS_32,OS_32,
- OS_16,OS_32,OS_64,
- OS_F32,OS_F64,OS_F80,OS_C64,OS_F128,
- OS_M32,
- OS_ADDR,OS_NO,OS_NO,
- OS_NO,
- OS_NO);
- {********************************* Types *********************************}
- type
- TRegEnum = RS_EAX..RS_ESP;
- TRegArray = Array[TRegEnum] of tsuperregister;
- TRegSet = Set of TRegEnum;
- toptreginfo = Record
- NewRegsEncountered, OldRegsEncountered: TRegSet;
- RegsLoadedForRef: TRegSet;
- lastReload: array[RS_EAX..RS_ESP] 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: Word;
- {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[RS_EAX..RS_ESP] Of TContent;
- {contents of the FPU registers}
- // TRegFPUContent = Array[RS_ST..RS_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[RS_EAX..RS_ESP] Of Word;
- 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: TAsmList; prev, foll, new_one: TLinkedListItem);
- function RefsEqual(const R1, R2: TReference): Boolean;
- function isgp32reg(supreg: tsuperregister): Boolean;
- function reginref(supreg: tsuperregister; const ref: treference): boolean;
- function RegReadByInstruction(supreg: tsuperregister; hp: tai): boolean;
- function RegModifiedByInstruction(supreg: tsuperregister; p1: tai): boolean;
- function RegInInstruction(supreg: tsuperregister; p1: tai): boolean;
- function reginop(supreg: tsuperregister; const o:toper): boolean;
- function instrWritesFlags(p: tai): boolean;
- function instrReadsFlags(p: tai): boolean;
- function writeToMemDestroysContents(regWritten: tsuperregister; const ref: treference;
- supreg: tsuperregister; size: tcgsize; const c: tcontent; var invalsmemwrite: boolean): boolean;
- function writeToRegDestroysContents(destReg, supreg: tsuperregister;
- const c: tcontent): boolean;
- function writeDestroysContents(const op: toper; supreg: tsuperregister; size: tcgsize;
- const c: tcontent; var memwritedestroyed: boolean): boolean;
- function sequenceDependsonReg(const Content: TContent; seqreg: tsuperregister; supreg: tsuperregister): 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: TAsmList; p: tai);
- function regLoadedWithNewValue(supreg: tsuperregister; canDependOnPrevValue: boolean;
- hp: tai): boolean;
- procedure UpdateUsedRegs(var UsedRegs: TRegSet; p: tai);
- procedure AllocRegBetween(asml: TAsmList; reg: tregister; p1, p2: tai; var initialusedregs: tregset);
- function FindRegDealloc(supreg: tsuperregister; p: tai): boolean;
- function InstructionsEquivalent(p1, p2: tai; var RegInfo: toptreginfo): Boolean;
- function sizescompatible(loadsize,newsize: topsize): boolean;
- function OpsEqual(const o1,o2:toper): Boolean;
- type
- tdfaobj = class
- constructor create(_list: TAsmList); virtual;
- function pass_1(_blockstart: tai): tai;
- function pass_generate_code: boolean;
- procedure clear;
- function getlabelwithsym(sym: tasmlabel): tai;
- private
- { asm list we're working on }
- list: TAsmList;
- { current part of the asm list }
- blockstart, blockend: tai;
- { the amount of taiObjects in the current part of the assembler list }
- nroftaiobjs: longint;
- { Array which holds all TtaiProps }
- taipropblock: ptaipropblock;
- { all labels in the current block: their value mapped to their location }
- lolab, hilab, labdif: longint;
- labeltable: plabeltable;
- { Walks through the list to find the lowest and highest label number, inits the }
- { labeltable and fixes/optimizes some regallocs }
- procedure initlabeltable;
- function initdfapass2: boolean;
- procedure dodfapass2;
- end;
- function FindLabel(L: tasmlabel; var hp: tai): Boolean;
- procedure incState(var S: Byte; amount: longint);
- {******************************* Variables *******************************}
- var
- dfa: tdfaobj;
- {*********************** end of Interface section ************************}
- Implementation
- Uses
- {$ifdef csdebug}
- cutils,
- {$else}
- {$ifdef statedebug}
- cutils,
- {$else}
- {$ifdef allocregdebug}
- cutils,
- {$endif}
- {$endif}
- {$endif}
- globals, systems, verbose, symconst, cgobj,procinfo;
- Type
- TRefCompare = function(const r1, r2: treference; size1, size2: tcgsize): 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.FindByValue(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
- case tai_regalloc(p).ratype of
- ra_alloc :
- Include(UsedRegs, TRegEnum(getsupreg(tai_regalloc(p).reg)));
- ra_dealloc :
- Exclude(UsedRegs, TRegEnum(getsupreg(tai_regalloc(p).reg)));
- end;
- 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 findregalloc(supreg: tsuperregister; starttai: tai; ratyp: tregalloctype): 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 (tai_regalloc(Starttai).ratype = ratyp) and
- (getsupreg(tai_regalloc(Starttai).reg) = supreg) then
- begin
- findregalloc:=true;
- break;
- end;
- starttai := tai(starttai.next);
- end
- else
- break;
- until false;
- end;
- procedure RemoveLastDeallocForFuncRes(asml: TAsmList; p: tai);
- procedure DoRemoveLastDeallocForFuncRes(asml: TAsmList; supreg: tsuperregister);
- var
- hp2: tai;
- begin
- hp2 := p;
- repeat
- hp2 := tai(hp2.previous);
- if assigned(hp2) and
- (hp2.typ = ait_regalloc) and
- (tai_regalloc(hp2).ratype=ra_dealloc) and
- (getregtype(tai_regalloc(hp2).reg) = R_INTREGISTER) and
- (getsupreg(tai_regalloc(hp2).reg) = supreg) then
- begin
- asml.remove(hp2);
- hp2.free;
- break;
- end;
- until not(assigned(hp2)) or regInInstruction(supreg,hp2);
- end;
- begin
- case current_procinfo.procdef.returndef.typ of
- arraydef,recorddef,pointerdef,
- stringdef,enumdef,procdef,objectdef,errordef,
- filedef,setdef,procvardef,
- classrefdef,forwarddef:
- DoRemoveLastDeallocForFuncRes(asml,RS_EAX);
- orddef:
- if current_procinfo.procdef.returndef.size <> 0 then
- begin
- DoRemoveLastDeallocForFuncRes(asml,RS_EAX);
- { for int64/qword }
- if current_procinfo.procdef.returndef.size = 8 then
- DoRemoveLastDeallocForFuncRes(asml,RS_EDX);
- end;
- end;
- end;
- procedure getNoDeallocRegs(var regs: tregset);
- var
- regCounter: TSuperRegister;
- begin
- regs := [];
- case current_procinfo.procdef.returndef.typ of
- arraydef,recorddef,pointerdef,
- stringdef,enumdef,procdef,objectdef,errordef,
- filedef,setdef,procvardef,
- classrefdef,forwarddef:
- regs := [RS_EAX];
- orddef:
- if current_procinfo.procdef.returndef.size <> 0 then
- begin
- regs := [RS_EAX];
- { for int64/qword }
- if current_procinfo.procdef.returndef.size = 8 then
- regs := regs + [RS_EDX];
- end;
- end;
- for regCounter := RS_EAX to RS_EBX do
- { if not(regCounter in rg.usableregsint) then}
- include(regs,regcounter);
- end;
- procedure AddRegDeallocFor(asml: TAsmList; reg: tregister; p: tai);
- var
- hp1: tai;
- funcResRegs: tregset;
- { funcResReg: boolean;}
- begin
- { if not(supreg in rg.usableregsint) then
- exit;}
- { if not(supreg in [RS_EDI]) then
- exit;}
- getNoDeallocRegs(funcresregs);
- { funcResRegs := funcResRegs - rg.usableregsint;}
- { funcResRegs := funcResRegs - [RS_EDI];}
- { funcResRegs := funcResRegs - [RS_EAX,RS_EBX,RS_ECX,RS_EDX,RS_ESI]; }
- { funcResReg := getsupreg(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(supreg, 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 := tai_regalloc.deAlloc(reg,nil);
- insertLLItem(AsmL, hp1.previous, hp1, p);
- end;
- 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
- p: tai;
- begin
- p := hp;
- while assigned(p) and
- (p.typ in SkipInstr + [ait_label,ait_align]) Do
- if (p.typ <> ait_Label) or
- (tai_label(p).labsym <> l) then
- GetNextInstruction(p, p)
- else
- begin
- hp := p;
- findlabel := true;
- exit
- end;
- findlabel := false;
- end;
- {************************ Some general functions ************************}
- function tch2reg(ch: tinschange): tsuperregister;
- {converts a TChange variable to a TRegister}
- const
- ch2reg: array[CH_REAX..CH_REDI] of tsuperregister = (RS_EAX,RS_ECX,RS_EDX,RS_EBX,RS_ESP,RS_EBP,RS_ESI,RS_EDI);
- begin
- if (ch <= CH_REDI) then
- tch2reg := ch2reg[ch]
- else if (ch <= CH_WEDI) then
- tch2reg := ch2reg[tinschange(ord(ch) - ord(CH_REDI))]
- else if (ch <= CH_RWEDI) then
- tch2reg := ch2reg[tinschange(ord(ch) - ord(CH_WEDI))]
- else if (ch <= CH_MEDI) then
- tch2reg := ch2reg[tinschange(ord(ch) - ord(CH_RWEDI))]
- else
- InternalError($db)
- end;
- { inserts new_one between prev and foll }
- procedure InsertLLItem(AsmL: TAsmList; 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;
- { shgould 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;
- {********************* 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 = NR_NO) or (reg2 = NR_NO) then
- internalerror(2003111602);
- regssamesize := getsubreg(reg1) = getsubreg(reg2);
- end;
- procedure AddReg2RegInfo(OldReg, NewReg: TRegister; var RegInfo: toptreginfo);
- {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 RS_INVALID}
- var
- newsupreg, oldsupreg: tsuperregister;
- begin
- if (newreg = NR_NO) or (oldreg = NR_NO) then
- internalerror(2003111601);
- newsupreg := getsupreg(newreg);
- oldsupreg := getsupreg(oldreg);
- with RegInfo Do
- begin
- NewRegsEncountered := NewRegsEncountered + [newsupreg];
- OldRegsEncountered := OldRegsEncountered + [oldsupreg];
- New2OldReg[newsupreg] := oldsupreg;
- end;
- end;
- procedure AddOp2RegInfo(const o:toper; var reginfo: toptreginfo);
- begin
- case o.typ Of
- top_reg:
- if (o.reg <> NR_NO) then
- AddReg2RegInfo(o.reg, o.reg, RegInfo);
- top_ref:
- begin
- if o.ref^.base <> NR_NO then
- AddReg2RegInfo(o.ref^.base, o.ref^.base, RegInfo);
- if o.ref^.index <> NR_NO then
- AddReg2RegInfo(o.ref^.index, o.ref^.index, RegInfo);
- end;
- end;
- end;
- function RegsEquivalent(oldreg, newreg: tregister; const oldinst, newinst: taicpu; var reginfo: toptreginfo; opact: topaction): Boolean;
- begin
- if not((oldreg = NR_NO) or (newreg = NR_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 RS_NO and the comparison in the else-part will fail}
- if (getsupreg(oldReg) in OldRegsEncountered) then
- if (getsupreg(NewReg) in NewRegsEncountered) then
- RegsEquivalent := (getsupreg(oldreg) = New2OldReg[getsupreg(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(getsupreg(newreg) in NewRegsEncountered) and
- ((opact = opact_write) or
- ((newreg = oldreg) and
- (ptaiprop(oldinst.optinfo)^.regs[getsupreg(oldreg)].wstate =
- ptaiprop(newinst.optinfo)^.regs[getsupreg(oldreg)].wstate) and
- not(regmodifiedbyinstruction(getsupreg(oldreg),oldinst)))) 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; const oldinst, newinst: taicpu; var regInfo: toptreginfo): boolean;
- begin
- RefsEquivalent :=
- (r1.offset = r2.offset) and
- RegsEquivalent(r1.base, r2.base, oldinst, newinst, reginfo, OpAct_Read) and
- RegsEquivalent(r1.index, r2.index, oldinst, newinst, reginfo, OpAct_Read) and
- (r1.segment = r2.segment) and (r1.scalefactor = r2.scalefactor) and
- (r1.symbol = r2.symbol) and (r1.refaddr = r2.refaddr) and
- (r1.relsymbol = r2.relsymbol);
- end;
- function refsequal(const r1, r2: treference): boolean;
- begin
- refsequal :=
- (r1.offset = r2.offset) 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) and (r1.refaddr = r2.refaddr) and
- (r1.relsymbol = r2.relsymbol);
- end;
- {$ifdef q+}
- {$q-}
- {$define overflowon}
- {$endif q+}
- // checks whether a write to r2 of size "size" contains address r1
- function refsoverlapping(const r1, r2: treference; size1, size2: tcgsize): boolean;
- var
- realsize1, realsize2: aint;
- begin
- realsize1 := tcgsize2size[size1];
- realsize2 := tcgsize2size[size2];
- refsoverlapping :=
- (r2.offset <= r1.offset+realsize1) and
- (r1.offset <= r2.offset+realsize2) 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) and (r1.refaddr = r2.refaddr) and
- (r1.relsymbol = r2.relsymbol);
- end;
- {$ifdef overflowon}
- {$q+}
- {$undef overflowon}
- {$endif overflowon}
- function isgp32reg(supreg: tsuperregister): boolean;
- {Checks if the register is a 32 bit general purpose register}
- begin
- isgp32reg := false;
- if (supreg >= RS_EAX) and (supreg <= RS_EBX) then
- isgp32reg := true
- end;
- function reginref(supreg: tsuperregister; const ref: treference): boolean;
- begin {checks whether ref contains a reference to reg}
- reginref :=
- ((ref.base <> NR_NO) and
- (getsupreg(ref.base) = supreg)) or
- ((ref.index <> NR_NO) and
- (getsupreg(ref.index) = supreg))
- end;
- function RegReadByInstruction(supreg: tsuperregister; hp: tai): boolean;
- var
- p: taicpu;
- opcount: longint;
- begin
- RegReadByInstruction := false;
- if hp.typ <> ait_instruction then
- exit;
- p := taicpu(hp);
- case p.opcode of
- A_CALL:
- regreadbyinstruction := true;
- A_IMUL:
- case p.ops of
- 1:
- regReadByInstruction :=
- (supreg = RS_EAX) or reginop(supreg,p.oper[0]^);
- 2,3:
- regReadByInstruction :=
- reginop(supreg,p.oper[0]^) or
- reginop(supreg,p.oper[1]^);
- end;
- A_IDIV,A_DIV,A_MUL:
- begin
- regReadByInstruction :=
- reginop(supreg,p.oper[0]^) or (supreg in [RS_EAX,RS_EDX]);
- end;
- else
- begin
- for opcount := 0 to p.ops-1 do
- if (p.oper[opCount]^.typ = top_ref) and
- reginref(supreg,p.oper[opcount]^.ref^) then
- begin
- RegReadByInstruction := true;
- exit
- end;
- for opcount := 1 to maxinschanges do
- case insprop[p.opcode].ch[opcount] of
- CH_REAX..CH_REDI,CH_RWEAX..CH_MEDI:
- if supreg = 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
- reginop(supreg,p.oper[0]^) then
- begin
- RegReadByInstruction := true;
- exit
- end;
- Ch_RWOP2,Ch_ROP2,Ch_MOP2:
- if //(p.oper[1]^.typ = top_reg) and
- reginop(supreg,p.oper[1]^) then
- begin
- RegReadByInstruction := true;
- exit
- end;
- Ch_RWOP3,Ch_ROP3,Ch_MOP3:
- if //(p.oper[2]^.typ = top_reg) and
- reginop(supreg,p.oper[2]^) then
- begin
- RegReadByInstruction := true;
- exit
- end;
- end;
- end;
- end;
- end;
- function regInInstruction(supreg: tsuperregister; 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: longint;
- begin
- regInInstruction := false;
- if p1.typ <> ait_instruction then
- exit;
- p := taicpu(p1);
- case p.opcode of
- A_CALL:
- regininstruction := true;
- A_IMUL:
- case p.ops of
- 1:
- regInInstruction :=
- (supreg = RS_EAX) or reginop(supreg,p.oper[0]^);
- 2,3:
- regInInstruction :=
- reginop(supreg,p.oper[0]^) or
- reginop(supreg,p.oper[1]^) or
- (assigned(p.oper[2]) and
- reginop(supreg,p.oper[2]^));
- end;
- A_IDIV,A_DIV,A_MUL:
- regInInstruction :=
- reginop(supreg,p.oper[0]^) or
- (supreg in [RS_EAX,RS_EDX])
- else
- begin
- for opcount := 0 to p.ops-1 do
- if (p.oper[opCount]^.typ = top_ref) and
- reginref(supreg,p.oper[opcount]^.ref^) then
- begin
- regInInstruction := true;
- exit
- end;
- for opcount := 1 to maxinschanges do
- case insprop[p.opcode].Ch[opCount] of
- CH_REAX..CH_MEDI:
- if tch2reg(InsProp[p.opcode].Ch[opCount]) = supreg then
- begin
- regInInstruction := true;
- exit;
- end;
- CH_ROp1..CH_MOp1:
- if reginop(supreg,p.oper[0]^) then
- begin
- regInInstruction := true;
- exit
- end;
- Ch_ROp2..Ch_MOp2:
- if reginop(supreg,p.oper[1]^) then
- begin
- regInInstruction := true;
- exit
- end;
- Ch_ROp3..Ch_MOp3:
- if reginop(supreg,p.oper[2]^) then
- begin
- regInInstruction := true;
- exit
- end;
- end;
- end;
- end;
- end;
- function reginop(supreg: tsuperregister; const o:toper): boolean;
- begin
- reginop := false;
- case o.typ Of
- top_reg:
- reginop :=
- (getregtype(o.reg) = R_INTREGISTER) and
- (supreg = getsupreg(o.reg));
- top_ref:
- reginop :=
- ((o.ref^.base <> NR_NO) and
- (supreg = getsupreg(o.ref^.base))) or
- ((o.ref^.index <> NR_NO) and
- (supreg = getsupreg(o.ref^.index)));
- end;
- end;
- function RegModifiedByInstruction(supreg: tsuperregister; p1: tai): boolean;
- var
- InstrProp: TInsProp;
- TmpResult: Boolean;
- Cnt: Word;
- begin
- TmpResult := False;
- if supreg = RS_INVALID then
- exit;
- if (p1.typ = ait_instruction) then
- case taicpu(p1).opcode of
- A_IMUL:
- With taicpu(p1) Do
- TmpResult :=
- ((ops = 1) and (supreg in [RS_EAX,RS_EDX])) or
- ((ops = 2) and (getsupreg(oper[1]^.reg) = supreg)) or
- ((ops = 3) and (getsupreg(oper[2]^.reg) = supreg));
- A_DIV, A_IDIV, A_MUL:
- With taicpu(p1) Do
- TmpResult :=
- (supreg in [RS_EAX,RS_EDX]);
- else
- begin
- Cnt := 1;
- InstrProp := InsProp[taicpu(p1).OpCode];
- while (Cnt <= maxinschanges) and
- (InstrProp.Ch[Cnt] <> Ch_None) and
- not(TmpResult) Do
- begin
- case InstrProp.Ch[Cnt] Of
- Ch_WEAX..Ch_MEDI:
- TmpResult := supreg = tch2reg(InstrProp.Ch[Cnt]);
- Ch_RWOp1,Ch_WOp1,Ch_Mop1:
- TmpResult := (taicpu(p1).oper[0]^.typ = top_reg) and
- reginop(supreg,taicpu(p1).oper[0]^);
- Ch_RWOp2,Ch_WOp2,Ch_Mop2:
- TmpResult := (taicpu(p1).oper[1]^.typ = top_reg) and
- reginop(supreg,taicpu(p1).oper[1]^);
- Ch_RWOp3,Ch_WOp3,Ch_Mop3:
- TmpResult := (taicpu(p1).oper[2]^.typ = top_reg) and
- reginop(supreg,taicpu(p1).oper[2]^);
- Ch_FPU: TmpResult := false; // supreg is supposed to be an intreg!! supreg in [RS_ST..RS_ST7,RS_MM0..RS_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 maxinschanges do
- if InsProp[taicpu(p).opcode].Ch[l] in [Ch_WFlags,Ch_RWFlags,Ch_All] then
- exit;
- end;
- ait_label:
- exit;
- end;
- instrWritesFlags := false;
- end;
- function instrReadsFlags(p: tai): boolean;
- var
- l: longint;
- begin
- instrReadsFlags := true;
- case p.typ of
- ait_instruction:
- begin
- for l := 1 to maxinschanges do
- if InsProp[taicpu(p).opcode].Ch[l] in [Ch_RFlags,Ch_RWFlags,Ch_All] then
- exit;
- end;
- ait_label:
- exit;
- end;
- instrReadsFlags := false;
- 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 = mark_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 = mark_NoPropInfoStart) then
- begin
- while assigned(Current) and
- ((current.typ <> ait_Marker) or
- (tai_Marker(current).Kind <> mark_NoPropInfoEnd)) Do
- Current := tai(current.Next);
- end;}
- until not(assigned(Current)) or
- (current.typ <> ait_Marker) or
- not(tai_Marker(current).Kind in [mark_NoPropInfoStart,mark_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 = mark_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 [mark_AsmBlockEnd{,mark_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 = mark_NoPropInfoEnd) then
- begin
- while assigned(Current) and
- ((current.typ <> ait_Marker) or
- (tai_Marker(current).Kind <> mark_NoPropInfoStart)) Do
- Current := tai(current.previous);
- end;}
- until not(assigned(Current)) or
- (current.typ <> ait_Marker) or
- not(tai_Marker(current).Kind in [mark_NoPropInfoStart,mark_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 = mark_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 [mark_AsmBlockEnd,mark_InlineStart,mark_InlineEnd])) then
- GetNextInstruction(p,p)
- else if ((p.Typ = Ait_Marker) and
- (tai_Marker(p).Kind = mark_NoPropInfoStart)) then
- {a marker of the mark_NoPropInfoStart can't be the first instruction of a
- TAsmList list}
- GetNextInstruction(tai(p.previous),p);
- until p = oldp
- end;
- function labelCanBeSkipped(p: tai_label): boolean;
- begin
- labelCanBeSkipped := not(p.labsym.is_used) or (p.labsym.labeltype<>alt_jump);
- end;
- {******************* The Data Flow Analyzer functions ********************}
- function regLoadedWithNewValue(supreg: tsuperregister; canDependOnPrevValue: boolean;
- hp: tai): boolean;
- { assumes reg is a 32bit register }
- var
- p: taicpu;
- begin
- if not assigned(hp) or
- (hp.typ <> ait_instruction) then
- begin
- regLoadedWithNewValue := false;
- exit;
- end;
- p := taicpu(hp);
- regLoadedWithNewValue :=
- (((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
- (getsupreg(p.oper[1]^.reg) = supreg) and
- (canDependOnPrevValue or
- (p.oper[0]^.typ = top_const) or
- ((p.oper[0]^.typ = top_reg) and
- (getsupreg(p.oper[0]^.reg) <> supreg)) or
- ((p.oper[0]^.typ = top_ref) and
- not regInRef(supreg,p.oper[0]^.ref^)))) or
- ((p.opcode = A_POP) and
- (getsupreg(p.oper[0]^.reg) = supreg));
- 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))) or
- ((p.typ = ait_marker) and
- (tai_Marker(p).Kind in [mark_AsmBlockEnd,mark_InlineStart,mark_InlineEnd]))) do
- p := tai(p.next);
- while assigned(p) and
- (p.typ=ait_RegAlloc) Do
- begin
- if (getregtype(tai_regalloc(p).reg) = R_INTREGISTER) then
- begin
- case tai_regalloc(p).ratype of
- ra_alloc :
- Include(UsedRegs, TRegEnum(getsupreg(tai_regalloc(p).reg)));
- ra_dealloc :
- Exclude(UsedRegs, TRegEnum(getsupreg(tai_regalloc(p).reg)));
- end;
- end;
- 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: TAsmList; reg: tregister; p1, p2: tai; var initialusedregs: tregset);
- { allocates register reg between (and including) instructions p1 and p2 }
- { the type of p1 and p2 must not be in SkipInstr }
- { note that this routine is both called from the peephole optimizer }
- { where optinfo is not yet initialised) and from the cse (where it is) }
- var
- hp, start: tai;
- removedsomething,
- firstRemovedWasAlloc,
- lastRemovedWasDealloc: boolean;
- supreg: tsuperregister;
- begin
- {$ifdef EXTDEBUG}
- if assigned(p1.optinfo) and
- (ptaiprop(p1.optinfo)^.usedregs <> initialusedregs) then
- internalerror(2004101010);
- {$endif EXTDEBUG}
- start := p1;
- if (reg = NR_ESP) or
- (reg = current_procinfo.framepointer) or
- not(assigned(p1)) then
- { this happens with registers which are loaded implicitely, outside the }
- { current block (e.g. esi with self) }
- exit;
- supreg := getsupreg(reg);
- { make sure we allocate it for this instruction }
- getnextinstruction(p2,p2);
- lastRemovedWasDealloc := false;
- removedSomething := false;
- firstRemovedWasAlloc := false;
- {$ifdef allocregdebug}
- hp := tai_comment.Create(strpnew('allocating '+std_regname(newreg(R_INTREGISTER,supreg,R_SUBWHOLE))+
- ' from here...'));
- insertllitem(asml,p1.previous,p1,hp);
- hp := tai_comment.Create(strpnew('allocated '+std_regname(newreg(R_INTREGISTER,supreg,R_SUBWHOLE))+
- ' till here...'));
- insertllitem(asml,p2,p2.next,hp);
- {$endif allocregdebug}
- if not(supreg in initialusedregs) then
- begin
- hp := tai_regalloc.alloc(reg,nil);
- insertllItem(asmL,p1.previous,p1,hp);
- include(initialusedregs,supreg);
- end;
- while assigned(p1) and
- (p1 <> p2) do
- begin
- if assigned(p1.optinfo) then
- include(ptaiprop(p1.optinfo)^.usedregs,supreg);
- 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 (getsupreg(tai_regalloc(p1).reg) = supreg) then
- begin
- if not removedSomething then
- begin
- firstRemovedWasAlloc := tai_regalloc(p1).ratype=ra_alloc;
- removedSomething := true;
- end;
- lastRemovedWasDealloc := (tai_regalloc(p1).ratype=ra_dealloc);
- 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);
- end;
- if assigned(p1) then
- begin
- if firstRemovedWasAlloc then
- begin
- hp := tai_regalloc.Alloc(reg,nil);
- insertLLItem(asmL,start.previous,start,hp);
- end;
- if lastRemovedWasDealloc then
- begin
- hp := tai_regalloc.DeAlloc(reg,nil);
- insertLLItem(asmL,p1.previous,p1,hp);
- end;
- end;
- end;
- function FindRegDealloc(supreg: tsuperregister; p: tai): boolean;
- 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
- (getregtype(tai_regalloc(p).reg) = R_INTREGISTER) and
- (getsupreg(tai_regalloc(p).reg) = supreg) then
- if (tai_regalloc(p).ratype=ra_dealloc) then
- if first then
- begin
- findregdealloc := true;
- break;
- end
- else
- begin
- findRegDealloc :=
- getNextInstruction(p,hp) and
- regLoadedWithNewValue(supreg,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: tsuperregister; supreg: tsuperregister): 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: Word;
- 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 = current_procinfo.FramePointer) or
- (assigned(symbol) and (base = NR_NO))) and
- (index = NR_NO) then
- begin
- RegsChecked := RegsChecked + [getsupreg(taicpu(p).oper[1]^.reg)];
- if supreg = getsupreg(taicpu(p).oper[1]^.reg) then
- break;
- end
- else
- tmpResult :=
- regReadByInstruction(supreg,p) and
- regModifiedByInstruction(seqReg,p)
- else
- tmpResult :=
- regReadByInstruction(supreg,p) and
- regModifiedByInstruction(seqReg,p);
- inc(Counter);
- GetNextInstruction(p,p)
- end;
- sequenceDependsonReg := TmpResult
- end;
- procedure invalidateDependingRegs(p1: ptaiprop; supreg: tsuperregister);
- var
- counter: tsuperregister;
- begin
- for counter := RS_EAX to RS_EDI do
- if counter <> supreg then
- with p1^.regs[counter] Do
- begin
- if (typ in [con_ref,con_noRemoveRef]) and
- sequenceDependsOnReg(p1^.Regs[counter],counter,supreg) then
- if typ in [con_ref, con_invalid] then
- typ := con_invalid
- { 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; supreg: tsuperregister; 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
- { the following happens for fpu registers }
- if (supreg < low(NrOfInstrSinceLastMod)) or
- (supreg > high(NrOfInstrSinceLastMod)) then
- exit;
- NrOfInstrSinceLastMod[supreg] := 0;
- with p1^.regs[supreg] do
- begin
- if doincState then
- begin
- incState(wstate,1);
- typ := con_unknown;
- startmod := nil;
- end
- else
- if typ in [con_ref,con_const,con_invalid] then
- typ := con_invalid
- { con_noRemoveRef = con_unknown }
- else
- typ := con_unknown;
- memwrite := nil;
- end;
- invalidateDependingRegs(p1,supreg);
- 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 [RS_NO,RS_ESP,current_procinfo.FramePointer]) then
- RegSet := RegSet + [taicpu(p).oper[0]^.reg];
- top_ref:
- With TReference(taicpu(p).oper[0]^) Do
- begin
- if not(base in [current_procinfo.FramePointer,RS_NO,RS_ESP])
- then RegSet := RegSet + [base];
- if not(index in [current_procinfo.FramePointer,RS_NO,RS_ESP])
- then RegSet := RegSet + [index];
- end;
- end;
- case taicpu(p).oper[1]^.typ Of
- top_reg:
- if not(taicpu(p).oper[1]^.reg in [RS_NO,RS_ESP,current_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 [current_procinfo.FramePointer,RS_NO,RS_ESP])
- then RegSet := RegSet + [base];
- if not(index in [current_procinfo.FramePointer,RS_NO,RS_ESP])
- then RegSet := RegSet + [index];
- end;
- end;
- end;
- end;}
- function OpsEquivalent(const o1, o2: toper; const oldinst, newinst: taicpu; var RegInfo: toptreginfo; 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, oldinst, newinst, RegInfo, OpAct);
- top_ref:
- OpsEquivalent := RefsEquivalent(o1.ref^, o2.ref^, oldinst, newinst, RegInfo);
- 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_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.ops = p2.ops) and
- (p1.opsize = p2.opsize);
- end;
- end;
- function InstructionsEquivalent(p1, p2: tai; var RegInfo: toptreginfo): 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(p2).typ = ait_instruction) and
- opscompatible(taicpu(p1),taicpu(p2)) and
- (not(assigned(taicpu(p1).oper[0])) or
- (taicpu(p1).oper[0]^.typ = taicpu(p2).oper[0]^.typ)) and
- (not(assigned(taicpu(p1).oper[1])) or
- (taicpu(p1).oper[1]^.typ = taicpu(p2).oper[1]^.typ)) and
- (not(assigned(taicpu(p1).oper[2])) or
- (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(getsupreg(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(getsupreg(taicpu(p2).oper[1]^.reg), taicpu(p2).oper[0]^.ref^)) and
- RefsEquivalent(taicpu(p1).oper[0]^.ref^, taicpu(p2).oper[0]^.ref^,taicpu(p1), taicpu(p2), reginfo) 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 (base <> NR_NO) and
- (not(getsupreg(base) in [getsupreg(current_procinfo.FramePointer), RS_ESP])) then
- include(RegInfo.RegsLoadedForRef, getsupreg(base));
- if (index <> NR_NO) and
- (not(getsupreg(index) in [getsupreg(current_procinfo.FramePointer), RS_ESP])) then
- include(RegInfo.RegsLoadedForRef, getsupreg(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(taicpu(p1).oper[1]^.reg,
- taicpu(p2).oper[1]^.reg, taicpu(p1), taicpu(p2), 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 (base <> NR_NO) and
- (not(getsupreg(base) in [getsupreg(current_procinfo.FramePointer),
- getsupreg(taicpu(p2).oper[1]^.reg),RS_ESP])) then
- {it won't do any harm if the register is already in RegsLoadedForRef}
- begin
- include(RegInfo.RegsLoadedForRef, getsupreg(base));
- {$ifdef csdebug}
- Writeln(std_regname(base), ' added');
- {$endif csdebug}
- end;
- if (index <> NR_NO) and
- (not(getsupreg(index) in [getsupreg(current_procinfo.FramePointer),
- getsupreg(taicpu(p2).oper[1]^.reg),RS_ESP])) then
- begin
- include(RegInfo.RegsLoadedForRef, getsupreg(index));
- {$ifdef csdebug}
- Writeln(std_regname(index), ' added');
- {$endif csdebug}
- end;
- end;
- if (taicpu(p2).oper[1]^.reg <> NR_NO) and
- (not(getsupreg(taicpu(p2).oper[1]^.reg) in [getsupreg(current_procinfo.FramePointer),RS_ESP])) then
- begin
- RegInfo.RegsLoadedForRef := RegInfo.RegsLoadedForRef -
- [getsupreg(taicpu(p2).oper[1]^.reg)];
- {$ifdef csdebug}
- Writeln(std_regname(newreg(R_INTREGISTER,getsupreg(taicpu(p2).oper[1]^.reg),R_SUBWHOLE)), ' removed');
- {$endif csdebug}
- end;
- InstructionsEquivalent :=
- OpsEquivalent(taicpu(p1).oper[0]^, taicpu(p2).oper[0]^, taicpu(p1), taicpu(p2), RegInfo, OpAct_Read) and
- OpsEquivalent(taicpu(p1).oper[1]^, taicpu(p2).oper[1]^, taicpu(p1), taicpu(p2), RegInfo, OpAct_Write)
- end
- else
- {an instruction <> mov, movzx, movsx}
- begin
- {$ifdef csdebug}
- hp := tai_comment.Create(strpnew('checking if equivalent'));
- hp.previous := p2;
- hp.next := p2.next;
- p2.next.previous := hp;
- p2.next := hp;
- {$endif csdebug}
- InstructionsEquivalent :=
- (not(assigned(taicpu(p1).oper[0])) or
- OpsEquivalent(taicpu(p1).oper[0]^, taicpu(p2).oper[0]^, taicpu(p1), taicpu(p2), RegInfo, OpAct_Unknown)) and
- (not(assigned(taicpu(p1).oper[1])) or
- OpsEquivalent(taicpu(p1).oper[1]^, taicpu(p2).oper[1]^, taicpu(p1), taicpu(p2), RegInfo, OpAct_Unknown)) and
- (not(assigned(taicpu(p1).oper[2])) or
- OpsEquivalent(taicpu(p1).oper[2]^, taicpu(p2).oper[2]^, taicpu(p1), taicpu(p2), 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_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_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; supreg: tsuperregister);
- begin
- if supreg in [RS_EAX..RS_EDI] then
- incState(p^.regs[supreg].rstate,1)
- end;
- procedure readref(p: ptaiprop; const ref: preference);
- begin
- if ref^.base <> NR_NO then
- readreg(p, getsupreg(ref^.base));
- if ref^.index <> NR_NO then
- readreg(p, getsupreg(ref^.index));
- end;
- procedure ReadOp(p: ptaiprop;const o:toper);
- begin
- case o.typ Of
- top_reg: readreg(p, getsupreg(o.reg));
- top_ref: readref(p, o.ref);
- end;
- end;
- function RefInInstruction(const ref: TReference; p: tai;
- RefsEq: TRefCompare; size: tcgsize): Boolean;
- {checks whehter ref is used in p}
- var
- mysize: tcgsize;
- TmpResult: Boolean;
- begin
- TmpResult := False;
- if (p.typ = ait_instruction) then
- begin
- mysize := topsize2tcgsize[taicpu(p).opsize];
- if (taicpu(p).ops >= 1) and
- (taicpu(p).oper[0]^.typ = top_ref) then
- TmpResult := RefsEq(taicpu(p).oper[0]^.ref^,ref,mysize,size);
- if not(TmpResult) and
- (taicpu(p).ops >= 2) and
- (taicpu(p).oper[1]^.typ = top_ref) then
- TmpResult := RefsEq(taicpu(p).oper[1]^.ref^,ref,mysize,size);
- if not(TmpResult) and
- (taicpu(p).ops >= 3) and
- (taicpu(p).oper[2]^.typ = top_ref) then
- TmpResult := RefsEq(taicpu(p).oper[2]^.ref^,ref,mysize,size);
- end;
- RefInInstruction := TmpResult;
- end;
- function RefInSequence(const ref: TReference; Content: TContent;
- RefsEq: TRefCompare; size: tcgsize): 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: Word;
- 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, size)
- then TmpResult := True;
- inc(Counter);
- GetNextInstruction(p,p)
- end;
- RefInSequence := TmpResult
- end;
- {$ifdef q+}
- {$q-}
- {$define overflowon}
- {$endif q+}
- // checks whether a write to r2 of size "size" contains address r1
- function arrayrefsoverlapping(const r1, r2: treference; size1, size2: tcgsize): Boolean;
- var
- realsize1, realsize2: aint;
- begin
- realsize1 := tcgsize2size[size1];
- realsize2 := tcgsize2size[size2];
- arrayrefsoverlapping :=
- (r2.offset <= r1.offset+realsize1) and
- (r1.offset <= r2.offset+realsize2) and
- (r1.segment = r2.segment) and
- (r1.symbol=r2.symbol) and
- (r1.base = r2.base)
- end;
- {$ifdef overflowon}
- {$q+}
- {$undef overflowon}
- {$endif overflowon}
- 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 = current_procinfo.framepointer);
- 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 := 0 to hp.ops-1 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: tsuperregister; const ref: treference;
- supreg: tsuperregister; size: tcgsize; 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
- if isSimpleRef(ref) then
- begin
- if (ref.index <> NR_NO) or
- (assigned(ref.symbol) and
- (ref.base <> NR_NO)) then
- { local/global variable or parameter which is an array }
- refsEq := @arrayRefsOverlapping
- else
- { local/global variable or parameter which is not an array }
- refsEq := @refsOverlapping;
- invalsmemwrite :=
- assigned(c.memwrite) and
- ((not(cs_opt_size in current_settings.optimizerswitches) and
- containsPointerRef(c.memwrite)) or
- refsEq(c.memwrite.oper[1]^.ref^,ref,topsize2tcgsize[c.memwrite.opsize],size));
- 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_opt_size in current_settings.optimizerswitches) and
- containsPointerLoad(c)
- ) or
- (refInSequence(ref,c,refsEq,size) and
- ((supreg <> 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, topsize2tcgsize[taicpu(StartMod).opsize],size)
- )
- )
- )
- );
- 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_opt_size in current_settings.optimizerswitches) 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_opt_size in current_settings.optimizerswitches) or
- { for movsl }
- ((ref.base = NR_EDI) and (ref.index = NR_EDI)) or
- { don't destroy if reg contains a parameter, local or global variable }
- containsPointerLoad(c)
- );
- end;
- end;
- function writeToRegDestroysContents(destReg, supreg: tsuperregister;
- 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,supreg,destReg);
- end;
- function writeDestroysContents(const op: toper; supreg: tsuperregister; size: tcgsize;
- const c: tcontent; var memwritedestroyed: boolean): boolean;
- { returns whether the contents c of reg are invalid after regWritten is }
- { is written to op }
- begin
- memwritedestroyed := false;
- case op.typ of
- top_reg:
- writeDestroysContents :=
- (getregtype(op.reg) = R_INTREGISTER) and
- writeToRegDestroysContents(getsupreg(op.reg),supreg,c);
- top_ref:
- writeDestroysContents :=
- writeToMemDestroysContents(RS_INVALID,op.ref^,supreg,size,c,memwritedestroyed);
- else
- writeDestroysContents := false;
- end;
- end;
- procedure destroyRefs(p: tai; const ref: treference; regwritten: tsuperregister; size: tcgsize);
- { 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: tsuperregister;
- destroymemwrite: boolean;
- begin
- for counter := RS_EAX to RS_EDI Do
- begin
- if writeToMemDestroysContents(regwritten,ref,counter,size,
- 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; read, written: boolean);
- var Counter: tsuperregister;
- begin {initializes/desrtoys all registers}
- For Counter := RS_EAX To RS_EDI Do
- begin
- if read then
- readreg(p, Counter);
- DestroyReg(p, Counter, written);
- 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_comment.Create(strpnew('destroying '+std_regname(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), getsupreg(o.reg), true);
- end;
- top_ref:
- begin
- readref(ptaiprop(taiObj.OptInfo), o.ref);
- DestroyRefs(taiObj, o.ref^, RS_INVALID,topsize2tcgsize[(taiobj as taicpu).opsize]);
- end;
- end;
- end;
- procedure AddInstr2RegContents({$ifdef statedebug} asml: TAsmList; {$endif}
- p: taicpu; supreg: tsuperregister);
- {$ifdef statedebug}
- var
- hp: tai;
- {$endif statedebug}
- begin
- With ptaiprop(p.optinfo)^.regs[supreg] 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[supreg]);
- ptaiprop(tai(StartMod).OptInfo)^.Regs[supreg].NrOfMods := NrOfMods;
- NrOfInstrSinceLastMod[supreg] := 0;
- invalidateDependingRegs(p.optinfo,supreg);
- ptaiprop(p.optinfo)^.regs[supreg].memwrite := nil;
- {$ifdef StateDebug}
- hp := tai_comment.Create(strpnew(std_regname(newreg(R_INTREGISTER,supreg,R_SUBWHOLE))+': '+tostr(ptaiprop(p.optinfo)^.Regs[supreg].WState)
- + ' -- ' + tostr(ptaiprop(p.optinfo)^.Regs[supreg].nrofmods)));
- InsertLLItem(AsmL, p, p.next, hp);
- {$endif StateDebug}
- end
- else
- begin
- {$ifdef statedebug}
- hp := tai_comment.Create(strpnew('destroying '+std_regname(newreg(R_INTREGISTER,supreg,R_SUBWHOLE))));
- insertllitem(asml,p,p.next,hp);
- {$endif statedebug}
- DestroyReg(ptaiprop(p.optinfo), supreg, true);
- {$ifdef StateDebug}
- hp := tai_comment.Create(strpnew(std_regname(newreg(R_INTREGISTER,supreg,R_SUBWHOLE))+': '+tostr(ptaiprop(p.optinfo)^.Regs[supreg].WState)));
- InsertLLItem(AsmL, p, p.next, hp);
- {$endif StateDebug}
- end
- end;
- procedure AddInstr2OpContents({$ifdef statedebug} asml: TAsmList; {$endif}
- p: taicpu; const oper: TOper);
- begin
- if oper.typ = top_reg then
- AddInstr2RegContents({$ifdef statedebug} asml, {$endif}p, getsupreg(oper.reg))
- else
- begin
- ReadOp(ptaiprop(p.optinfo), oper);
- DestroyOp(p, oper);
- end
- end;
- {*************************************************************************************}
- {************************************** TDFAOBJ **************************************}
- {*************************************************************************************}
- constructor tdfaobj.create(_list: TAsmList);
- begin
- list := _list;
- blockstart := nil;
- blockend := nil;
- nroftaiobjs := 0;
- taipropblock := nil;
- lolab := 0;
- hilab := 0;
- labdif := 0;
- labeltable := nil;
- end;
- procedure tdfaobj.initlabeltable;
- var
- labelfound: boolean;
- p, prev: tai;
- hp1, hp2: tai;
- {$ifdef i386}
- regcounter,
- supreg : tsuperregister;
- {$endif i386}
- usedregs, nodeallocregs: tregset;
- begin
- labelfound := false;
- lolab := maxlongint;
- hilab := 0;
- p := blockstart;
- prev := 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).labsym.labelnr < lolab) then
- lolab := tai_label(p).labsym.labelnr;
- if (tai_Label(p).labsym.labelnr > hilab) then
- hilab := tai_label(p).labsym.labelnr;
- end;
- prev := p;
- getnextinstruction(p, p);
- end;
- if (prev.typ = ait_marker) and
- (tai_marker(prev).kind = mark_AsmBlockStart) then
- blockend := prev
- else blockend := nil;
- if labelfound then
- labdif := hilab+1-lolab
- else labdif := 0;
- usedregs := [];
- if (labdif <> 0) then
- begin
- getmem(labeltable, labdif*sizeof(tlabeltableitem));
- fillchar(labeltable^, labdif*sizeof(tlabeltableitem), 0);
- end;
- p := blockstart;
- prev := p;
- while (p <> blockend) do
- begin
- case p.typ of
- ait_label:
- if not labelcanbeskipped(tai_label(p)) then
- labeltable^[tai_label(p).labsym.labelnr-lolab].taiobj := p;
- {$ifdef i386}
- ait_regalloc:
- if (getregtype(tai_regalloc(p).reg) = R_INTREGISTER) then
- begin
- supreg:=getsupreg(tai_regalloc(p).reg);
- case tai_regalloc(p).ratype of
- ra_alloc :
- begin
- if not(supreg in usedregs) then
- include(usedregs, supreg)
- else
- begin
- //addregdeallocfor(list, tai_regalloc(p).reg, p);
- hp1 := tai(p.previous);
- list.remove(p);
- p.free;
- p := hp1;
- end;
- end;
- ra_dealloc :
- begin
- exclude(usedregs, supreg);
- hp1 := p;
- hp2 := nil;
- while not(findregalloc(supreg,tai(hp1.next),ra_alloc)) and
- getnextinstruction(hp1, hp1) and
- regininstruction(getsupreg(tai_regalloc(p).reg), hp1) Do
- hp2 := hp1;
- if hp2 <> nil then
- begin
- hp1 := tai(p.previous);
- list.remove(p);
- insertllitem(list, hp2, tai(hp2.next), p);
- p := hp1;
- end
- else if findregalloc(getsupreg(tai_regalloc(p).reg), tai(p.next),ra_alloc)
- and getnextinstruction(p,hp1) then
- begin
- hp1 := tai(p.previous);
- list.remove(p);
- p.free;
- p := hp1;
- // don't include here, since then the allocation will be removed when it's processed
- // include(usedregs,supreg);
- end;
- end;
- end;
- end;
- {$endif i386}
- end;
- repeat
- prev := p;
- p := tai(p.next);
- until not(assigned(p)) or
- (p = blockend) or
- not(p.typ in (skipinstr - [ait_regalloc]));
- end;
- {$ifdef i386}
- { don't add deallocation for function result variable or for regvars}
- getNoDeallocRegs(noDeallocRegs);
- usedRegs := usedRegs - noDeallocRegs;
- for regCounter := RS_EAX to RS_EDI do
- if regCounter in usedRegs then
- addRegDeallocFor(list,newreg(R_INTREGISTER,regCounter,R_SUBWHOLE),prev);
- {$endif i386}
- end;
- function tdfaobj.pass_1(_blockstart: tai): tai;
- begin
- blockstart := _blockstart;
- initlabeltable;
- pass_1 := blockend;
- end;
- function tdfaobj.initdfapass2: 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
- labeltable^[tai_label(p).labsym.labelnr-lolab].instrnr := nroftaiobjs
- end;
- ait_instruction:
- begin
- if taicpu(p).is_jmp then
- begin
- if (tasmlabel(taicpu(p).oper[0]^.sym).labsymabelnr >= lolab) and
- (tasmlabel(taicpu(p).oper[0]^.sym).labsymabelnr <= hilab) then
- inc(labeltable^[tasmlabel(taicpu(p).oper[0]^.sym).labsymabelnr-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;
- 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;
- procedure tdfaobj.dodfapass2;
- {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 : tai;
- tmpref: TReference;
- tmpsupreg: tsuperregister;
- {$ifdef statedebug}
- hp : tai;
- {$endif}
- {$ifdef AnalyzeLoops}
- hp : tai;
- 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 := RS_EAX to RS_EDI Do
- curprop^.regs[tmpreg].WState := 1;}
- end;
- curprop^.UsedRegs := UsedRegs;
- curprop^.CanBeRemoved := False;
- UpdateUsedRegs(UsedRegs, tai(p.Next));
- For tmpsupreg := RS_EAX To RS_EDI Do
- if NrOfInstrSinceLastMod[tmpsupreg] < 255 then
- inc(NrOfInstrSinceLastMod[tmpsupreg])
- else
- begin
- NrOfInstrSinceLastMod[tmpsupreg] := 0;
- curprop^.regs[tmpsupreg].typ := con_unknown;
- end;
- case p.typ Of
- ait_marker:;
- ait_label:
- {$ifndef JumpAnal}
- if not labelCanBeSkipped(tai_label(p)) then
- DestroyAllRegs(curprop,false,false);
- {$else JumpAnal}
- begin
- if not labelCanBeSkipped(tai_label(p)) then
- With LTable^[tai_Label(p).labsym^.labelnr-LoLab] Do
- {$ifDef AnalyzeLoops}
- if (RefsFound = tai_Label(p).labsym^.RefCount)
- {$else AnalyzeLoops}
- if (JmpsProcessed = tai_Label(p).labsym^.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 tmpsupreg := RS_EAX to RS_EDI Do
- begin
- if (curprop^.regs[tmpsupreg].WState <>
- ptaiprop(hp.OptInfo)^.Regs[tmpsupreg].WState)
- then DestroyReg(curprop, tmpsupreg, 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).labsymabelnr = tai_Label(p).labsym^.labelnr)) and
- not((hp.typ = ait_label) and
- (LTable^[tai_Label(hp).labsym^.labelnr-LoLab].RefsFound
- = tai_Label(hp).labsym^.RefCount) and
- (LTable^[tai_Label(hp).labsym^.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),true,true)
- 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,true,true)
- end;
- end;
- {$endif JumpAnal}
- ait_stab, ait_force_line, ait_function_name:;
- ait_align: ; { may destroy flags !!! }
- ait_instruction:
- begin
- if taicpu(p).is_jmp or
- (taicpu(p).opcode = A_JMP) then
- begin
- {$ifNDef JumpAnal}
- for tmpsupreg := RS_EAX to RS_EDI do
- with curprop^.regs[tmpsupreg] 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).labsymabelnr-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 := RS_EAX to RS_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 := RS_EAX to RS_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 := RS_EAX to RS_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_comment.Create(strpnew('destroying '+std_regname(taicpu(p).oper[1]^.reg)));
- insertllitem(list,p,p.next,hp);
- {$endif statedebug}
- readOp(curprop, taicpu(p).oper[0]^);
- tmpsupreg := getsupreg(taicpu(p).oper[1]^.reg);
- if reginop(tmpsupreg, taicpu(p).oper[0]^) and
- (curprop^.regs[tmpsupreg].typ in [con_ref,con_noRemoveRef]) then
- begin
- with curprop^.regs[tmpsupreg] 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[tmpsupreg]);
- ptaiprop(startmod.optinfo)^.regs[tmpsupreg].nrOfMods := nrOfMods;
- nrOfInstrSinceLastMod[tmpsupreg] := 0;
- { Destroy the contents of the registers }
- { that depended on the previous value of }
- { this register }
- invalidateDependingRegs(curprop,tmpsupreg);
- curprop^.regs[tmpsupreg].memwrite := nil;
- end;
- end
- else
- begin
- {$ifdef statedebug}
- hp := tai_comment.Create(strpnew('destroying & initing '+std_regname(newreg(R_INTREGISTER,tmpsupreg,R_SUBWHOLE))));
- insertllitem(list,p,p.next,hp);
- {$endif statedebug}
- destroyReg(curprop, tmpsupreg, true);
- if not(reginop(tmpsupreg, taicpu(p).oper[0]^)) then
- with curprop^.regs[tmpsupreg] Do
- begin
- typ := con_ref;
- startmod := p;
- nrOfMods := 1;
- end
- end;
- {$ifdef StateDebug}
- hp := tai_comment.Create(strpnew(std_regname(newreg(R_INTREGISTER,tmpsupreg,R_SUBWHOLE))+': '+tostr(curprop^.regs[tmpsupreg].WState)));
- insertllitem(list,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, getsupreg(taicpu(p).oper[0]^.reg));
- DestroyRefs(p, taicpu(p).oper[1]^.ref^, getsupreg(taicpu(p).oper[0]^.reg),topsize2tcgsize[taicpu(p).opsize]);
- ptaiprop(p.optinfo)^.regs[getsupreg(taicpu(p).oper[0]^.reg)].memwrite :=
- taicpu(p);
- end
- else
- DestroyRefs(p, taicpu(p).oper[1]^.ref^, RS_INVALID,topsize2tcgsize[taicpu(p).opsize]);
- end;
- end;
- top_Const:
- begin
- case taicpu(p).oper[1]^.typ Of
- top_reg:
- begin
- tmpsupreg := getsupreg(taicpu(p).oper[1]^.reg);
- {$ifdef statedebug}
- hp := tai_comment.Create(strpnew('destroying '+std_regname(newreg(R_INTREGISTER,tmpsupreg,R_SUBWHOLE))));
- insertllitem(list,p,p.next,hp);
- {$endif statedebug}
- With curprop^.regs[tmpsupreg] Do
- begin
- DestroyReg(curprop, tmpsupreg, true);
- typ := Con_Const;
- StartMod := p;
- nrOfMods := 1;
- end
- end;
- top_ref:
- begin
- readref(curprop, taicpu(p).oper[1]^.ref);
- DestroyRefs(p, taicpu(p).oper[1]^.ref^, RS_INVALID,topsize2tcgsize[taicpu(p).opsize]);
- end;
- end;
- end;
- end;
- end;
- A_DIV, A_IDIV, A_MUL:
- begin
- ReadOp(curprop, taicpu(p).oper[0]^);
- readreg(curprop,RS_EAX);
- if (taicpu(p).OpCode = A_IDIV) or
- (taicpu(p).OpCode = A_DIV) then
- begin
- readreg(curprop,RS_EDX);
- end;
- {$ifdef statedebug}
- hp := tai_comment.Create(strpnew('destroying eax and edx'));
- insertllitem(list,p,p.next,hp);
- {$endif statedebug}
- { DestroyReg(curprop, RS_EAX, true);}
- AddInstr2RegContents({$ifdef statedebug}list,{$endif}
- taicpu(p), RS_EAX);
- DestroyReg(curprop, RS_EDX, true);
- LastFlagsChangeProp := curprop;
- end;
- A_IMUL:
- begin
- ReadOp(curprop,taicpu(p).oper[0]^);
- if (taicpu(p).ops >= 2) then
- ReadOp(curprop,taicpu(p).oper[1]^);
- if (taicpu(p).ops <= 2) then
- if (taicpu(p).ops=1) then
- begin
- readreg(curprop,RS_EAX);
- {$ifdef statedebug}
- hp := tai_comment.Create(strpnew('destroying eax and edx'));
- insertllitem(list,p,p.next,hp);
- {$endif statedebug}
- { DestroyReg(curprop, RS_EAX, true); }
- AddInstr2RegContents({$ifdef statedebug}list,{$endif}
- taicpu(p), RS_EAX);
- DestroyReg(curprop,RS_EDX, true)
- end
- else
- AddInstr2OpContents(
- {$ifdef statedebug}list,{$endif}
- taicpu(p), taicpu(p).oper[1]^)
- else
- AddInstr2OpContents({$ifdef statedebug}list,{$endif}
- taicpu(p), taicpu(p).oper[2]^);
- LastFlagsChangeProp := curprop;
- end;
- A_LEA:
- begin
- readop(curprop,taicpu(p).oper[0]^);
- if reginref(getsupreg(taicpu(p).oper[1]^.reg),taicpu(p).oper[0]^.ref^) then
- AddInstr2RegContents({$ifdef statedebug}list,{$endif}
- taicpu(p), getsupreg(taicpu(p).oper[1]^.reg))
- else
- begin
- {$ifdef statedebug}
- hp := tai_comment.Create(strpnew('destroying & initing'+
- std_regname(taicpu(p).oper[1]^.reg)));
- insertllitem(list,p,p.next,hp);
- {$endif statedebug}
- destroyreg(curprop,getsupreg(taicpu(p).oper[1]^.reg),true);
- with curprop^.regs[getsupreg(taicpu(p).oper[1]^.reg)] Do
- begin
- typ := con_ref;
- startmod := p;
- nrOfMods := 1;
- end
- end;
- end;
- else
- begin
- Cnt := 1;
- while (Cnt <= maxinschanges) and
- (InstrProp.Ch[Cnt] <> Ch_None) Do
- begin
- case InstrProp.Ch[Cnt] Of
- Ch_REAX..Ch_REDI:
- begin
- tmpsupreg:=tch2reg(InstrProp.Ch[Cnt]);
- readreg(curprop,tmpsupreg);
- end;
- Ch_WEAX..Ch_RWEDI:
- begin
- if (InstrProp.Ch[Cnt] >= Ch_RWEAX) then
- begin
- tmpsupreg:=tch2reg(InstrProp.Ch[Cnt]);
- readreg(curprop,tmpsupreg);
- end;
- {$ifdef statedebug}
- hp := tai_comment.Create(strpnew('destroying '+
- std_regname(tch2reg(InstrProp.Ch[Cnt]))));
- insertllitem(list,p,p.next,hp);
- {$endif statedebug}
- tmpsupreg:=tch2reg(InstrProp.Ch[Cnt]);
- DestroyReg(curprop,tmpsupreg, true);
- end;
- Ch_MEAX..Ch_MEDI:
- begin
- tmpsupreg:=tch2reg(InstrProp.Ch[Cnt]);
- AddInstr2RegContents({$ifdef statedebug} list,{$endif}
- taicpu(p),tmpsupreg);
- end;
- 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} list, {$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} list, {$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} list, {$endif}
- taicpu(p), taicpu(p).oper[2]^);
- Ch_WMemEDI:
- begin
- readreg(curprop, RS_EDI);
- fillchar(tmpref, SizeOf(tmpref), 0);
- tmpref.base := NR_EDI;
- tmpref.index := NR_EDI;
- DestroyRefs(p, tmpref,RS_INVALID,OS_32)
- 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_comment.Create(strpnew(
- 'destroying all regs for prev instruction'));
- insertllitem(list,p, p.next,hp);
- {$endif statedebug}
- DestroyAllRegs(curprop,true,true);
- LastFlagsChangeProp := curprop;
- end;
- end;
- inc(Cnt);
- end
- end;
- end;
- end;
- end
- else
- begin
- {$ifdef statedebug}
- hp := tai_comment.Create(strpnew(
- 'destroying all regs: unknown tai: '+tostr(ord(p.typ))));
- insertllitem(list,p, p.next,hp);
- {$endif statedebug}
- DestroyAllRegs(curprop,true,true);
- end;
- end;
- inc(InstrCnt);
- prev := p;
- GetNextInstruction(p, p);
- end;
- end;
- function tdfaobj.pass_generate_code: boolean;
- begin
- if initdfapass2 then
- begin
- dodfapass2;
- pass_generate_code := true
- end
- else
- pass_generate_code := false;
- end;
- {$ifopt r+}
- {$define rangewason}
- {$r-}
- {$endif}
- function tdfaobj.getlabelwithsym(sym: tasmlabel): tai;
- begin
- if (sym.labelnr >= lolab) and
- (sym.labelnr <= hilab) then { range check, a jump can go past an assembler block! }
- getlabelwithsym := labeltable^[sym.labelnr-lolab].taiobj
- else
- getlabelwithsym := nil;
- end;
- {$ifdef rangewason}
- {$r+}
- {$undef rangewason}
- {$endif}
- procedure tdfaobj.clear;
- begin
- if labdif <> 0 then
- begin
- freemem(labeltable);
- labeltable := nil;
- end;
- if assigned(taipropblock) then
- begin
- freemem(taipropblock, nroftaiobjs*sizeof(ttaiprop));
- taipropblock := nil;
- end;
- end;
- end.
|