daopt386.pas 95 KB

123456789101112131415161718192021222324252627282930313233343536373839404142434445464748495051525354555657585960616263646566676869707172737475767778798081828384858687888990919293949596979899100101102103104105106107108109110111112113114115116117118119120121122123124125126127128129130131132133134135136137138139140141142143144145146147148149150151152153154155156157158159160161162163164165166167168169170171172173174175176177178179180181182183184185186187188189190191192193194195196197198199200201202203204205206207208209210211212213214215216217218219220221222223224225226227228229230231232233234235236237238239240241242243244245246247248249250251252253254255256257258259260261262263264265266267268269270271272273274275276277278279280281282283284285286287288289290291292293294295296297298299300301302303304305306307308309310311312313314315316317318319320321322323324325326327328329330331332333334335336337338339340341342343344345346347348349350351352353354355356357358359360361362363364365366367368369370371372373374375376377378379380381382383384385386387388389390391392393394395396397398399400401402403404405406407408409410411412413414415416417418419420421422423424425426427428429430431432433434435436437438439440441442443444445446447448449450451452453454455456457458459460461462463464465466467468469470471472473474475476477478479480481482483484485486487488489490491492493494495496497498499500501502503504505506507508509510511512513514515516517518519520521522523524525526527528529530531532533534535536537538539540541542543544545546547548549550551552553554555556557558559560561562563564565566567568569570571572573574575576577578579580581582583584585586587588589590591592593594595596597598599600601602603604605606607608609610611612613614615616617618619620621622623624625626627628629630631632633634635636637638639640641642643644645646647648649650651652653654655656657658659660661662663664665666667668669670671672673674675676677678679680681682683684685686687688689690691692693694695696697698699700701702703704705706707708709710711712713714715716717718719720721722723724725726727728729730731732733734735736737738739740741742743744745746747748749750751752753754755756757758759760761762763764765766767768769770771772773774775776777778779780781782783784785786787788789790791792793794795796797798799800801802803804805806807808809810811812813814815816817818819820821822823824825826827828829830831832833834835836837838839840841842843844845846847848849850851852853854855856857858859860861862863864865866867868869870871872873874875876877878879880881882883884885886887888889890891892893894895896897898899900901902903904905906907908909910911912913914915916917918919920921922923924925926927928929930931932933934935936937938939940941942943944945946947948949950951952953954955956957958959960961962963964965966967968969970971972973974975976977978979980981982983984985986987988989990991992993994995996997998999100010011002100310041005100610071008100910101011101210131014101510161017101810191020102110221023102410251026102710281029103010311032103310341035103610371038103910401041104210431044104510461047104810491050105110521053105410551056105710581059106010611062106310641065106610671068106910701071107210731074107510761077107810791080108110821083108410851086108710881089109010911092109310941095109610971098109911001101110211031104110511061107110811091110111111121113111411151116111711181119112011211122112311241125112611271128112911301131113211331134113511361137113811391140114111421143114411451146114711481149115011511152115311541155115611571158115911601161116211631164116511661167116811691170117111721173117411751176117711781179118011811182118311841185118611871188118911901191119211931194119511961197119811991200120112021203120412051206120712081209121012111212121312141215121612171218121912201221122212231224122512261227122812291230123112321233123412351236123712381239124012411242124312441245124612471248124912501251125212531254125512561257125812591260126112621263126412651266126712681269127012711272127312741275127612771278127912801281128212831284128512861287128812891290129112921293129412951296129712981299130013011302130313041305130613071308130913101311131213131314131513161317131813191320132113221323132413251326132713281329133013311332133313341335133613371338133913401341134213431344134513461347134813491350135113521353135413551356135713581359136013611362136313641365136613671368136913701371137213731374137513761377137813791380138113821383138413851386138713881389139013911392139313941395139613971398139914001401140214031404140514061407140814091410141114121413141414151416141714181419142014211422142314241425142614271428142914301431143214331434143514361437143814391440144114421443144414451446144714481449145014511452145314541455145614571458145914601461146214631464146514661467146814691470147114721473147414751476147714781479148014811482148314841485148614871488148914901491149214931494149514961497149814991500150115021503150415051506150715081509151015111512151315141515151615171518151915201521152215231524152515261527152815291530153115321533153415351536153715381539154015411542154315441545154615471548154915501551155215531554155515561557155815591560156115621563156415651566156715681569157015711572157315741575157615771578157915801581158215831584158515861587158815891590159115921593159415951596159715981599160016011602160316041605160616071608160916101611161216131614161516161617161816191620162116221623162416251626162716281629163016311632163316341635163616371638163916401641164216431644164516461647164816491650165116521653165416551656165716581659166016611662166316641665166616671668166916701671167216731674167516761677167816791680168116821683168416851686168716881689169016911692169316941695169616971698169917001701170217031704170517061707170817091710171117121713171417151716171717181719172017211722172317241725172617271728172917301731173217331734173517361737173817391740174117421743174417451746174717481749175017511752175317541755175617571758175917601761176217631764176517661767176817691770177117721773177417751776177717781779178017811782178317841785178617871788178917901791179217931794179517961797179817991800180118021803180418051806180718081809181018111812181318141815181618171818181918201821182218231824182518261827182818291830183118321833183418351836183718381839184018411842184318441845184618471848184918501851185218531854185518561857185818591860186118621863186418651866186718681869187018711872187318741875187618771878187918801881188218831884188518861887188818891890189118921893189418951896189718981899190019011902190319041905190619071908190919101911191219131914191519161917191819191920192119221923192419251926192719281929193019311932193319341935193619371938193919401941194219431944194519461947194819491950195119521953195419551956195719581959196019611962196319641965196619671968196919701971197219731974197519761977197819791980198119821983198419851986198719881989199019911992199319941995199619971998199920002001200220032004200520062007200820092010201120122013201420152016201720182019202020212022202320242025202620272028202920302031203220332034203520362037203820392040204120422043204420452046204720482049205020512052205320542055205620572058205920602061206220632064206520662067206820692070207120722073207420752076207720782079208020812082208320842085208620872088208920902091209220932094209520962097209820992100210121022103210421052106210721082109211021112112211321142115211621172118211921202121212221232124212521262127212821292130213121322133213421352136213721382139214021412142214321442145214621472148214921502151215221532154215521562157215821592160216121622163216421652166216721682169217021712172217321742175217621772178217921802181218221832184218521862187218821892190219121922193219421952196219721982199220022012202220322042205220622072208220922102211221222132214221522162217221822192220222122222223222422252226222722282229223022312232223322342235223622372238223922402241224222432244224522462247224822492250225122522253225422552256225722582259226022612262226322642265226622672268226922702271227222732274227522762277227822792280228122822283228422852286228722882289229022912292229322942295229622972298229923002301230223032304230523062307230823092310231123122313231423152316231723182319232023212322232323242325232623272328232923302331233223332334233523362337233823392340234123422343234423452346234723482349235023512352235323542355235623572358235923602361236223632364236523662367236823692370237123722373237423752376237723782379238023812382238323842385238623872388238923902391239223932394239523962397239823992400240124022403240424052406240724082409241024112412241324142415241624172418241924202421242224232424242524262427242824292430243124322433243424352436243724382439244024412442244324442445244624472448244924502451245224532454245524562457245824592460246124622463246424652466246724682469247024712472247324742475247624772478247924802481248224832484248524862487248824892490249124922493249424952496249724982499250025012502250325042505250625072508250925102511251225132514251525162517251825192520252125222523252425252526252725282529253025312532253325342535253625372538253925402541254225432544254525462547254825492550255125522553255425552556255725582559256025612562256325642565256625672568256925702571257225732574257525762577257825792580258125822583258425852586258725882589259025912592259325942595259625972598259926002601260226032604260526062607260826092610261126122613261426152616261726182619262026212622262326242625262626272628262926302631263226332634263526362637263826392640264126422643264426452646264726482649265026512652265326542655265626572658265926602661266226632664266526662667266826692670267126722673267426752676267726782679268026812682268326842685268626872688268926902691269226932694269526962697269826992700270127022703270427052706270727082709271027112712271327142715271627172718271927202721272227232724272527262727272827292730273127322733273427352736273727382739274027412742274327442745274627472748274927502751275227532754275527562757275827592760276127622763276427652766276727682769277027712772277327742775277627772778277927802781278227832784278527862787278827892790279127922793279427952796279727982799280028012802280328042805280628072808280928102811281228132814281528162817281828192820282128222823
  1. {
  2. $Id$
  3. Copyright (c) 1998-2002 by Jonas Maebe, member of the Freepascal
  4. development team
  5. This unit contains the data flow analyzer and several helper procedures
  6. and functions.
  7. This program is free software; you can redistribute it and/or modify
  8. it under the terms of the GNU General Public License as published by
  9. the Free Software Foundation; either version 2 of the License, or
  10. (at your option) any later version.
  11. This program is distributed in the hope that it will be useful,
  12. but WITHOUT ANY WARRANTY; without even the implied warranty of
  13. MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
  14. GNU General Public License for more details.
  15. You should have received a copy of the GNU General Public License
  16. along with this program; if not, write to the Free Software
  17. Foundation, inc., 675 Mass Ave, Cambridge, MA 02139, USA.
  18. ****************************************************************************
  19. }
  20. unit daopt386;
  21. {$i fpcdefs.inc}
  22. interface
  23. uses
  24. globtype,
  25. cclasses,aasmbase,aasmtai,aasmcpu,cgbase,
  26. cpubase,optbase;
  27. {******************************* Constants *******************************}
  28. const
  29. { Possible register content types }
  30. con_Unknown = 0;
  31. con_ref = 1;
  32. con_const = 2;
  33. { The contents aren't usable anymore for CSE, but they may still be }
  34. { usefull for detecting whether the result of a load is actually used }
  35. con_invalid = 3;
  36. { the reverse of the above (in case a (conditional) jump is encountered): }
  37. { CSE is still possible, but the original instruction can't be removed }
  38. con_noRemoveRef = 4;
  39. { same, but for constants }
  40. con_noRemoveConst = 5;
  41. const
  42. topsize2tcgsize: array[topsize] of tcgsize = (OS_NO,
  43. OS_8,OS_16,OS_32,OS_64,OS_16,OS_32,OS_32,
  44. OS_16,OS_32,OS_64,
  45. OS_F32,OS_F64,OS_F80,OS_C64,OS_F128,
  46. OS_M32,OS_ADDR,OS_NO,OS_NO);
  47. {********************************* Types *********************************}
  48. type
  49. TRegArray = Array[RS_EAX..RS_ESP] of tsuperregister;
  50. TRegSet = Set of RS_EAX..RS_ESP;
  51. toptreginfo = Record
  52. NewRegsEncountered, OldRegsEncountered: TRegSet;
  53. RegsLoadedForRef: TRegSet;
  54. regsStillUsedAfterSeq: TRegSet;
  55. lastReload: array[RS_EAX..RS_ESP] of tai;
  56. New2OldReg: TRegArray;
  57. end;
  58. {possible actions on an operand: read, write or modify (= read & write)}
  59. TOpAction = (OpAct_Read, OpAct_Write, OpAct_Modify, OpAct_Unknown);
  60. {the possible states of a flag}
  61. TFlagContents = (F_Unknown, F_notSet, F_Set);
  62. TContent = Packed Record
  63. {start and end of block instructions that defines the
  64. content of this register.}
  65. StartMod: tai;
  66. MemWrite: taicpu;
  67. {how many instructions starting with StarMod does the block consist of}
  68. NrOfMods: Word;
  69. {the type of the content of the register: unknown, memory, constant}
  70. Typ: Byte;
  71. case byte of
  72. {starts at 0, gets increased everytime the register is written to}
  73. 1: (WState: Byte;
  74. {starts at 0, gets increased everytime the register is read from}
  75. RState: Byte);
  76. { to compare both states in one operation }
  77. 2: (state: word);
  78. end;
  79. {Contents of the integer registers}
  80. TRegContent = Array[RS_EAX..RS_ESP] Of TContent;
  81. {contents of the FPU registers}
  82. // TRegFPUContent = Array[RS_ST..RS_ST7] Of TContent;
  83. {$ifdef tempOpts}
  84. { linked list which allows searching/deleting based on value, no extra frills}
  85. PSearchLinkedListItem = ^TSearchLinkedListItem;
  86. TSearchLinkedListItem = object(TLinkedList_Item)
  87. constructor init;
  88. function equals(p: PSearchLinkedListItem): boolean; virtual;
  89. end;
  90. PSearchDoubleIntItem = ^TSearchDoubleInttem;
  91. TSearchDoubleIntItem = object(TLinkedList_Item)
  92. constructor init(_int1,_int2: longint);
  93. function equals(p: PSearchLinkedListItem): boolean; virtual;
  94. private
  95. int1, int2: longint;
  96. end;
  97. PSearchLinkedList = ^TSearchLinkedList;
  98. TSearchLinkedList = object(TLinkedList)
  99. function searchByValue(p: PSearchLinkedListItem): boolean;
  100. procedure removeByValue(p: PSearchLinkedListItem);
  101. end;
  102. {$endif tempOpts}
  103. {information record with the contents of every register. Every tai object
  104. gets one of these assigned: a pointer to it is stored in the OptInfo field}
  105. TtaiProp = Record
  106. Regs: TRegContent;
  107. { FPURegs: TRegFPUContent;} {currently not yet used}
  108. { allocated Registers }
  109. UsedRegs: TRegSet;
  110. { status of the direction flag }
  111. DirFlag: TFlagContents;
  112. {$ifdef tempOpts}
  113. { currently used temps }
  114. tempAllocs: PSearchLinkedList;
  115. {$endif tempOpts}
  116. { can this instruction be removed? }
  117. CanBeRemoved: Boolean;
  118. { are the resultflags set by this instruction used? }
  119. FlagsUsed: Boolean;
  120. end;
  121. ptaiprop = ^TtaiProp;
  122. TtaiPropBlock = Array[1..250000] Of TtaiProp;
  123. PtaiPropBlock = ^TtaiPropBlock;
  124. TInstrSinceLastMod = Array[RS_EAX..RS_ESP] Of Word;
  125. TLabelTableItem = Record
  126. taiObj: tai;
  127. {$ifDef JumpAnal}
  128. InstrNr: Longint;
  129. RefsFound: Word;
  130. JmpsProcessed: Word
  131. {$endif JumpAnal}
  132. end;
  133. TLabelTable = Array[0..2500000] Of TLabelTableItem;
  134. PLabelTable = ^TLabelTable;
  135. {*********************** procedures and functions ************************}
  136. procedure InsertLLItem(AsmL: TAAsmOutput; prev, foll, new_one: TLinkedListItem);
  137. function RefsEquivalent(const R1, R2: TReference; var RegInfo: toptreginfo; OpAct: TOpAction): Boolean;
  138. function RefsEqual(const R1, R2: TReference): Boolean;
  139. function isgp32reg(supreg: tsuperregister): Boolean;
  140. function reginref(supreg: tsuperregister; const ref: treference): boolean;
  141. function RegReadByInstruction(supreg: tsuperregister; hp: tai): boolean;
  142. function RegModifiedByInstruction(supreg: tsuperregister; p1: tai): boolean;
  143. function RegInInstruction(supreg: tsuperregister; p1: tai): boolean;
  144. function reginop(supreg: tsuperregister; const o:toper): boolean;
  145. function instrWritesFlags(p: tai): boolean;
  146. function instrReadsFlags(p: tai): boolean;
  147. function writeToMemDestroysContents(regWritten: tsuperregister; const ref: treference;
  148. supreg: tsuperregister; size: tcgsize; const c: tcontent; var invalsmemwrite: boolean): boolean;
  149. function writeToRegDestroysContents(destReg, supreg: tsuperregister;
  150. const c: tcontent): boolean;
  151. function writeDestroysContents(const op: toper; supreg: tsuperregister; size: tcgsize;
  152. const c: tcontent; var memwritedestroyed: boolean): boolean;
  153. function GetNextInstruction(Current: tai; var Next: tai): Boolean;
  154. function GetLastInstruction(Current: tai; var Last: tai): Boolean;
  155. procedure SkipHead(var p: tai);
  156. function labelCanBeSkipped(p: tai_label): boolean;
  157. procedure RemoveLastDeallocForFuncRes(asmL: TAAsmOutput; p: tai);
  158. function regLoadedWithNewValue(supreg: tsuperregister; canDependOnPrevValue: boolean;
  159. hp: tai): boolean;
  160. procedure UpdateUsedRegs(var UsedRegs: TRegSet; p: tai);
  161. procedure AllocRegBetween(asml: taasmoutput; reg: tregister; p1, p2: tai; const initialusedregs: tregset);
  162. function FindRegDealloc(supreg: tsuperregister; p: tai): boolean;
  163. //function RegsEquivalent(OldReg, NewReg: tregister; var RegInfo: toptreginfo; OpAct: TopAction): Boolean;
  164. function InstructionsEquivalent(p1, p2: tai; var RegInfo: toptreginfo): Boolean;
  165. function sizescompatible(loadsize,newsize: topsize): boolean;
  166. function OpsEqual(const o1,o2:toper): Boolean;
  167. type
  168. tdfaobj = class
  169. constructor create(_list: taasmoutput); virtual;
  170. function pass_1(_blockstart: tai): tai;
  171. function pass_2: boolean;
  172. procedure clear;
  173. function getlabelwithsym(sym: tasmlabel): tai;
  174. private
  175. { Walks through the list to find the lowest and highest label number, inits the }
  176. { labeltable and fixes/optimizes some regallocs }
  177. procedure initlabeltable;
  178. function initdfapass2: boolean;
  179. procedure dodfapass2;
  180. { asm list we're working on }
  181. list: taasmoutput;
  182. { current part of the asm list }
  183. blockstart, blockend: tai;
  184. { the amount of taiObjects in the current part of the assembler list }
  185. nroftaiobjs: longint;
  186. { Array which holds all TtaiProps }
  187. taipropblock: ptaipropblock;
  188. { all labels in the current block: their value mapped to their location }
  189. lolab, hilab, labdif: longint;
  190. labeltable: plabeltable;
  191. end;
  192. function FindLabel(L: tasmlabel; var hp: tai): Boolean;
  193. procedure incState(var S: Byte; amount: longint);
  194. {******************************* Variables *******************************}
  195. var
  196. dfa: tdfaobj;
  197. {*********************** end of Interface section ************************}
  198. Implementation
  199. Uses
  200. {$ifdef csdebug}
  201. cutils,
  202. {$else}
  203. {$ifdef statedebug}
  204. cutils,
  205. {$endif}
  206. {$endif}
  207. globals, systems, verbose, symconst, symsym, cgobj,
  208. rgobj, procinfo;
  209. Type
  210. TRefCompare = function(const r1, r2: treference; size: tcgsize): boolean;
  211. var
  212. {How many instructions are between the current instruction and the last one
  213. that modified the register}
  214. NrOfInstrSinceLastMod: TInstrSinceLastMod;
  215. {$ifdef tempOpts}
  216. constructor TSearchLinkedListItem.init;
  217. begin
  218. end;
  219. function TSearchLinkedListItem.equals(p: PSearchLinkedListItem): boolean;
  220. begin
  221. equals := false;
  222. end;
  223. constructor TSearchDoubleIntItem.init(_int1,_int2: longint);
  224. begin
  225. int1 := _int1;
  226. int2 := _int2;
  227. end;
  228. function TSearchDoubleIntItem.equals(p: PSearchLinkedListItem): boolean;
  229. begin
  230. equals := (TSearchDoubleIntItem(p).int1 = int1) and
  231. (TSearchDoubleIntItem(p).int2 = int2);
  232. end;
  233. function TSearchLinkedList.searchByValue(p: PSearchLinkedListItem): boolean;
  234. var temp: PSearchLinkedListItem;
  235. begin
  236. temp := first;
  237. while (temp <> last.next) and
  238. not(temp.equals(p)) do
  239. temp := temp.next;
  240. searchByValue := temp <> last.next;
  241. end;
  242. procedure TSearchLinkedList.removeByValue(p: PSearchLinkedListItem);
  243. begin
  244. temp := first;
  245. while (temp <> last.next) and
  246. not(temp.equals(p)) do
  247. temp := temp.next;
  248. if temp <> last.next then
  249. begin
  250. remove(temp);
  251. dispose(temp,done);
  252. end;
  253. end;
  254. procedure updateTempAllocs(var UsedRegs: TRegSet; p: tai);
  255. {updates UsedRegs with the RegAlloc Information coming after p}
  256. begin
  257. repeat
  258. while assigned(p) and
  259. ((p.typ in (SkipInstr - [ait_RegAlloc])) or
  260. ((p.typ = ait_label) and
  261. labelCanBeSkipped(tai_label(current)))) Do
  262. p := tai(p.next);
  263. while assigned(p) and
  264. (p.typ=ait_RegAlloc) Do
  265. begin
  266. case tai_regalloc(p).ratype of
  267. ra_alloc :
  268. UsedRegs := UsedRegs + [tai_regalloc(p).reg];
  269. ra_dealloc :
  270. UsedRegs := UsedRegs - [tai_regalloc(p).reg];
  271. end;
  272. p := tai(p.next);
  273. end;
  274. until not(assigned(p)) or
  275. (not(p.typ in SkipInstr) and
  276. not((p.typ = ait_label) and
  277. labelCanBeSkipped(tai_label(current))));
  278. end;
  279. {$endif tempOpts}
  280. {************************ Create the Label table ************************}
  281. function findregalloc(reg: tregister; starttai: tai; ratyp: tregalloctype): boolean;
  282. { Returns true if a ait_alloc object for reg is found in the block of tai's }
  283. { starting with Starttai and ending with the next "real" instruction }
  284. var
  285. supreg: tsuperregister;
  286. begin
  287. findregalloc := false;
  288. supreg := getsupreg(reg);
  289. repeat
  290. while assigned(starttai) and
  291. ((starttai.typ in (skipinstr - [ait_regalloc])) or
  292. ((starttai.typ = ait_label) and
  293. labelcanbeskipped(tai_label(starttai)))) do
  294. starttai := tai(starttai.next);
  295. if assigned(starttai) and
  296. (starttai.typ = ait_regalloc) then
  297. begin
  298. if (tai_regalloc(Starttai).ratype = ratyp) and
  299. (getsupreg(tai_regalloc(Starttai).reg) = supreg) then
  300. begin
  301. findregalloc:=true;
  302. break;
  303. end;
  304. starttai := tai(starttai.next);
  305. end
  306. else
  307. break;
  308. until false;
  309. end;
  310. procedure RemoveLastDeallocForFuncRes(asml: taasmoutput; p: tai);
  311. procedure DoRemoveLastDeallocForFuncRes(asml: taasmoutput; supreg: tsuperregister);
  312. var
  313. hp2: tai;
  314. begin
  315. hp2 := p;
  316. repeat
  317. hp2 := tai(hp2.previous);
  318. if assigned(hp2) and
  319. (hp2.typ = ait_regalloc) and
  320. (tai_regalloc(hp2).ratype=ra_dealloc) and
  321. (getregtype(tai_regalloc(hp2).reg) = R_INTREGISTER) and
  322. (getsupreg(tai_regalloc(hp2).reg) = supreg) then
  323. begin
  324. asml.remove(hp2);
  325. hp2.free;
  326. break;
  327. end;
  328. until not(assigned(hp2)) or regInInstruction(supreg,hp2);
  329. end;
  330. begin
  331. case current_procinfo.procdef.rettype.def.deftype of
  332. arraydef,recorddef,pointerdef,
  333. stringdef,enumdef,procdef,objectdef,errordef,
  334. filedef,setdef,procvardef,
  335. classrefdef,forwarddef:
  336. DoRemoveLastDeallocForFuncRes(asml,RS_EAX);
  337. orddef:
  338. if current_procinfo.procdef.rettype.def.size <> 0 then
  339. begin
  340. DoRemoveLastDeallocForFuncRes(asml,RS_EAX);
  341. { for int64/qword }
  342. if current_procinfo.procdef.rettype.def.size = 8 then
  343. DoRemoveLastDeallocForFuncRes(asml,RS_EDX);
  344. end;
  345. end;
  346. end;
  347. procedure getNoDeallocRegs(var regs: tregset);
  348. var
  349. regCounter: TSuperRegister;
  350. begin
  351. regs := [];
  352. case current_procinfo.procdef.rettype.def.deftype of
  353. arraydef,recorddef,pointerdef,
  354. stringdef,enumdef,procdef,objectdef,errordef,
  355. filedef,setdef,procvardef,
  356. classrefdef,forwarddef:
  357. regs := [RS_EAX];
  358. orddef:
  359. if current_procinfo.procdef.rettype.def.size <> 0 then
  360. begin
  361. regs := [RS_EAX];
  362. { for int64/qword }
  363. if current_procinfo.procdef.rettype.def.size = 8 then
  364. regs := regs + [RS_EDX];
  365. end;
  366. end;
  367. for regCounter := RS_EAX to RS_EBX do
  368. { if not(regCounter in rg.usableregsint) then}
  369. include(regs,regcounter);
  370. end;
  371. procedure AddRegDeallocFor(asml: taasmoutput; reg: tregister; p: tai);
  372. var
  373. hp1: tai;
  374. funcResRegs: tregset;
  375. funcResReg: boolean;
  376. begin
  377. { if not(supreg in rg.usableregsint) then
  378. exit;}
  379. { if not(supreg in [RS_EDI]) then
  380. exit;}
  381. getNoDeallocRegs(funcresregs);
  382. { funcResRegs := funcResRegs - rg.usableregsint;}
  383. { funcResRegs := funcResRegs - [RS_EDI];}
  384. { funcResRegs := funcResRegs - [RS_EAX,RS_EBX,RS_ECX,RS_EDX,RS_ESI]; }
  385. funcResReg := getsupreg(reg) in funcresregs;
  386. hp1 := p;
  387. {
  388. while not(funcResReg and
  389. (p.typ = ait_instruction) and
  390. (taicpu(p).opcode = A_JMP) and
  391. (tasmlabel(taicpu(p).oper[0]^.sym) = aktexit2label)) and
  392. getLastInstruction(p, p) and
  393. not(regInInstruction(supreg, p)) do
  394. hp1 := p;
  395. }
  396. { don't insert a dealloc for registers which contain the function result }
  397. { if they are followed by a jump to the exit label (for exit(...)) }
  398. { if not(funcResReg) or
  399. not((hp1.typ = ait_instruction) and
  400. (taicpu(hp1).opcode = A_JMP) and
  401. (tasmlabel(taicpu(hp1).oper[0]^.sym) = aktexit2label)) then }
  402. begin
  403. p := tai_regalloc.deAlloc(reg,nil);
  404. insertLLItem(AsmL, hp1.previous, hp1, p);
  405. end;
  406. end;
  407. {************************ Search the Label table ************************}
  408. function findlabel(l: tasmlabel; var hp: tai): boolean;
  409. {searches for the specified label starting from hp as long as the
  410. encountered instructions are labels, to be able to optimize constructs like
  411. jne l2 jmp l2
  412. jmp l3 and l1:
  413. l1: l2:
  414. l2:}
  415. var
  416. p: tai;
  417. begin
  418. p := hp;
  419. while assigned(p) and
  420. (p.typ in SkipInstr + [ait_label,ait_align]) Do
  421. if (p.typ <> ait_Label) or
  422. (tai_label(p).l <> l) then
  423. GetNextInstruction(p, p)
  424. else
  425. begin
  426. hp := p;
  427. findlabel := true;
  428. exit
  429. end;
  430. findlabel := false;
  431. end;
  432. {************************ Some general functions ************************}
  433. function tch2reg(ch: tinschange): tsuperregister;
  434. {converts a TChange variable to a TRegister}
  435. const
  436. ch2reg: array[CH_REAX..CH_REDI] of tsuperregister = (RS_EAX,RS_ECX,RS_EDX,RS_EBX,RS_ESP,RS_EBP,RS_ESI,RS_EDI);
  437. begin
  438. if (ch <= CH_REDI) then
  439. tch2reg := ch2reg[ch]
  440. else if (ch <= CH_WEDI) then
  441. tch2reg := ch2reg[tinschange(ord(ch) - ord(CH_REDI))]
  442. else if (ch <= CH_RWEDI) then
  443. tch2reg := ch2reg[tinschange(ord(ch) - ord(CH_WEDI))]
  444. else if (ch <= CH_MEDI) then
  445. tch2reg := ch2reg[tinschange(ord(ch) - ord(CH_RWEDI))]
  446. else
  447. InternalError($db)
  448. end;
  449. { inserts new_one between prev and foll }
  450. procedure InsertLLItem(AsmL: TAAsmOutput; prev, foll, new_one: TLinkedListItem);
  451. begin
  452. if assigned(prev) then
  453. if assigned(foll) then
  454. begin
  455. if assigned(new_one) then
  456. begin
  457. new_one.previous := prev;
  458. new_one.next := foll;
  459. prev.next := new_one;
  460. foll.previous := new_one;
  461. { shgould we update line information }
  462. if (not (tai(new_one).typ in SkipLineInfo)) and
  463. (not (tai(foll).typ in SkipLineInfo)) then
  464. tailineinfo(new_one).fileinfo := tailineinfo(foll).fileinfo;
  465. end;
  466. end
  467. else
  468. asml.Concat(new_one)
  469. else
  470. if assigned(foll) then
  471. asml.Insert(new_one)
  472. end;
  473. {********************* Compare parts of tai objects *********************}
  474. function regssamesize(reg1, reg2: tregister): boolean;
  475. {returns true if Reg1 and Reg2 are of the same size (so if they're both
  476. 8bit, 16bit or 32bit)}
  477. begin
  478. if (reg1 = NR_NO) or (reg2 = NR_NO) then
  479. internalerror(2003111602);
  480. regssamesize := getsubreg(reg1) = getsubreg(reg2);
  481. end;
  482. procedure AddReg2RegInfo(OldReg, NewReg: TRegister; var RegInfo: toptreginfo);
  483. {updates the ???RegsEncountered and ???2???reg fields of RegInfo. Assumes that
  484. OldReg and NewReg have the same size (has to be chcked in advance with
  485. RegsSameSize) and that neither equals RS_INVALID}
  486. var
  487. newsupreg, oldsupreg: tsuperregister;
  488. begin
  489. if (newreg = NR_NO) or (oldreg = NR_NO) then
  490. internalerror(2003111601);
  491. newsupreg := getsupreg(newreg);
  492. oldsupreg := getsupreg(oldreg);
  493. with RegInfo Do
  494. begin
  495. NewRegsEncountered := NewRegsEncountered + [newsupreg];
  496. OldRegsEncountered := OldRegsEncountered + [oldsupreg];
  497. New2OldReg[newsupreg] := oldsupreg;
  498. end;
  499. end;
  500. procedure AddOp2RegInfo(const o:toper; var reginfo: toptreginfo);
  501. begin
  502. case o.typ Of
  503. top_reg:
  504. if (o.reg <> NR_NO) then
  505. AddReg2RegInfo(o.reg, o.reg, RegInfo);
  506. top_ref:
  507. begin
  508. if o.ref^.base <> NR_NO then
  509. AddReg2RegInfo(o.ref^.base, o.ref^.base, RegInfo);
  510. if o.ref^.index <> NR_NO then
  511. AddReg2RegInfo(o.ref^.index, o.ref^.index, RegInfo);
  512. end;
  513. end;
  514. end;
  515. function RegsEquivalent(oldreg, newreg: tregister; var reginfo: toptreginfo; opact: topaction): Boolean;
  516. begin
  517. if not((oldreg = NR_NO) or (newreg = NR_NO)) then
  518. if RegsSameSize(oldreg, newreg) then
  519. with reginfo do
  520. {here we always check for the 32 bit component, because it is possible that
  521. the 8 bit component has not been set, event though NewReg already has been
  522. processed. This happens if it has been compared with a register that doesn't
  523. have an 8 bit component (such as EDI). in that case the 8 bit component is
  524. still set to RS_NO and the comparison in the else-part will fail}
  525. if (getsupreg(oldReg) in OldRegsEncountered) then
  526. if (getsupreg(NewReg) in NewRegsEncountered) then
  527. RegsEquivalent := (getsupreg(oldreg) = New2OldReg[getsupreg(newreg)])
  528. { if we haven't encountered the new register yet, but we have encountered the
  529. old one already, the new one can only be correct if it's being written to
  530. (and consequently the old one is also being written to), otherwise
  531. movl -8(%ebp), %eax and movl -8(%ebp), %eax
  532. movl (%eax), %eax movl (%edx), %edx
  533. are considered equivalent}
  534. else
  535. if (opact = opact_write) then
  536. begin
  537. AddReg2RegInfo(oldreg, newreg, reginfo);
  538. RegsEquivalent := true
  539. end
  540. else
  541. Regsequivalent := false
  542. else
  543. if not(getsupreg(newreg) in NewRegsEncountered) and
  544. ((opact = opact_write) or
  545. (newreg = oldreg)) then
  546. begin
  547. AddReg2RegInfo(oldreg, newreg, reginfo);
  548. RegsEquivalent := true
  549. end
  550. else
  551. RegsEquivalent := false
  552. else
  553. RegsEquivalent := false
  554. else
  555. RegsEquivalent := oldreg = newreg
  556. end;
  557. function RefsEquivalent(const r1, r2: treference; var regInfo: toptreginfo; opact: topaction): boolean;
  558. begin
  559. RefsEquivalent :=
  560. (r1.offset = r2.offset) and
  561. RegsEquivalent(r1.base, r2.base, reginfo, opact) and
  562. RegsEquivalent(r1.index, r2.index, reginfo, opact) and
  563. (r1.segment = r2.segment) and (r1.scalefactor = r2.scalefactor) and
  564. (r1.symbol = r2.symbol) and (r1.refaddr = r2.refaddr) and
  565. (r1.relsymbol = r2.relsymbol);
  566. end;
  567. function refsequal(const r1, r2: treference): boolean;
  568. begin
  569. refsequal :=
  570. (r1.offset = r2.offset) and
  571. (r1.segment = r2.segment) and (r1.base = r2.base) and
  572. (r1.index = r2.index) and (r1.scalefactor = r2.scalefactor) and
  573. (r1.symbol=r2.symbol) and (r1.refaddr = r2.refaddr) and
  574. (r1.relsymbol = r2.relsymbol);
  575. end;
  576. {$ifdef q+}
  577. {$q-}
  578. {$define overflowon}
  579. {$endif q+}
  580. // checks whether a write to r2 of size "size" contains address r1
  581. function refsoverlapping(const r1, r2: treference; size: tcgsize): boolean;
  582. var
  583. realsize: aword;
  584. begin
  585. realsize := tcgsize2size[size];
  586. refsoverlapping :=
  587. (aword(r1.offset-r2.offset) <= realsize) and
  588. (r1.segment = r2.segment) and (r1.base = r2.base) and
  589. (r1.index = r2.index) and (r1.scalefactor = r2.scalefactor) and
  590. (r1.symbol=r2.symbol) and (r1.refaddr = r2.refaddr) and
  591. (r1.relsymbol = r2.relsymbol);
  592. end;
  593. {$ifdef overflowon}
  594. {$q+}
  595. {$undef overflowon}
  596. {$endif overflowon}
  597. function isgp32reg(supreg: tsuperregister): boolean;
  598. {Checks if the register is a 32 bit general purpose register}
  599. begin
  600. isgp32reg := false;
  601. if (supreg >= RS_EAX) and (supreg <= RS_EBX) then
  602. isgp32reg := true
  603. end;
  604. function reginref(supreg: tsuperregister; const ref: treference): boolean;
  605. begin {checks whether ref contains a reference to reg}
  606. reginref :=
  607. ((ref.base <> NR_NO) and
  608. (getsupreg(ref.base) = supreg)) or
  609. ((ref.index <> NR_NO) and
  610. (getsupreg(ref.index) = supreg))
  611. end;
  612. function RegReadByInstruction(supreg: tsuperregister; hp: tai): boolean;
  613. var
  614. p: taicpu;
  615. opcount: longint;
  616. begin
  617. RegReadByInstruction := false;
  618. if hp.typ <> ait_instruction then
  619. exit;
  620. p := taicpu(hp);
  621. case p.opcode of
  622. A_CALL:
  623. regreadbyinstruction := true;
  624. A_IMUL:
  625. case p.ops of
  626. 1:
  627. regReadByInstruction :=
  628. (supreg = RS_EAX) or reginop(supreg,p.oper[0]^);
  629. 2,3:
  630. regReadByInstruction :=
  631. reginop(supreg,p.oper[0]^) or
  632. reginop(supreg,p.oper[1]^);
  633. end;
  634. A_IDIV,A_DIV,A_MUL:
  635. begin
  636. regReadByInstruction :=
  637. reginop(supreg,p.oper[0]^) or (supreg in [RS_EAX,RS_EDX]);
  638. end;
  639. else
  640. begin
  641. for opcount := 0 to p.ops-1 do
  642. if (p.oper[opCount]^.typ = top_ref) and
  643. reginref(supreg,p.oper[opcount]^.ref^) then
  644. begin
  645. RegReadByInstruction := true;
  646. exit
  647. end;
  648. for opcount := 1 to maxinschanges do
  649. case insprop[p.opcode].ch[opcount] of
  650. CH_REAX..CH_REDI,CH_RWEAX..CH_MEDI:
  651. if supreg = tch2reg(insprop[p.opcode].ch[opcount]) then
  652. begin
  653. RegReadByInstruction := true;
  654. exit
  655. end;
  656. CH_RWOP1,CH_ROP1,CH_MOP1:
  657. if //(p.oper[0]^.typ = top_reg) and
  658. reginop(supreg,p.oper[0]^) then
  659. begin
  660. RegReadByInstruction := true;
  661. exit
  662. end;
  663. Ch_RWOP2,Ch_ROP2,Ch_MOP2:
  664. if //(p.oper[1]^.typ = top_reg) and
  665. reginop(supreg,p.oper[1]^) then
  666. begin
  667. RegReadByInstruction := true;
  668. exit
  669. end;
  670. Ch_RWOP3,Ch_ROP3,Ch_MOP3:
  671. if //(p.oper[2]^.typ = top_reg) and
  672. reginop(supreg,p.oper[2]^) then
  673. begin
  674. RegReadByInstruction := true;
  675. exit
  676. end;
  677. end;
  678. end;
  679. end;
  680. end;
  681. function regInInstruction(supreg: tsuperregister; p1: tai): boolean;
  682. { Checks if reg is used by the instruction p1 }
  683. { Difference with "regReadBysinstruction() or regModifiedByInstruction()": }
  684. { this one ignores CH_ALL opcodes, while regModifiedByInstruction doesn't }
  685. var
  686. p: taicpu;
  687. opcount: Word;
  688. begin
  689. regInInstruction := false;
  690. if p1.typ <> ait_instruction then
  691. exit;
  692. p := taicpu(p1);
  693. case p.opcode of
  694. A_CALL:
  695. regininstruction := true;
  696. A_IMUL:
  697. case p.ops of
  698. 1:
  699. regInInstruction :=
  700. (supreg = RS_EAX) or reginop(supreg,p.oper[0]^);
  701. 2,3:
  702. regInInstruction :=
  703. reginop(supreg,p.oper[0]^) or
  704. reginop(supreg,p.oper[1]^) or
  705. (assigned(p.oper[2]) and
  706. reginop(supreg,p.oper[2]^));
  707. end;
  708. A_IDIV,A_DIV,A_MUL:
  709. regInInstruction :=
  710. reginop(supreg,p.oper[0]^) or
  711. (supreg in [RS_EAX,RS_EDX])
  712. else
  713. begin
  714. for opcount := 1 to maxinschanges do
  715. case insprop[p.opcode].Ch[opCount] of
  716. CH_REAX..CH_MEDI:
  717. if tch2reg(InsProp[p.opcode].Ch[opCount]) = supreg then
  718. begin
  719. regInInstruction := true;
  720. exit;
  721. end;
  722. CH_ROp1..CH_MOp1:
  723. if reginop(supreg,p.oper[0]^) then
  724. begin
  725. regInInstruction := true;
  726. exit
  727. end;
  728. Ch_ROp2..Ch_MOp2:
  729. if reginop(supreg,p.oper[1]^) then
  730. begin
  731. regInInstruction := true;
  732. exit
  733. end;
  734. Ch_ROp3..Ch_MOp3:
  735. if reginop(supreg,p.oper[2]^) then
  736. begin
  737. regInInstruction := true;
  738. exit
  739. end;
  740. end;
  741. end;
  742. end;
  743. end;
  744. function reginop(supreg: tsuperregister; const o:toper): boolean;
  745. begin
  746. reginop := false;
  747. case o.typ Of
  748. top_reg:
  749. reginop :=
  750. (getregtype(o.reg) = R_INTREGISTER) and
  751. (supreg = getsupreg(o.reg));
  752. top_ref:
  753. reginop :=
  754. ((o.ref^.base <> NR_NO) and
  755. (supreg = getsupreg(o.ref^.base))) or
  756. ((o.ref^.index <> NR_NO) and
  757. (supreg = getsupreg(o.ref^.index)));
  758. end;
  759. end;
  760. function RegModifiedByInstruction(supreg: tsuperregister; p1: tai): boolean;
  761. var
  762. InstrProp: TInsProp;
  763. TmpResult: Boolean;
  764. Cnt: Word;
  765. begin
  766. TmpResult := False;
  767. if supreg = RS_INVALID then
  768. exit;
  769. if (p1.typ = ait_instruction) then
  770. case taicpu(p1).opcode of
  771. A_IMUL:
  772. With taicpu(p1) Do
  773. TmpResult :=
  774. ((ops = 1) and (supreg in [RS_EAX,RS_EDX])) or
  775. ((ops = 2) and (getsupreg(oper[1]^.reg) = supreg)) or
  776. ((ops = 3) and (getsupreg(oper[2]^.reg) = supreg));
  777. A_DIV, A_IDIV, A_MUL:
  778. With taicpu(p1) Do
  779. TmpResult :=
  780. (supreg in [RS_EAX,RS_EDX]);
  781. else
  782. begin
  783. Cnt := 1;
  784. InstrProp := InsProp[taicpu(p1).OpCode];
  785. while (Cnt <= maxinschanges) and
  786. (InstrProp.Ch[Cnt] <> Ch_None) and
  787. not(TmpResult) Do
  788. begin
  789. case InstrProp.Ch[Cnt] Of
  790. Ch_WEAX..Ch_MEDI:
  791. TmpResult := supreg = tch2reg(InstrProp.Ch[Cnt]);
  792. Ch_RWOp1,Ch_WOp1,Ch_Mop1:
  793. TmpResult := (taicpu(p1).oper[0]^.typ = top_reg) and
  794. reginop(supreg,taicpu(p1).oper[0]^);
  795. Ch_RWOp2,Ch_WOp2,Ch_Mop2:
  796. TmpResult := (taicpu(p1).oper[1]^.typ = top_reg) and
  797. reginop(supreg,taicpu(p1).oper[1]^);
  798. Ch_RWOp3,Ch_WOp3,Ch_Mop3:
  799. TmpResult := (taicpu(p1).oper[2]^.typ = top_reg) and
  800. reginop(supreg,taicpu(p1).oper[2]^);
  801. Ch_FPU: TmpResult := false; // supreg is supposed to be an intreg!! supreg in [RS_ST..RS_ST7,RS_MM0..RS_MM7];
  802. Ch_ALL: TmpResult := true;
  803. end;
  804. inc(Cnt)
  805. end
  806. end
  807. end;
  808. RegModifiedByInstruction := TmpResult
  809. end;
  810. function instrWritesFlags(p: tai): boolean;
  811. var
  812. l: longint;
  813. begin
  814. instrWritesFlags := true;
  815. case p.typ of
  816. ait_instruction:
  817. begin
  818. for l := 1 to maxinschanges do
  819. if InsProp[taicpu(p).opcode].Ch[l] in [Ch_WFlags,Ch_RWFlags,Ch_All] then
  820. exit;
  821. end;
  822. ait_label:
  823. exit;
  824. end;
  825. instrWritesFlags := false;
  826. end;
  827. function instrReadsFlags(p: tai): boolean;
  828. var
  829. l: longint;
  830. begin
  831. instrReadsFlags := true;
  832. case p.typ of
  833. ait_instruction:
  834. begin
  835. for l := 1 to maxinschanges do
  836. if InsProp[taicpu(p).opcode].Ch[l] in [Ch_RFlags,Ch_RWFlags,Ch_All] then
  837. exit;
  838. end;
  839. ait_label:
  840. exit;
  841. end;
  842. instrReadsFlags := false;
  843. end;
  844. {********************* GetNext and GetLastInstruction *********************}
  845. function GetNextInstruction(Current: tai; var Next: tai): Boolean;
  846. { skips ait_regalloc, ait_regdealloc and ait_stab* objects and puts the }
  847. { next tai object in Next. Returns false if there isn't any }
  848. begin
  849. repeat
  850. if (Current.typ = ait_marker) and
  851. (tai_Marker(current).Kind = AsmBlockStart) then
  852. begin
  853. GetNextInstruction := False;
  854. Next := Nil;
  855. Exit
  856. end;
  857. Current := tai(current.Next);
  858. while assigned(Current) and
  859. ((current.typ in skipInstr) or
  860. ((current.typ = ait_label) and
  861. labelCanBeSkipped(tai_label(current)))) do
  862. Current := tai(current.Next);
  863. { if assigned(Current) and
  864. (current.typ = ait_Marker) and
  865. (tai_Marker(current).Kind = NoPropInfoStart) then
  866. begin
  867. while assigned(Current) and
  868. ((current.typ <> ait_Marker) or
  869. (tai_Marker(current).Kind <> NoPropInfoend)) Do
  870. Current := tai(current.Next);
  871. end;}
  872. until not(assigned(Current)) or
  873. (current.typ <> ait_Marker) or
  874. not(tai_Marker(current).Kind in [NoPropInfoStart,NoPropInfoend]);
  875. Next := Current;
  876. if assigned(Current) and
  877. not((current.typ in SkipInstr) or
  878. ((current.typ = ait_label) and
  879. labelCanBeSkipped(tai_label(current))))
  880. then
  881. GetNextInstruction :=
  882. not((current.typ = ait_marker) and
  883. (tai_marker(current).kind = asmBlockStart))
  884. else
  885. begin
  886. GetNextInstruction := False;
  887. Next := nil;
  888. end;
  889. end;
  890. function GetLastInstruction(Current: tai; var Last: tai): boolean;
  891. {skips the ait-types in SkipInstr puts the previous tai object in
  892. Last. Returns false if there isn't any}
  893. begin
  894. repeat
  895. Current := tai(current.previous);
  896. while assigned(Current) and
  897. (((current.typ = ait_Marker) and
  898. not(tai_Marker(current).Kind in [AsmBlockend{,NoPropInfoend}])) or
  899. (current.typ in SkipInstr) or
  900. ((current.typ = ait_label) and
  901. labelCanBeSkipped(tai_label(current)))) Do
  902. Current := tai(current.previous);
  903. { if assigned(Current) and
  904. (current.typ = ait_Marker) and
  905. (tai_Marker(current).Kind = NoPropInfoend) then
  906. begin
  907. while assigned(Current) and
  908. ((current.typ <> ait_Marker) or
  909. (tai_Marker(current).Kind <> NoPropInfoStart)) Do
  910. Current := tai(current.previous);
  911. end;}
  912. until not(assigned(Current)) or
  913. (current.typ <> ait_Marker) or
  914. not(tai_Marker(current).Kind in [NoPropInfoStart,NoPropInfoend]);
  915. if not(assigned(Current)) or
  916. (current.typ in SkipInstr) or
  917. ((current.typ = ait_label) and
  918. labelCanBeSkipped(tai_label(current))) or
  919. ((current.typ = ait_Marker) and
  920. (tai_Marker(current).Kind = AsmBlockend))
  921. then
  922. begin
  923. Last := nil;
  924. GetLastInstruction := False
  925. end
  926. else
  927. begin
  928. Last := Current;
  929. GetLastInstruction := True;
  930. end;
  931. end;
  932. procedure SkipHead(var p: tai);
  933. var
  934. oldp: tai;
  935. begin
  936. repeat
  937. oldp := p;
  938. if (p.typ in SkipInstr) or
  939. ((p.typ = ait_marker) and
  940. (tai_Marker(p).Kind in [AsmBlockend,inlinestart,inlineend])) then
  941. GetNextInstruction(p,p)
  942. else if ((p.Typ = Ait_Marker) and
  943. (tai_Marker(p).Kind = nopropinfostart)) then
  944. {a marker of the NoPropInfoStart can't be the first instruction of a
  945. TAAsmoutput list}
  946. GetNextInstruction(tai(p.previous),p);
  947. until p = oldp
  948. end;
  949. function labelCanBeSkipped(p: tai_label): boolean;
  950. begin
  951. labelCanBeSkipped := not(p.l.is_used) or p.l.is_addr;
  952. end;
  953. {******************* The Data Flow Analyzer functions ********************}
  954. function regLoadedWithNewValue(supreg: tsuperregister; canDependOnPrevValue: boolean;
  955. hp: tai): boolean;
  956. { assumes reg is a 32bit register }
  957. var
  958. p: taicpu;
  959. begin
  960. if not assigned(hp) or
  961. (hp.typ <> ait_instruction) then
  962. begin
  963. regLoadedWithNewValue := false;
  964. exit;
  965. end;
  966. p := taicpu(hp);
  967. regLoadedWithNewValue :=
  968. (((p.opcode = A_MOV) or
  969. (p.opcode = A_MOVZX) or
  970. (p.opcode = A_MOVSX) or
  971. (p.opcode = A_LEA)) and
  972. (p.oper[1]^.typ = top_reg) and
  973. (getsupreg(p.oper[1]^.reg) = supreg) and
  974. (canDependOnPrevValue or
  975. (p.oper[0]^.typ <> top_ref) or
  976. not regInRef(supreg,p.oper[0]^.ref^)) or
  977. ((p.opcode = A_POP) and
  978. (getsupreg(p.oper[0]^.reg) = supreg)));
  979. end;
  980. procedure UpdateUsedRegs(var UsedRegs: TRegSet; p: tai);
  981. {updates UsedRegs with the RegAlloc Information coming after p}
  982. begin
  983. repeat
  984. while assigned(p) and
  985. ((p.typ in (SkipInstr - [ait_RegAlloc])) or
  986. ((p.typ = ait_label) and
  987. labelCanBeSkipped(tai_label(p)))) Do
  988. p := tai(p.next);
  989. while assigned(p) and
  990. (p.typ=ait_RegAlloc) Do
  991. begin
  992. if (getregtype(tai_regalloc(p).reg) = R_INTREGISTER) then
  993. begin
  994. case tai_regalloc(p).ratype of
  995. ra_alloc :
  996. UsedRegs := UsedRegs + [getsupreg(tai_regalloc(p).reg)];
  997. ra_dealloc :
  998. UsedRegs := UsedRegs - [getsupreg(tai_regalloc(p).reg)];
  999. end;
  1000. end;
  1001. p := tai(p.next);
  1002. end;
  1003. until not(assigned(p)) or
  1004. (not(p.typ in SkipInstr) and
  1005. not((p.typ = ait_label) and
  1006. labelCanBeSkipped(tai_label(p))));
  1007. end;
  1008. procedure AllocRegBetween(asml: taasmoutput; reg: tregister; p1, p2: tai; const initialusedregs: tregset);
  1009. { allocates register reg between (and including) instructions p1 and p2 }
  1010. { the type of p1 and p2 must not be in SkipInstr }
  1011. { note that this routine is both called from the peephole optimizer }
  1012. { where optinfo is not yet initialised) and from the cse (where it is) }
  1013. var
  1014. hp: tai;
  1015. lastRemovedWasDealloc: boolean;
  1016. supreg: tsuperregister;
  1017. begin
  1018. {$ifdef EXTDEBUG}
  1019. if assigned(p1.optinfo) and
  1020. (ptaiprop(p1.optinfo)^.usedregs <> initialusedregs) then
  1021. internalerror(2004101010);
  1022. {$endif EXTDEBUG}
  1023. supreg := getsupreg(reg);
  1024. { if not(supreg in rg.usableregsint+[RS_EDI,RS_ESI]) or
  1025. not(assigned(p1)) then}
  1026. if not(supreg in [RS_EAX,RS_EBX,RS_ECX,RS_EDX,RS_EDI,RS_ESI]) or
  1027. not(assigned(p1)) then
  1028. { this happens with registers which are loaded implicitely, outside the }
  1029. { current block (e.g. esi with self) }
  1030. exit;
  1031. { make sure we allocate it for this instruction }
  1032. getnextinstruction(p2,p2);
  1033. lastRemovedWasDealloc := false;
  1034. {$ifdef allocregdebug}
  1035. hp := tai_comment.Create(strpnew('allocating '+std_reg2str[supreg]+
  1036. ' from here...')));
  1037. insertllitem(asml,p1.previous,p1,hp);
  1038. hp := tai_comment.Create(strpnew('allocated '+std_reg2str[supreg]+
  1039. ' till here...')));
  1040. insertllitem(asml,p2,p1.next,hp);
  1041. {$endif allocregdebug}
  1042. if not(supreg in initialusedregs) then
  1043. begin
  1044. hp := tai_regalloc.alloc(reg,nil);
  1045. insertllItem(asmL,p1.previous,p1,hp);
  1046. end;
  1047. while assigned(p1) and
  1048. (p1 <> p2) do
  1049. begin
  1050. if assigned(p1.optinfo) then
  1051. include(ptaiprop(p1.optinfo)^.usedregs,supreg);
  1052. p1 := tai(p1.next);
  1053. repeat
  1054. while assigned(p1) and
  1055. (p1.typ in (SkipInstr-[ait_regalloc])) Do
  1056. p1 := tai(p1.next);
  1057. { remove all allocation/deallocation info about the register in between }
  1058. if assigned(p1) and
  1059. (p1.typ = ait_regalloc) then
  1060. if (getsupreg(tai_regalloc(p1).reg) = supreg) then
  1061. begin
  1062. lastRemovedWasDealloc := (tai_regalloc(p1).ratype=ra_dealloc);
  1063. hp := tai(p1.Next);
  1064. asml.Remove(p1);
  1065. p1.free;
  1066. p1 := hp;
  1067. end
  1068. else p1 := tai(p1.next);
  1069. until not(assigned(p1)) or
  1070. not(p1.typ in SkipInstr);
  1071. end;
  1072. if assigned(p1) then
  1073. begin
  1074. if lastRemovedWasDealloc then
  1075. begin
  1076. hp := tai_regalloc.DeAlloc(reg,nil);
  1077. insertLLItem(asmL,p1.previous,p1,hp);
  1078. end;
  1079. end;
  1080. end;
  1081. function FindRegDealloc(supreg: tsuperregister; p: tai): boolean;
  1082. var
  1083. hp: tai;
  1084. first: boolean;
  1085. begin
  1086. findregdealloc := false;
  1087. first := true;
  1088. while assigned(p.previous) and
  1089. ((tai(p.previous).typ in (skipinstr+[ait_align])) or
  1090. ((tai(p.previous).typ = ait_label) and
  1091. labelCanBeSkipped(tai_label(p.previous)))) do
  1092. begin
  1093. p := tai(p.previous);
  1094. if (p.typ = ait_regalloc) and
  1095. (getsupreg(tai_regalloc(p).reg) = supreg) then
  1096. if (tai_regalloc(p).ratype=ra_dealloc) then
  1097. if first then
  1098. begin
  1099. findregdealloc := true;
  1100. break;
  1101. end
  1102. else
  1103. begin
  1104. findRegDealloc :=
  1105. getNextInstruction(p,hp) and
  1106. regLoadedWithNewValue(supreg,false,hp);
  1107. break
  1108. end
  1109. else
  1110. first := false;
  1111. end
  1112. end;
  1113. procedure incState(var S: Byte; amount: longint);
  1114. {increases S by 1, wraps around at $ffff to 0 (so we won't get overflow
  1115. errors}
  1116. begin
  1117. if (s <= $ff - amount) then
  1118. inc(s, amount)
  1119. else s := longint(s) + amount - $ff;
  1120. end;
  1121. function sequenceDependsonReg(const Content: TContent; seqreg: tsuperregister; supreg: tsuperregister): Boolean;
  1122. { Content is the sequence of instructions that describes the contents of }
  1123. { seqReg. reg is being overwritten by the current instruction. if the }
  1124. { content of seqReg depends on reg (ie. because of a }
  1125. { "movl (seqreg,reg), seqReg" instruction), this function returns true }
  1126. var
  1127. p: tai;
  1128. Counter: Word;
  1129. TmpResult: Boolean;
  1130. RegsChecked: TRegSet;
  1131. begin
  1132. RegsChecked := [];
  1133. p := Content.StartMod;
  1134. TmpResult := False;
  1135. Counter := 1;
  1136. while not(TmpResult) and
  1137. (Counter <= Content.NrOfMods) Do
  1138. begin
  1139. if (p.typ = ait_instruction) and
  1140. ((taicpu(p).opcode = A_MOV) or
  1141. (taicpu(p).opcode = A_MOVZX) or
  1142. (taicpu(p).opcode = A_MOVSX) or
  1143. (taicpu(p).opcode = A_LEA)) and
  1144. (taicpu(p).oper[0]^.typ = top_ref) then
  1145. With taicpu(p).oper[0]^.ref^ Do
  1146. if ((base = current_procinfo.FramePointer) or
  1147. (assigned(symbol) and (base = NR_NO))) and
  1148. (index = NR_NO) then
  1149. begin
  1150. RegsChecked := RegsChecked + [getsupreg(taicpu(p).oper[1]^.reg)];
  1151. if supreg = getsupreg(taicpu(p).oper[1]^.reg) then
  1152. break;
  1153. end
  1154. else
  1155. tmpResult :=
  1156. regReadByInstruction(supreg,p) and
  1157. regModifiedByInstruction(seqReg,p)
  1158. else
  1159. tmpResult :=
  1160. regReadByInstruction(supreg,p) and
  1161. regModifiedByInstruction(seqReg,p);
  1162. inc(Counter);
  1163. GetNextInstruction(p,p)
  1164. end;
  1165. sequenceDependsonReg := TmpResult
  1166. end;
  1167. procedure invalidateDependingRegs(p1: ptaiprop; supreg: tsuperregister);
  1168. var
  1169. counter: tsuperregister;
  1170. begin
  1171. for counter := RS_EAX to RS_EDI do
  1172. if counter <> supreg then
  1173. with p1^.regs[counter] Do
  1174. begin
  1175. if (typ in [con_ref,con_noRemoveRef]) and
  1176. sequenceDependsOnReg(p1^.Regs[counter],counter,supreg) then
  1177. if typ in [con_ref, con_invalid] then
  1178. typ := con_invalid
  1179. { con_noRemoveRef = con_unknown }
  1180. else
  1181. typ := con_unknown;
  1182. if assigned(memwrite) and
  1183. regInRef(counter,memwrite.oper[1]^.ref^) then
  1184. memwrite := nil;
  1185. end;
  1186. end;
  1187. procedure DestroyReg(p1: ptaiprop; supreg: tsuperregister; doincState:Boolean);
  1188. {Destroys the contents of the register reg in the ptaiprop p1, as well as the
  1189. contents of registers are loaded with a memory location based on reg.
  1190. doincState is false when this register has to be destroyed not because
  1191. it's contents are directly modified/overwritten, but because of an indirect
  1192. action (e.g. this register holds the contents of a variable and the value
  1193. of the variable in memory is changed) }
  1194. begin
  1195. { the following happens for fpu registers }
  1196. if (supreg < low(NrOfInstrSinceLastMod)) or
  1197. (supreg > high(NrOfInstrSinceLastMod)) then
  1198. exit;
  1199. NrOfInstrSinceLastMod[supreg] := 0;
  1200. with p1^.regs[supreg] do
  1201. begin
  1202. if doincState then
  1203. begin
  1204. incState(wstate,1);
  1205. typ := con_unknown;
  1206. startmod := nil;
  1207. end
  1208. else
  1209. if typ in [con_ref,con_const,con_invalid] then
  1210. typ := con_invalid
  1211. { con_noRemoveRef = con_unknown }
  1212. else
  1213. typ := con_unknown;
  1214. memwrite := nil;
  1215. end;
  1216. invalidateDependingRegs(p1,supreg);
  1217. end;
  1218. {procedure AddRegsToSet(p: tai; var RegSet: TRegSet);
  1219. begin
  1220. if (p.typ = ait_instruction) then
  1221. begin
  1222. case taicpu(p).oper[0]^.typ Of
  1223. top_reg:
  1224. if not(taicpu(p).oper[0]^.reg in [RS_NO,RS_ESP,current_procinfo.FramePointer]) then
  1225. RegSet := RegSet + [taicpu(p).oper[0]^.reg];
  1226. top_ref:
  1227. With TReference(taicpu(p).oper[0]^) Do
  1228. begin
  1229. if not(base in [current_procinfo.FramePointer,RS_NO,RS_ESP])
  1230. then RegSet := RegSet + [base];
  1231. if not(index in [current_procinfo.FramePointer,RS_NO,RS_ESP])
  1232. then RegSet := RegSet + [index];
  1233. end;
  1234. end;
  1235. case taicpu(p).oper[1]^.typ Of
  1236. top_reg:
  1237. if not(taicpu(p).oper[1]^.reg in [RS_NO,RS_ESP,current_procinfo.FramePointer]) then
  1238. if RegSet := RegSet + [TRegister(TwoWords(taicpu(p).oper[1]^).Word1];
  1239. top_ref:
  1240. With TReference(taicpu(p).oper[1]^) Do
  1241. begin
  1242. if not(base in [current_procinfo.FramePointer,RS_NO,RS_ESP])
  1243. then RegSet := RegSet + [base];
  1244. if not(index in [current_procinfo.FramePointer,RS_NO,RS_ESP])
  1245. then RegSet := RegSet + [index];
  1246. end;
  1247. end;
  1248. end;
  1249. end;}
  1250. function OpsEquivalent(const o1, o2: toper; var RegInfo: toptreginfo; OpAct: TopAction): Boolean;
  1251. begin {checks whether the two ops are equivalent}
  1252. OpsEquivalent := False;
  1253. if o1.typ=o2.typ then
  1254. case o1.typ Of
  1255. top_reg:
  1256. OpsEquivalent :=RegsEquivalent(o1.reg,o2.reg, RegInfo, OpAct);
  1257. top_ref:
  1258. OpsEquivalent := RefsEquivalent(o1.ref^, o2.ref^, RegInfo, OpAct);
  1259. Top_Const:
  1260. OpsEquivalent := o1.val = o2.val;
  1261. Top_None:
  1262. OpsEquivalent := True
  1263. end;
  1264. end;
  1265. function OpsEqual(const o1,o2:toper): Boolean;
  1266. begin {checks whether the two ops are equal}
  1267. OpsEqual := False;
  1268. if o1.typ=o2.typ then
  1269. case o1.typ Of
  1270. top_reg :
  1271. OpsEqual:=o1.reg=o2.reg;
  1272. top_ref :
  1273. OpsEqual := RefsEqual(o1.ref^, o2.ref^);
  1274. Top_Const :
  1275. OpsEqual:=o1.val=o2.val;
  1276. Top_None :
  1277. OpsEqual := True
  1278. end;
  1279. end;
  1280. function sizescompatible(loadsize,newsize: topsize): boolean;
  1281. begin
  1282. case loadsize of
  1283. S_B,S_BW,S_BL:
  1284. sizescompatible := (newsize = loadsize) or (newsize = S_B);
  1285. S_W,S_WL:
  1286. sizescompatible := (newsize = loadsize) or (newsize = S_W);
  1287. else
  1288. sizescompatible := newsize = S_L;
  1289. end;
  1290. end;
  1291. function opscompatible(p1,p2: taicpu): boolean;
  1292. begin
  1293. case p1.opcode of
  1294. A_MOVZX,A_MOVSX:
  1295. opscompatible :=
  1296. ((p2.opcode = p1.opcode) or (p2.opcode = A_MOV)) and
  1297. sizescompatible(p1.opsize,p2.opsize);
  1298. else
  1299. opscompatible :=
  1300. (p1.opcode = p2.opcode) and
  1301. (p1.ops = p2.ops) and
  1302. (p1.opsize = p2.opsize);
  1303. end;
  1304. end;
  1305. function InstructionsEquivalent(p1, p2: tai; var RegInfo: toptreginfo): Boolean;
  1306. {$ifdef csdebug}
  1307. var
  1308. hp: tai;
  1309. {$endif csdebug}
  1310. begin {checks whether two taicpu instructions are equal}
  1311. if assigned(p1) and assigned(p2) and
  1312. (tai(p1).typ = ait_instruction) and
  1313. (tai(p2).typ = ait_instruction) and
  1314. opscompatible(taicpu(p1),taicpu(p2)) and
  1315. (not(assigned(taicpu(p1).oper[0])) or
  1316. (taicpu(p1).oper[0]^.typ = taicpu(p2).oper[0]^.typ)) and
  1317. (not(assigned(taicpu(p1).oper[1])) or
  1318. (taicpu(p1).oper[1]^.typ = taicpu(p2).oper[1]^.typ)) and
  1319. (not(assigned(taicpu(p1).oper[2])) or
  1320. (taicpu(p1).oper[2]^.typ = taicpu(p2).oper[2]^.typ)) then
  1321. {both instructions have the same structure:
  1322. "<operator> <operand of type1>, <operand of type 2>"}
  1323. if ((taicpu(p1).opcode = A_MOV) or
  1324. (taicpu(p1).opcode = A_MOVZX) or
  1325. (taicpu(p1).opcode = A_MOVSX) or
  1326. (taicpu(p1).opcode = A_LEA)) and
  1327. (taicpu(p1).oper[0]^.typ = top_ref) {then .oper[1]^t = top_reg} then
  1328. if not(RegInRef(getsupreg(taicpu(p1).oper[1]^.reg), taicpu(p1).oper[0]^.ref^)) then
  1329. {the "old" instruction is a load of a register with a new value, not with
  1330. a value based on the contents of this register (so no "mov (reg), reg")}
  1331. if not(RegInRef(getsupreg(taicpu(p2).oper[1]^.reg), taicpu(p2).oper[0]^.ref^)) and
  1332. RefsEqual(taicpu(p1).oper[0]^.ref^, taicpu(p2).oper[0]^.ref^) then
  1333. {the "new" instruction is also a load of a register with a new value, and
  1334. this value is fetched from the same memory location}
  1335. begin
  1336. With taicpu(p2).oper[0]^.ref^ Do
  1337. begin
  1338. if (base <> NR_NO) and
  1339. (not(getsupreg(base) in [getsupreg(current_procinfo.FramePointer), RS_ESP])) then
  1340. include(RegInfo.RegsLoadedForRef, getsupreg(base));
  1341. if (index <> NR_NO) and
  1342. (not(getsupreg(index) in [getsupreg(current_procinfo.FramePointer), RS_ESP])) then
  1343. include(RegInfo.RegsLoadedForRef, getsupreg(index));
  1344. end;
  1345. {add the registers from the reference (.oper[0]^) to the RegInfo, all registers
  1346. from the reference are the same in the old and in the new instruction
  1347. sequence}
  1348. AddOp2RegInfo(taicpu(p1).oper[0]^, RegInfo);
  1349. {the registers from .oper[1]^ have to be equivalent, but not necessarily equal}
  1350. InstructionsEquivalent :=
  1351. RegsEquivalent(taicpu(p1).oper[1]^.reg,
  1352. taicpu(p2).oper[1]^.reg, RegInfo, OpAct_Write);
  1353. end
  1354. {the registers are loaded with values from different memory locations. if
  1355. this was allowed, the instructions "mov -4(esi),eax" and "mov -4(ebp),eax"
  1356. would be considered equivalent}
  1357. else
  1358. InstructionsEquivalent := False
  1359. else
  1360. {load register with a value based on the current value of this register}
  1361. begin
  1362. With taicpu(p2).oper[0]^.ref^ Do
  1363. begin
  1364. if (base <> NR_NO) and
  1365. (not(getsupreg(base) in [getsupreg(current_procinfo.FramePointer),
  1366. getsupreg(taicpu(p2).oper[1]^.reg),RS_ESP])) then
  1367. {it won't do any harm if the register is already in RegsLoadedForRef}
  1368. begin
  1369. include(RegInfo.RegsLoadedForRef, getsupreg(base));
  1370. {$ifdef csdebug}
  1371. Writeln(std_regname(base), ' added');
  1372. {$endif csdebug}
  1373. end;
  1374. if (index <> NR_NO) and
  1375. (not(getsupreg(index) in [getsupreg(current_procinfo.FramePointer),
  1376. getsupreg(taicpu(p2).oper[1]^.reg),RS_ESP])) then
  1377. begin
  1378. include(RegInfo.RegsLoadedForRef, getsupreg(index));
  1379. {$ifdef csdebug}
  1380. Writeln(std_regname(index), ' added');
  1381. {$endif csdebug}
  1382. end;
  1383. end;
  1384. if (taicpu(p2).oper[1]^.reg <> NR_NO) and
  1385. (not(getsupreg(taicpu(p2).oper[1]^.reg) in [getsupreg(current_procinfo.FramePointer),RS_ESP])) then
  1386. begin
  1387. RegInfo.RegsLoadedForRef := RegInfo.RegsLoadedForRef -
  1388. [getsupreg(taicpu(p2).oper[1]^.reg)];
  1389. {$ifdef csdebug}
  1390. Writeln(std_regname(newreg(R_INTREGISTER,getsupreg(taicpu(p2).oper[1]^.reg),R_SUBWHOLE)), ' removed');
  1391. {$endif csdebug}
  1392. end;
  1393. InstructionsEquivalent :=
  1394. OpsEquivalent(taicpu(p1).oper[0]^, taicpu(p2).oper[0]^, RegInfo, OpAct_Read) and
  1395. OpsEquivalent(taicpu(p1).oper[1]^, taicpu(p2).oper[1]^, RegInfo, OpAct_Write)
  1396. end
  1397. else
  1398. {an instruction <> mov, movzx, movsx}
  1399. begin
  1400. {$ifdef csdebug}
  1401. hp := tai_comment.Create(strpnew('checking if equivalent'));
  1402. hp.previous := p2;
  1403. hp.next := p2.next;
  1404. p2.next.previous := hp;
  1405. p2.next := hp;
  1406. {$endif csdebug}
  1407. InstructionsEquivalent :=
  1408. (not(assigned(taicpu(p1).oper[0])) or
  1409. OpsEquivalent(taicpu(p1).oper[0]^, taicpu(p2).oper[0]^, RegInfo, OpAct_Unknown)) and
  1410. (not(assigned(taicpu(p1).oper[1])) or
  1411. OpsEquivalent(taicpu(p1).oper[1]^, taicpu(p2).oper[1]^, RegInfo, OpAct_Unknown)) and
  1412. (not(assigned(taicpu(p1).oper[2])) or
  1413. OpsEquivalent(taicpu(p1).oper[2]^, taicpu(p2).oper[2]^, RegInfo, OpAct_Unknown))
  1414. end
  1415. {the instructions haven't even got the same structure, so they're certainly
  1416. not equivalent}
  1417. else
  1418. begin
  1419. {$ifdef csdebug}
  1420. hp := tai_comment.Create(strpnew('different opcodes/format'));
  1421. hp.previous := p2;
  1422. hp.next := p2.next;
  1423. p2.next.previous := hp;
  1424. p2.next := hp;
  1425. {$endif csdebug}
  1426. InstructionsEquivalent := False;
  1427. end;
  1428. {$ifdef csdebug}
  1429. hp := tai_comment.Create(strpnew('instreq: '+tostr(byte(instructionsequivalent))));
  1430. hp.previous := p2;
  1431. hp.next := p2.next;
  1432. p2.next.previous := hp;
  1433. p2.next := hp;
  1434. {$endif csdebug}
  1435. end;
  1436. (*
  1437. function InstructionsEqual(p1, p2: tai): Boolean;
  1438. begin {checks whether two taicpu instructions are equal}
  1439. InstructionsEqual :=
  1440. assigned(p1) and assigned(p2) and
  1441. ((tai(p1).typ = ait_instruction) and
  1442. (tai(p1).typ = ait_instruction) and
  1443. (taicpu(p1).opcode = taicpu(p2).opcode) and
  1444. (taicpu(p1).oper[0]^.typ = taicpu(p2).oper[0]^.typ) and
  1445. (taicpu(p1).oper[1]^.typ = taicpu(p2).oper[1]^.typ) and
  1446. OpsEqual(taicpu(p1).oper[0]^.typ, taicpu(p1).oper[0]^, taicpu(p2).oper[0]^) and
  1447. OpsEqual(taicpu(p1).oper[1]^.typ, taicpu(p1).oper[1]^, taicpu(p2).oper[1]^))
  1448. end;
  1449. *)
  1450. procedure readreg(p: ptaiprop; supreg: tsuperregister);
  1451. begin
  1452. if supreg in [RS_EAX..RS_EDI] then
  1453. incState(p^.regs[supreg].rstate,1)
  1454. end;
  1455. procedure readref(p: ptaiprop; const ref: preference);
  1456. begin
  1457. if ref^.base <> NR_NO then
  1458. readreg(p, getsupreg(ref^.base));
  1459. if ref^.index <> NR_NO then
  1460. readreg(p, getsupreg(ref^.index));
  1461. end;
  1462. procedure ReadOp(p: ptaiprop;const o:toper);
  1463. begin
  1464. case o.typ Of
  1465. top_reg: readreg(p, getsupreg(o.reg));
  1466. top_ref: readref(p, o.ref);
  1467. end;
  1468. end;
  1469. function RefInInstruction(const ref: TReference; p: tai;
  1470. RefsEq: TRefCompare; size: tcgsize): Boolean;
  1471. {checks whehter ref is used in p}
  1472. var
  1473. TmpResult: Boolean;
  1474. begin
  1475. TmpResult := False;
  1476. if (p.typ = ait_instruction) then
  1477. begin
  1478. if (taicpu(p).ops >= 1) and
  1479. (taicpu(p).oper[0]^.typ = top_ref) then
  1480. TmpResult := RefsEq(taicpu(p).oper[0]^.ref^,ref,size);
  1481. if not(TmpResult) and
  1482. (taicpu(p).ops >= 2) and
  1483. (taicpu(p).oper[1]^.typ = top_ref) then
  1484. TmpResult := RefsEq(taicpu(p).oper[1]^.ref^,ref,size);
  1485. if not(TmpResult) and
  1486. (taicpu(p).ops >= 3) and
  1487. (taicpu(p).oper[2]^.typ = top_ref) then
  1488. TmpResult := RefsEq(taicpu(p).oper[2]^.ref^,ref,size);
  1489. end;
  1490. RefInInstruction := TmpResult;
  1491. end;
  1492. function RefInSequence(const ref: TReference; Content: TContent;
  1493. RefsEq: TRefCompare; size: tcgsize): Boolean;
  1494. {checks the whole sequence of Content (so StartMod and and the next NrOfMods
  1495. tai objects) to see whether ref is used somewhere}
  1496. var p: tai;
  1497. Counter: Word;
  1498. TmpResult: Boolean;
  1499. begin
  1500. p := Content.StartMod;
  1501. TmpResult := False;
  1502. Counter := 1;
  1503. while not(TmpResult) and
  1504. (Counter <= Content.NrOfMods) Do
  1505. begin
  1506. if (p.typ = ait_instruction) and
  1507. RefInInstruction(ref, p, RefsEq, size)
  1508. then TmpResult := True;
  1509. inc(Counter);
  1510. GetNextInstruction(p,p)
  1511. end;
  1512. RefInSequence := TmpResult
  1513. end;
  1514. {$ifdef q+}
  1515. {$q-}
  1516. {$define overflowon}
  1517. {$endif q+}
  1518. // checks whether a write to r2 of size "size" contains address r1
  1519. function ArrayRefsOverlapping(const r1, r2: treference; size: tcgsize): Boolean;
  1520. var
  1521. realsize: aword;
  1522. begin
  1523. realsize := tcgsize2size[size];
  1524. ArrayRefsOverlapping := (aword(r1.offset-r2.offset) <= realsize) and
  1525. (r1.segment = r2.segment) and
  1526. (r1.symbol=r2.symbol) and
  1527. (r1.base = r2.base)
  1528. end;
  1529. {$ifdef overflowon}
  1530. {$q+}
  1531. {$undef overflowon}
  1532. {$endif overflowon}
  1533. function isSimpleRef(const ref: treference): boolean;
  1534. { returns true if ref is reference to a local or global variable, to a }
  1535. { parameter or to an object field (this includes arrays). Returns false }
  1536. { otherwise. }
  1537. begin
  1538. isSimpleRef :=
  1539. assigned(ref.symbol) or
  1540. (ref.base = current_procinfo.framepointer);
  1541. end;
  1542. function containsPointerRef(p: tai): boolean;
  1543. { checks if an instruction contains a reference which is a pointer location }
  1544. var
  1545. hp: taicpu;
  1546. count: longint;
  1547. begin
  1548. containsPointerRef := false;
  1549. if p.typ <> ait_instruction then
  1550. exit;
  1551. hp := taicpu(p);
  1552. for count := 0 to hp.ops-1 do
  1553. begin
  1554. case hp.oper[count]^.typ of
  1555. top_ref:
  1556. if not isSimpleRef(hp.oper[count]^.ref^) then
  1557. begin
  1558. containsPointerRef := true;
  1559. exit;
  1560. end;
  1561. top_none:
  1562. exit;
  1563. end;
  1564. end;
  1565. end;
  1566. function containsPointerLoad(c: tcontent): boolean;
  1567. { checks whether the contents of a register contain a pointer reference }
  1568. var
  1569. p: tai;
  1570. count: longint;
  1571. begin
  1572. containsPointerLoad := false;
  1573. p := c.startmod;
  1574. for count := c.nrOfMods downto 1 do
  1575. begin
  1576. if containsPointerRef(p) then
  1577. begin
  1578. containsPointerLoad := true;
  1579. exit;
  1580. end;
  1581. getnextinstruction(p,p);
  1582. end;
  1583. end;
  1584. function writeToMemDestroysContents(regWritten: tsuperregister; const ref: treference;
  1585. supreg: tsuperregister; size: tcgsize; const c: tcontent; var invalsmemwrite: boolean): boolean;
  1586. { returns whether the contents c of reg are invalid after regWritten is }
  1587. { is written to ref }
  1588. var
  1589. refsEq: trefCompare;
  1590. begin
  1591. if isSimpleRef(ref) then
  1592. begin
  1593. if (ref.index <> NR_NO) or
  1594. (assigned(ref.symbol) and
  1595. (ref.base <> NR_NO)) then
  1596. { local/global variable or parameter which is an array }
  1597. refsEq := {$ifdef fpc}@{$endif}arrayRefsOverlapping
  1598. else
  1599. { local/global variable or parameter which is not an array }
  1600. refsEq := {$ifdef fpc}@{$endif}refsOverlapping;
  1601. invalsmemwrite :=
  1602. assigned(c.memwrite) and
  1603. ((not(cs_uncertainOpts in aktglobalswitches) and
  1604. containsPointerRef(c.memwrite)) or
  1605. refsEq(c.memwrite.oper[1]^.ref^,ref,size));
  1606. if not(c.typ in [con_ref,con_noRemoveRef,con_invalid]) then
  1607. begin
  1608. writeToMemDestroysContents := false;
  1609. exit;
  1610. end;
  1611. { write something to a parameter, a local or global variable, so }
  1612. { * with uncertain optimizations on: }
  1613. { - destroy the contents of registers whose contents have somewhere a }
  1614. { "mov?? (ref), %reg". WhichReg (this is the register whose contents }
  1615. { are being written to memory) is not destroyed if it's StartMod is }
  1616. { of that form and NrOfMods = 1 (so if it holds ref, but is not a }
  1617. { expression based on ref) }
  1618. { * with uncertain optimizations off: }
  1619. { - also destroy registers that contain any pointer }
  1620. with c do
  1621. writeToMemDestroysContents :=
  1622. (typ in [con_ref,con_noRemoveRef]) and
  1623. ((not(cs_uncertainOpts in aktglobalswitches) and
  1624. containsPointerLoad(c)
  1625. ) or
  1626. (refInSequence(ref,c,refsEq,size) and
  1627. ((supreg <> regWritten) or
  1628. not((nrOfMods = 1) and
  1629. {StarMod is always of the type ait_instruction}
  1630. (taicpu(StartMod).oper[0]^.typ = top_ref) and
  1631. refsEq(taicpu(StartMod).oper[0]^.ref^, ref, size)
  1632. )
  1633. )
  1634. )
  1635. );
  1636. end
  1637. else
  1638. { write something to a pointer location, so }
  1639. { * with uncertain optimzations on: }
  1640. { - do not destroy registers which contain a local/global variable or }
  1641. { a parameter, except if DestroyRefs is called because of a "movsl" }
  1642. { * with uncertain optimzations off: }
  1643. { - destroy every register which contains a memory location }
  1644. begin
  1645. invalsmemwrite :=
  1646. assigned(c.memwrite) and
  1647. (not(cs_UncertainOpts in aktglobalswitches) or
  1648. containsPointerRef(c.memwrite));
  1649. if not(c.typ in [con_ref,con_noRemoveRef,con_invalid]) then
  1650. begin
  1651. writeToMemDestroysContents := false;
  1652. exit;
  1653. end;
  1654. with c do
  1655. writeToMemDestroysContents :=
  1656. (typ in [con_ref,con_noRemoveRef]) and
  1657. (not(cs_UncertainOpts in aktglobalswitches) or
  1658. { for movsl }
  1659. ((ref.base = NR_EDI) and (ref.index = NR_EDI)) or
  1660. { don't destroy if reg contains a parameter, local or global variable }
  1661. containsPointerLoad(c)
  1662. );
  1663. end;
  1664. end;
  1665. function writeToRegDestroysContents(destReg, supreg: tsuperregister;
  1666. const c: tcontent): boolean;
  1667. { returns whether the contents c of reg are invalid after destReg is }
  1668. { modified }
  1669. begin
  1670. writeToRegDestroysContents :=
  1671. (c.typ in [con_ref,con_noRemoveRef,con_invalid]) and
  1672. sequenceDependsOnReg(c,supreg,destReg);
  1673. end;
  1674. function writeDestroysContents(const op: toper; supreg: tsuperregister; size: tcgsize;
  1675. const c: tcontent; var memwritedestroyed: boolean): boolean;
  1676. { returns whether the contents c of reg are invalid after regWritten is }
  1677. { is written to op }
  1678. begin
  1679. memwritedestroyed := false;
  1680. case op.typ of
  1681. top_reg:
  1682. writeDestroysContents :=
  1683. writeToRegDestroysContents(getsupreg(op.reg),supreg,c);
  1684. top_ref:
  1685. writeDestroysContents :=
  1686. writeToMemDestroysContents(RS_INVALID,op.ref^,supreg,size,c,memwritedestroyed);
  1687. else
  1688. writeDestroysContents := false;
  1689. end;
  1690. end;
  1691. procedure destroyRefs(p: tai; const ref: treference; regwritten: tsuperregister; size: tcgsize);
  1692. { destroys all registers which possibly contain a reference to ref, regWritten }
  1693. { is the register whose contents are being written to memory (if this proc }
  1694. { is called because of a "mov?? %reg, (mem)" instruction) }
  1695. var
  1696. counter: tsuperregister;
  1697. destroymemwrite: boolean;
  1698. begin
  1699. for counter := RS_EAX to RS_EDI Do
  1700. begin
  1701. if writeToMemDestroysContents(regwritten,ref,counter,size,
  1702. ptaiprop(p.optInfo)^.regs[counter],destroymemwrite) then
  1703. destroyReg(ptaiprop(p.optInfo), counter, false)
  1704. else if destroymemwrite then
  1705. ptaiprop(p.optinfo)^.regs[counter].MemWrite := nil;
  1706. end;
  1707. end;
  1708. procedure DestroyAllRegs(p: ptaiprop; read, written: boolean);
  1709. var Counter: tsuperregister;
  1710. begin {initializes/desrtoys all registers}
  1711. For Counter := RS_EAX To RS_EDI Do
  1712. begin
  1713. if read then
  1714. readreg(p, Counter);
  1715. DestroyReg(p, Counter, written);
  1716. p^.regs[counter].MemWrite := nil;
  1717. end;
  1718. p^.DirFlag := F_Unknown;
  1719. end;
  1720. procedure DestroyOp(taiObj: tai; const o:Toper);
  1721. {$ifdef statedebug}
  1722. var
  1723. hp: tai;
  1724. {$endif statedebug}
  1725. begin
  1726. case o.typ Of
  1727. top_reg:
  1728. begin
  1729. {$ifdef statedebug}
  1730. hp := tai_comment.Create(strpnew('destroying '+std_regname(o.reg)));
  1731. hp.next := taiobj.next;
  1732. hp.previous := taiobj;
  1733. taiobj.next := hp;
  1734. if assigned(hp.next) then
  1735. hp.next.previous := hp;
  1736. {$endif statedebug}
  1737. DestroyReg(ptaiprop(taiObj.OptInfo), getsupreg(o.reg), true);
  1738. end;
  1739. top_ref:
  1740. begin
  1741. readref(ptaiprop(taiObj.OptInfo), o.ref);
  1742. DestroyRefs(taiObj, o.ref^, RS_INVALID,topsize2tcgsize[(taiobj as taicpu).opsize]);
  1743. end;
  1744. end;
  1745. end;
  1746. procedure AddInstr2RegContents({$ifdef statedebug} asml: taasmoutput; {$endif}
  1747. p: taicpu; supreg: tsuperregister);
  1748. {$ifdef statedebug}
  1749. var
  1750. hp: tai;
  1751. {$endif statedebug}
  1752. begin
  1753. With ptaiprop(p.optinfo)^.regs[supreg] Do
  1754. if (typ in [con_ref,con_noRemoveRef]) then
  1755. begin
  1756. incState(wstate,1);
  1757. { also store how many instructions are part of the sequence in the first }
  1758. { instructions ptaiprop, so it can be easily accessed from within }
  1759. { CheckSequence}
  1760. inc(NrOfMods, NrOfInstrSinceLastMod[supreg]);
  1761. ptaiprop(tai(StartMod).OptInfo)^.Regs[supreg].NrOfMods := NrOfMods;
  1762. NrOfInstrSinceLastMod[supreg] := 0;
  1763. invalidateDependingRegs(p.optinfo,supreg);
  1764. ptaiprop(p.optinfo)^.regs[supreg].memwrite := nil;
  1765. {$ifdef StateDebug}
  1766. hp := tai_comment.Create(strpnew(std_regname(newreg(R_INTREGISTER,supreg,R_SUBWHOLE))+': '+tostr(ptaiprop(p.optinfo)^.Regs[supreg].WState)
  1767. + ' -- ' + tostr(ptaiprop(p.optinfo)^.Regs[supreg].nrofmods)));
  1768. InsertLLItem(AsmL, p, p.next, hp);
  1769. {$endif StateDebug}
  1770. end
  1771. else
  1772. begin
  1773. {$ifdef statedebug}
  1774. hp := tai_comment.Create(strpnew('destroying '+std_regname(newreg(R_INTREGISTER,supreg,R_SUBWHOLE))));
  1775. insertllitem(asml,p,p.next,hp);
  1776. {$endif statedebug}
  1777. DestroyReg(ptaiprop(p.optinfo), supreg, true);
  1778. {$ifdef StateDebug}
  1779. hp := tai_comment.Create(strpnew(std_regname(newreg(R_INTREGISTER,supreg,R_SUBWHOLE))+': '+tostr(ptaiprop(p.optinfo)^.Regs[supreg].WState)));
  1780. InsertLLItem(AsmL, p, p.next, hp);
  1781. {$endif StateDebug}
  1782. end
  1783. end;
  1784. procedure AddInstr2OpContents({$ifdef statedebug} asml: TAAsmoutput; {$endif}
  1785. p: taicpu; const oper: TOper);
  1786. begin
  1787. if oper.typ = top_reg then
  1788. AddInstr2RegContents({$ifdef statedebug} asml, {$endif}p, getsupreg(oper.reg))
  1789. else
  1790. begin
  1791. ReadOp(ptaiprop(p.optinfo), oper);
  1792. DestroyOp(p, oper);
  1793. end
  1794. end;
  1795. {*************************************************************************************}
  1796. {************************************** TDFAOBJ **************************************}
  1797. {*************************************************************************************}
  1798. constructor tdfaobj.create(_list: taasmoutput);
  1799. begin
  1800. list := _list;
  1801. blockstart := nil;
  1802. blockend := nil;
  1803. nroftaiobjs := 0;
  1804. taipropblock := nil;
  1805. lolab := 0;
  1806. hilab := 0;
  1807. labdif := 0;
  1808. labeltable := nil;
  1809. end;
  1810. procedure tdfaobj.initlabeltable;
  1811. var
  1812. labelfound: boolean;
  1813. p, prev: tai;
  1814. hp1, hp2: tai;
  1815. {$ifdef i386}
  1816. regcounter,
  1817. supreg : tsuperregister;
  1818. {$endif i386}
  1819. usedregs, nodeallocregs: tregset;
  1820. begin
  1821. labelfound := false;
  1822. lolab := maxlongint;
  1823. hilab := 0;
  1824. p := blockstart;
  1825. prev := p;
  1826. while assigned(p) do
  1827. begin
  1828. if (tai(p).typ = ait_label) then
  1829. if not labelcanbeskipped(tai_label(p)) then
  1830. begin
  1831. labelfound := true;
  1832. if (tai_Label(p).l.labelnr < lolab) then
  1833. lolab := tai_label(p).l.labelnr;
  1834. if (tai_Label(p).l.labelnr > hilab) then
  1835. hilab := tai_label(p).l.labelnr;
  1836. end;
  1837. prev := p;
  1838. getnextinstruction(p, p);
  1839. end;
  1840. if (prev.typ = ait_marker) and
  1841. (tai_marker(prev).kind = asmblockstart) then
  1842. blockend := prev
  1843. else blockend := nil;
  1844. if labelfound then
  1845. labdif := hilab+1-lolab
  1846. else labdif := 0;
  1847. usedregs := [];
  1848. if (labdif <> 0) then
  1849. begin
  1850. getmem(labeltable, labdif*sizeof(tlabeltableitem));
  1851. fillchar(labeltable^, labdif*sizeof(tlabeltableitem), 0);
  1852. end;
  1853. p := blockstart;
  1854. prev := p;
  1855. while (p <> blockend) do
  1856. begin
  1857. case p.typ of
  1858. ait_label:
  1859. if not labelcanbeskipped(tai_label(p)) then
  1860. labeltable^[tai_label(p).l.labelnr-lolab].taiobj := p;
  1861. {$ifdef i386}
  1862. ait_regalloc:
  1863. begin
  1864. supreg:=getsupreg(tai_regalloc(p).reg);
  1865. case tai_regalloc(p).ratype of
  1866. ra_alloc :
  1867. begin
  1868. if not(supreg in usedregs) then
  1869. include(usedregs, supreg)
  1870. else
  1871. begin
  1872. //addregdeallocfor(list, tai_regalloc(p).reg, p);
  1873. hp1 := tai(p.previous);
  1874. list.remove(p);
  1875. p.free;
  1876. p := hp1;
  1877. end;
  1878. end;
  1879. ra_dealloc :
  1880. begin
  1881. exclude(usedregs, supreg);
  1882. hp1 := p;
  1883. hp2 := nil;
  1884. while not(findregalloc(tai_regalloc(p).reg, tai(hp1.next),ra_alloc)) and
  1885. getnextinstruction(hp1, hp1) and
  1886. regininstruction(getsupreg(tai_regalloc(p).reg), hp1) Do
  1887. hp2 := hp1;
  1888. if hp2 <> nil then
  1889. begin
  1890. hp1 := tai(p.previous);
  1891. list.remove(p);
  1892. insertllitem(list, hp2, tai(hp2.next), p);
  1893. p := hp1;
  1894. end
  1895. else if findregalloc(tai_regalloc(p).reg, tai(p.next),ra_alloc)
  1896. and getnextinstruction(p,hp1) and
  1897. (hp1.typ = ait_instruction) and
  1898. (taicpu(hp1).opcode = A_CALL) then
  1899. begin
  1900. hp1 := tai(p.previous);
  1901. list.remove(p);
  1902. p.free;
  1903. p := hp1;
  1904. include(usedregs,supreg);
  1905. end;
  1906. end;
  1907. end;
  1908. end;
  1909. {$endif i386}
  1910. end;
  1911. repeat
  1912. prev := p;
  1913. p := tai(p.next);
  1914. until not(assigned(p)) or
  1915. not(p.typ in (skipinstr - [ait_regalloc]));
  1916. end;
  1917. {$ifdef i386}
  1918. { don't add deallocation for function result variable or for regvars}
  1919. getNoDeallocRegs(noDeallocRegs);
  1920. usedRegs := usedRegs - noDeallocRegs;
  1921. for regCounter := RS_EAX to RS_EDI do
  1922. if regCounter in usedRegs then
  1923. addRegDeallocFor(list,newreg(R_INTREGISTER,regCounter,R_SUBWHOLE),prev);
  1924. {$endif i386}
  1925. end;
  1926. function tdfaobj.pass_1(_blockstart: tai): tai;
  1927. begin
  1928. blockstart := _blockstart;
  1929. initlabeltable;
  1930. pass_1 := blockend;
  1931. end;
  1932. function tdfaobj.initdfapass2: boolean;
  1933. {reserves memory for the PtaiProps in one big memory block when not using
  1934. TP, returns False if not enough memory is available for the optimizer in all
  1935. cases}
  1936. var
  1937. p: tai;
  1938. count: Longint;
  1939. { TmpStr: String; }
  1940. begin
  1941. p := blockstart;
  1942. skiphead(p);
  1943. nroftaiobjs := 0;
  1944. while (p <> blockend) do
  1945. begin
  1946. {$ifDef JumpAnal}
  1947. case p.typ of
  1948. ait_label:
  1949. begin
  1950. if not labelcanbeskipped(tai_label(p)) then
  1951. labeltable^[tai_label(p).l.labelnr-lolab].instrnr := nroftaiobjs
  1952. end;
  1953. ait_instruction:
  1954. begin
  1955. if taicpu(p).is_jmp then
  1956. begin
  1957. if (tasmlabel(taicpu(p).oper[0]^.sym).labelnr >= lolab) and
  1958. (tasmlabel(taicpu(p).oper[0]^.sym).labelnr <= hilab) then
  1959. inc(labeltable^[tasmlabel(taicpu(p).oper[0]^.sym).labelnr-lolab].refsfound);
  1960. end;
  1961. end;
  1962. { ait_instruction:
  1963. begin
  1964. if (taicpu(p).opcode = A_PUSH) and
  1965. (taicpu(p).oper[0]^.typ = top_symbol) and
  1966. (PCSymbol(taicpu(p).oper[0]^)^.offset = 0) then
  1967. begin
  1968. TmpStr := StrPas(PCSymbol(taicpu(p).oper[0]^)^.symbol);
  1969. if}
  1970. end;
  1971. {$endif JumpAnal}
  1972. inc(NrOftaiObjs);
  1973. getnextinstruction(p,p);
  1974. end;
  1975. if nroftaiobjs <> 0 then
  1976. begin
  1977. initdfapass2 := True;
  1978. getmem(taipropblock, nroftaiobjs*sizeof(ttaiprop));
  1979. fillchar(taiPropblock^,nroftaiobjs*sizeof(ttaiprop),0);
  1980. p := blockstart;
  1981. skiphead(p);
  1982. for count := 1 To nroftaiobjs do
  1983. begin
  1984. ptaiprop(p.optinfo) := @taipropblock^[count];
  1985. getnextinstruction(p, p);
  1986. end;
  1987. end
  1988. else
  1989. initdfapass2 := false;
  1990. end;
  1991. procedure tdfaobj.dodfapass2;
  1992. {Analyzes the Data Flow of an assembler list. Starts creating the reg
  1993. contents for the instructions starting with p. Returns the last tai which has
  1994. been processed}
  1995. var
  1996. curprop, LastFlagsChangeProp: ptaiprop;
  1997. Cnt, InstrCnt : Longint;
  1998. InstrProp: TInsProp;
  1999. UsedRegs: TRegSet;
  2000. prev,p : tai;
  2001. tmpref: TReference;
  2002. tmpsupreg: tsuperregister;
  2003. {$ifdef statedebug}
  2004. hp : tai;
  2005. {$endif}
  2006. {$ifdef AnalyzeLoops}
  2007. hp : tai;
  2008. TmpState: Byte;
  2009. {$endif AnalyzeLoops}
  2010. begin
  2011. p := BlockStart;
  2012. LastFlagsChangeProp := nil;
  2013. prev := nil;
  2014. UsedRegs := [];
  2015. UpdateUsedregs(UsedRegs, p);
  2016. SkipHead(p);
  2017. BlockStart := p;
  2018. InstrCnt := 1;
  2019. fillchar(NrOfInstrSinceLastMod, SizeOf(NrOfInstrSinceLastMod), 0);
  2020. while (p <> Blockend) Do
  2021. begin
  2022. curprop := @taiPropBlock^[InstrCnt];
  2023. if assigned(prev)
  2024. then
  2025. begin
  2026. {$ifdef JumpAnal}
  2027. if (p.Typ <> ait_label) then
  2028. {$endif JumpAnal}
  2029. begin
  2030. curprop^.regs := ptaiprop(prev.OptInfo)^.Regs;
  2031. curprop^.DirFlag := ptaiprop(prev.OptInfo)^.DirFlag;
  2032. curprop^.FlagsUsed := false;
  2033. end
  2034. end
  2035. else
  2036. begin
  2037. fillchar(curprop^, SizeOf(curprop^), 0);
  2038. { For tmpreg := RS_EAX to RS_EDI Do
  2039. curprop^.regs[tmpreg].WState := 1;}
  2040. end;
  2041. curprop^.UsedRegs := UsedRegs;
  2042. curprop^.CanBeRemoved := False;
  2043. UpdateUsedRegs(UsedRegs, tai(p.Next));
  2044. For tmpsupreg := RS_EAX To RS_EDI Do
  2045. if NrOfInstrSinceLastMod[tmpsupreg] < 255 then
  2046. inc(NrOfInstrSinceLastMod[tmpsupreg])
  2047. else
  2048. begin
  2049. NrOfInstrSinceLastMod[tmpsupreg] := 0;
  2050. curprop^.regs[tmpsupreg].typ := con_unknown;
  2051. end;
  2052. case p.typ Of
  2053. ait_marker:;
  2054. ait_label:
  2055. {$ifndef JumpAnal}
  2056. if not labelCanBeSkipped(tai_label(p)) then
  2057. DestroyAllRegs(curprop,false,false);
  2058. {$else JumpAnal}
  2059. begin
  2060. if not labelCanBeSkipped(tai_label(p)) then
  2061. With LTable^[tai_Label(p).l^.labelnr-LoLab] Do
  2062. {$ifDef AnalyzeLoops}
  2063. if (RefsFound = tai_Label(p).l^.RefCount)
  2064. {$else AnalyzeLoops}
  2065. if (JmpsProcessed = tai_Label(p).l^.RefCount)
  2066. {$endif AnalyzeLoops}
  2067. then
  2068. {all jumps to this label have been found}
  2069. {$ifDef AnalyzeLoops}
  2070. if (JmpsProcessed > 0)
  2071. then
  2072. {$endif AnalyzeLoops}
  2073. {we've processed at least one jump to this label}
  2074. begin
  2075. if (GetLastInstruction(p, hp) and
  2076. not(((hp.typ = ait_instruction)) and
  2077. (taicpu_labeled(hp).is_jmp))
  2078. then
  2079. {previous instruction not a JMP -> the contents of the registers after the
  2080. previous intruction has been executed have to be taken into account as well}
  2081. For tmpsupreg := RS_EAX to RS_EDI Do
  2082. begin
  2083. if (curprop^.regs[tmpsupreg].WState <>
  2084. ptaiprop(hp.OptInfo)^.Regs[tmpsupreg].WState)
  2085. then DestroyReg(curprop, tmpsupreg, true)
  2086. end
  2087. end
  2088. {$ifDef AnalyzeLoops}
  2089. else
  2090. {a label from a backward jump (e.g. a loop), no jump to this label has
  2091. already been processed}
  2092. if GetLastInstruction(p, hp) and
  2093. not(hp.typ = ait_instruction) and
  2094. (taicpu_labeled(hp).opcode = A_JMP))
  2095. then
  2096. {previous instruction not a jmp, so keep all the registers' contents from the
  2097. previous instruction}
  2098. begin
  2099. curprop^.regs := ptaiprop(hp.OptInfo)^.Regs;
  2100. curprop.DirFlag := ptaiprop(hp.OptInfo)^.DirFlag;
  2101. end
  2102. else
  2103. {previous instruction a jmp and no jump to this label processed yet}
  2104. begin
  2105. hp := p;
  2106. Cnt := InstrCnt;
  2107. {continue until we find a jump to the label or a label which has already
  2108. been processed}
  2109. while GetNextInstruction(hp, hp) and
  2110. not((hp.typ = ait_instruction) and
  2111. (taicpu(hp).is_jmp) and
  2112. (tasmlabel(taicpu(hp).oper[0]^.sym).labelnr = tai_Label(p).l^.labelnr)) and
  2113. not((hp.typ = ait_label) and
  2114. (LTable^[tai_Label(hp).l^.labelnr-LoLab].RefsFound
  2115. = tai_Label(hp).l^.RefCount) and
  2116. (LTable^[tai_Label(hp).l^.labelnr-LoLab].JmpsProcessed > 0)) Do
  2117. inc(Cnt);
  2118. if (hp.typ = ait_label)
  2119. then
  2120. {there's a processed label after the current one}
  2121. begin
  2122. curprop^.regs := taiPropBlock^[Cnt].Regs;
  2123. curprop.DirFlag := taiPropBlock^[Cnt].DirFlag;
  2124. end
  2125. else
  2126. {there's no label anymore after the current one, or they haven't been
  2127. processed yet}
  2128. begin
  2129. GetLastInstruction(p, hp);
  2130. curprop^.regs := ptaiprop(hp.OptInfo)^.Regs;
  2131. curprop.DirFlag := ptaiprop(hp.OptInfo)^.DirFlag;
  2132. DestroyAllRegs(ptaiprop(hp.OptInfo),true,true)
  2133. end
  2134. end
  2135. {$endif AnalyzeLoops}
  2136. else
  2137. {not all references to this label have been found, so destroy all registers}
  2138. begin
  2139. GetLastInstruction(p, hp);
  2140. curprop^.regs := ptaiprop(hp.OptInfo)^.Regs;
  2141. curprop.DirFlag := ptaiprop(hp.OptInfo)^.DirFlag;
  2142. DestroyAllRegs(curprop,true,true)
  2143. end;
  2144. end;
  2145. {$endif JumpAnal}
  2146. {$ifdef GDB}
  2147. ait_stabs, ait_stabn, ait_stab_function_name:;
  2148. {$endif GDB}
  2149. ait_align: ; { may destroy flags !!! }
  2150. ait_instruction:
  2151. begin
  2152. if taicpu(p).is_jmp or
  2153. (taicpu(p).opcode = A_JMP) then
  2154. begin
  2155. {$ifNDef JumpAnal}
  2156. for tmpsupreg := RS_EAX to RS_EDI do
  2157. with curprop^.regs[tmpsupreg] do
  2158. case typ of
  2159. con_ref: typ := con_noRemoveRef;
  2160. con_const: typ := con_noRemoveConst;
  2161. con_invalid: typ := con_unknown;
  2162. end;
  2163. {$else JumpAnal}
  2164. With LTable^[tasmlabel(taicpu(p).oper[0]^.sym).labelnr-LoLab] Do
  2165. if (RefsFound = tasmlabel(taicpu(p).oper[0]^.sym).RefCount) then
  2166. begin
  2167. if (InstrCnt < InstrNr)
  2168. then
  2169. {forward jump}
  2170. if (JmpsProcessed = 0) then
  2171. {no jump to this label has been processed yet}
  2172. begin
  2173. taiPropBlock^[InstrNr].Regs := curprop^.regs;
  2174. taiPropBlock^[InstrNr].DirFlag := curprop.DirFlag;
  2175. inc(JmpsProcessed);
  2176. end
  2177. else
  2178. begin
  2179. For tmpreg := RS_EAX to RS_EDI Do
  2180. if (taiPropBlock^[InstrNr].Regs[tmpreg].WState <>
  2181. curprop^.regs[tmpreg].WState) then
  2182. DestroyReg(@taiPropBlock^[InstrNr], tmpreg, true);
  2183. inc(JmpsProcessed);
  2184. end
  2185. {$ifdef AnalyzeLoops}
  2186. else
  2187. { backward jump, a loop for example}
  2188. { if (JmpsProcessed > 0) or
  2189. not(GetLastInstruction(taiObj, hp) and
  2190. (hp.typ = ait_labeled_instruction) and
  2191. (taicpu_labeled(hp).opcode = A_JMP))
  2192. then}
  2193. {instruction prior to label is not a jmp, or at least one jump to the label
  2194. has yet been processed}
  2195. begin
  2196. inc(JmpsProcessed);
  2197. For tmpreg := RS_EAX to RS_EDI Do
  2198. if (taiPropBlock^[InstrNr].Regs[tmpreg].WState <>
  2199. curprop^.regs[tmpreg].WState)
  2200. then
  2201. begin
  2202. TmpState := taiPropBlock^[InstrNr].Regs[tmpreg].WState;
  2203. Cnt := InstrNr;
  2204. while (TmpState = taiPropBlock^[Cnt].Regs[tmpreg].WState) Do
  2205. begin
  2206. DestroyReg(@taiPropBlock^[Cnt], tmpreg, true);
  2207. inc(Cnt);
  2208. end;
  2209. while (Cnt <= InstrCnt) Do
  2210. begin
  2211. inc(taiPropBlock^[Cnt].Regs[tmpreg].WState);
  2212. inc(Cnt)
  2213. end
  2214. end;
  2215. end
  2216. { else }
  2217. {instruction prior to label is a jmp and no jumps to the label have yet been
  2218. processed}
  2219. { begin
  2220. inc(JmpsProcessed);
  2221. For tmpreg := RS_EAX to RS_EDI Do
  2222. begin
  2223. TmpState := taiPropBlock^[InstrNr].Regs[tmpreg].WState;
  2224. Cnt := InstrNr;
  2225. while (TmpState = taiPropBlock^[Cnt].Regs[tmpreg].WState) Do
  2226. begin
  2227. taiPropBlock^[Cnt].Regs[tmpreg] := curprop^.regs[tmpreg];
  2228. inc(Cnt);
  2229. end;
  2230. TmpState := taiPropBlock^[InstrNr].Regs[tmpreg].WState;
  2231. while (TmpState = taiPropBlock^[Cnt].Regs[tmpreg].WState) Do
  2232. begin
  2233. DestroyReg(@taiPropBlock^[Cnt], tmpreg, true);
  2234. inc(Cnt);
  2235. end;
  2236. while (Cnt <= InstrCnt) Do
  2237. begin
  2238. inc(taiPropBlock^[Cnt].Regs[tmpreg].WState);
  2239. inc(Cnt)
  2240. end
  2241. end
  2242. end}
  2243. {$endif AnalyzeLoops}
  2244. end;
  2245. {$endif JumpAnal}
  2246. end
  2247. else
  2248. begin
  2249. InstrProp := InsProp[taicpu(p).opcode];
  2250. case taicpu(p).opcode Of
  2251. A_MOV, A_MOVZX, A_MOVSX:
  2252. begin
  2253. case taicpu(p).oper[0]^.typ Of
  2254. top_ref, top_reg:
  2255. case taicpu(p).oper[1]^.typ Of
  2256. top_reg:
  2257. begin
  2258. {$ifdef statedebug}
  2259. hp := tai_comment.Create(strpnew('destroying '+std_regname(taicpu(p).oper[1]^.reg)));
  2260. insertllitem(list,p,p.next,hp);
  2261. {$endif statedebug}
  2262. readOp(curprop, taicpu(p).oper[0]^);
  2263. tmpsupreg := getsupreg(taicpu(p).oper[1]^.reg);
  2264. if reginop(tmpsupreg, taicpu(p).oper[0]^) and
  2265. (curprop^.regs[tmpsupreg].typ in [con_ref,con_noRemoveRef]) then
  2266. begin
  2267. with curprop^.regs[tmpsupreg] Do
  2268. begin
  2269. incState(wstate,1);
  2270. { also store how many instructions are part of the sequence in the first }
  2271. { instruction's ptaiprop, so it can be easily accessed from within }
  2272. { CheckSequence }
  2273. inc(nrOfMods, nrOfInstrSinceLastMod[tmpsupreg]);
  2274. ptaiprop(startmod.optinfo)^.regs[tmpsupreg].nrOfMods := nrOfMods;
  2275. nrOfInstrSinceLastMod[tmpsupreg] := 0;
  2276. { Destroy the contents of the registers }
  2277. { that depended on the previous value of }
  2278. { this register }
  2279. invalidateDependingRegs(curprop,tmpsupreg);
  2280. curprop^.regs[tmpsupreg].memwrite := nil;
  2281. end;
  2282. end
  2283. else
  2284. begin
  2285. {$ifdef statedebug}
  2286. hp := tai_comment.Create(strpnew('destroying & initing '+std_regname(newreg(R_INTREGISTER,tmpsupreg,R_SUBWHOLE))));
  2287. insertllitem(list,p,p.next,hp);
  2288. {$endif statedebug}
  2289. destroyReg(curprop, tmpsupreg, true);
  2290. if not(reginop(tmpsupreg, taicpu(p).oper[0]^)) then
  2291. with curprop^.regs[tmpsupreg] Do
  2292. begin
  2293. typ := con_ref;
  2294. startmod := p;
  2295. nrOfMods := 1;
  2296. end
  2297. end;
  2298. {$ifdef StateDebug}
  2299. hp := tai_comment.Create(strpnew(std_regname(newreg(R_INTREGISTER,tmpsupreg,R_SUBWHOLE))+': '+tostr(curprop^.regs[tmpsupreg].WState)));
  2300. insertllitem(list,p,p.next,hp);
  2301. {$endif StateDebug}
  2302. end;
  2303. top_ref:
  2304. begin
  2305. readref(curprop, taicpu(p).oper[1]^.ref);
  2306. if taicpu(p).oper[0]^.typ = top_reg then
  2307. begin
  2308. readreg(curprop, getsupreg(taicpu(p).oper[0]^.reg));
  2309. DestroyRefs(p, taicpu(p).oper[1]^.ref^, getsupreg(taicpu(p).oper[0]^.reg),topsize2tcgsize[taicpu(p).opsize]);
  2310. ptaiprop(p.optinfo)^.regs[getsupreg(taicpu(p).oper[0]^.reg)].memwrite :=
  2311. taicpu(p);
  2312. end
  2313. else
  2314. DestroyRefs(p, taicpu(p).oper[1]^.ref^, RS_INVALID,topsize2tcgsize[taicpu(p).opsize]);
  2315. end;
  2316. end;
  2317. top_Const:
  2318. begin
  2319. case taicpu(p).oper[1]^.typ Of
  2320. top_reg:
  2321. begin
  2322. tmpsupreg := getsupreg(taicpu(p).oper[1]^.reg);
  2323. {$ifdef statedebug}
  2324. hp := tai_comment.Create(strpnew('destroying '+std_regname(newreg(R_INTREGISTER,tmpsupreg,R_SUBWHOLE))));
  2325. insertllitem(list,p,p.next,hp);
  2326. {$endif statedebug}
  2327. With curprop^.regs[tmpsupreg] Do
  2328. begin
  2329. DestroyReg(curprop, tmpsupreg, true);
  2330. typ := Con_Const;
  2331. StartMod := p;
  2332. end
  2333. end;
  2334. top_ref:
  2335. begin
  2336. readref(curprop, taicpu(p).oper[1]^.ref);
  2337. DestroyRefs(p, taicpu(p).oper[1]^.ref^, RS_INVALID,topsize2tcgsize[taicpu(p).opsize]);
  2338. end;
  2339. end;
  2340. end;
  2341. end;
  2342. end;
  2343. A_DIV, A_IDIV, A_MUL:
  2344. begin
  2345. ReadOp(curprop, taicpu(p).oper[0]^);
  2346. readreg(curprop,RS_EAX);
  2347. if (taicpu(p).OpCode = A_IDIV) or
  2348. (taicpu(p).OpCode = A_DIV) then
  2349. begin
  2350. readreg(curprop,RS_EDX);
  2351. end;
  2352. {$ifdef statedebug}
  2353. hp := tai_comment.Create(strpnew('destroying eax and edx'));
  2354. insertllitem(list,p,p.next,hp);
  2355. {$endif statedebug}
  2356. { DestroyReg(curprop, RS_EAX, true);}
  2357. AddInstr2RegContents({$ifdef statedebug}list,{$endif}
  2358. taicpu(p), RS_EAX);
  2359. DestroyReg(curprop, RS_EDX, true)
  2360. end;
  2361. A_IMUL:
  2362. begin
  2363. ReadOp(curprop,taicpu(p).oper[0]^);
  2364. if (taicpu(p).ops >= 2) then
  2365. ReadOp(curprop,taicpu(p).oper[1]^);
  2366. if (taicpu(p).ops <= 2) then
  2367. if (taicpu(p).oper[1]^.typ = top_none) then
  2368. begin
  2369. readreg(curprop,RS_EAX);
  2370. {$ifdef statedebug}
  2371. hp := tai_comment.Create(strpnew('destroying eax and edx'));
  2372. insertllitem(list,p,p.next,hp);
  2373. {$endif statedebug}
  2374. { DestroyReg(curprop, RS_EAX, true); }
  2375. AddInstr2RegContents({$ifdef statedebug}list,{$endif}
  2376. taicpu(p), RS_EAX);
  2377. DestroyReg(curprop,RS_EDX, true)
  2378. end
  2379. else
  2380. AddInstr2OpContents(
  2381. {$ifdef statedebug}list,{$endif}
  2382. taicpu(p), taicpu(p).oper[1]^)
  2383. else
  2384. AddInstr2OpContents({$ifdef statedebug}list,{$endif}
  2385. taicpu(p), taicpu(p).oper[2]^);
  2386. end;
  2387. A_LEA:
  2388. begin
  2389. readop(curprop,taicpu(p).oper[0]^);
  2390. if reginref(getsupreg(taicpu(p).oper[1]^.reg),taicpu(p).oper[0]^.ref^) then
  2391. AddInstr2RegContents({$ifdef statedebug}list,{$endif}
  2392. taicpu(p), getsupreg(taicpu(p).oper[1]^.reg))
  2393. else
  2394. begin
  2395. {$ifdef statedebug}
  2396. hp := tai_comment.Create(strpnew('destroying & initing'+
  2397. std_regname(taicpu(p).oper[1]^.reg)));
  2398. insertllitem(list,p,p.next,hp);
  2399. {$endif statedebug}
  2400. destroyreg(curprop,getsupreg(taicpu(p).oper[1]^.reg),true);
  2401. with curprop^.regs[getsupreg(taicpu(p).oper[1]^.reg)] Do
  2402. begin
  2403. typ := con_ref;
  2404. startmod := p;
  2405. nrOfMods := 1;
  2406. end
  2407. end;
  2408. end;
  2409. else
  2410. begin
  2411. Cnt := 1;
  2412. while (Cnt <= maxinschanges) and
  2413. (InstrProp.Ch[Cnt] <> Ch_None) Do
  2414. begin
  2415. case InstrProp.Ch[Cnt] Of
  2416. Ch_REAX..Ch_REDI:
  2417. begin
  2418. tmpsupreg:=tch2reg(InstrProp.Ch[Cnt]);
  2419. readreg(curprop,tmpsupreg);
  2420. end;
  2421. Ch_WEAX..Ch_RWEDI:
  2422. begin
  2423. if (InstrProp.Ch[Cnt] >= Ch_RWEAX) then
  2424. begin
  2425. tmpsupreg:=tch2reg(InstrProp.Ch[Cnt]);
  2426. readreg(curprop,tmpsupreg);
  2427. end;
  2428. {$ifdef statedebug}
  2429. hp := tai_comment.Create(strpnew('destroying '+
  2430. std_regname(tch2reg(InstrProp.Ch[Cnt]))));
  2431. insertllitem(list,p,p.next,hp);
  2432. {$endif statedebug}
  2433. tmpsupreg:=tch2reg(InstrProp.Ch[Cnt]);
  2434. DestroyReg(curprop,tmpsupreg, true);
  2435. end;
  2436. Ch_MEAX..Ch_MEDI:
  2437. begin
  2438. tmpsupreg:=tch2reg(InstrProp.Ch[Cnt]);
  2439. AddInstr2RegContents({$ifdef statedebug} list,{$endif}
  2440. taicpu(p),tmpsupreg);
  2441. end;
  2442. Ch_CDirFlag: curprop^.DirFlag := F_notSet;
  2443. Ch_SDirFlag: curprop^.DirFlag := F_Set;
  2444. Ch_Rop1: ReadOp(curprop, taicpu(p).oper[0]^);
  2445. Ch_Rop2: ReadOp(curprop, taicpu(p).oper[1]^);
  2446. Ch_ROp3: ReadOp(curprop, taicpu(p).oper[2]^);
  2447. Ch_Wop1..Ch_RWop1:
  2448. begin
  2449. if (InstrProp.Ch[Cnt] in [Ch_RWop1]) then
  2450. ReadOp(curprop, taicpu(p).oper[0]^);
  2451. DestroyOp(p, taicpu(p).oper[0]^);
  2452. end;
  2453. Ch_Mop1:
  2454. AddInstr2OpContents({$ifdef statedebug} list, {$endif}
  2455. taicpu(p), taicpu(p).oper[0]^);
  2456. Ch_Wop2..Ch_RWop2:
  2457. begin
  2458. if (InstrProp.Ch[Cnt] = Ch_RWop2) then
  2459. ReadOp(curprop, taicpu(p).oper[1]^);
  2460. DestroyOp(p, taicpu(p).oper[1]^);
  2461. end;
  2462. Ch_Mop2:
  2463. AddInstr2OpContents({$ifdef statedebug} list, {$endif}
  2464. taicpu(p), taicpu(p).oper[1]^);
  2465. Ch_WOp3..Ch_RWOp3:
  2466. begin
  2467. if (InstrProp.Ch[Cnt] = Ch_RWOp3) then
  2468. ReadOp(curprop, taicpu(p).oper[2]^);
  2469. DestroyOp(p, taicpu(p).oper[2]^);
  2470. end;
  2471. Ch_Mop3:
  2472. AddInstr2OpContents({$ifdef statedebug} list, {$endif}
  2473. taicpu(p), taicpu(p).oper[2]^);
  2474. Ch_WMemEDI:
  2475. begin
  2476. readreg(curprop, RS_EDI);
  2477. fillchar(tmpref, SizeOf(tmpref), 0);
  2478. tmpref.base := NR_EDI;
  2479. tmpref.index := NR_EDI;
  2480. DestroyRefs(p, tmpref,RS_INVALID,OS_32)
  2481. end;
  2482. Ch_RFlags:
  2483. if assigned(LastFlagsChangeProp) then
  2484. LastFlagsChangeProp^.FlagsUsed := true;
  2485. Ch_WFlags:
  2486. LastFlagsChangeProp := curprop;
  2487. Ch_RWFlags:
  2488. begin
  2489. if assigned(LastFlagsChangeProp) then
  2490. LastFlagsChangeProp^.FlagsUsed := true;
  2491. LastFlagsChangeProp := curprop;
  2492. end;
  2493. Ch_FPU:;
  2494. else
  2495. begin
  2496. {$ifdef statedebug}
  2497. hp := tai_comment.Create(strpnew(
  2498. 'destroying all regs for prev instruction'));
  2499. insertllitem(list,p, p.next,hp);
  2500. {$endif statedebug}
  2501. DestroyAllRegs(curprop,true,true);
  2502. LastFlagsChangeProp := curprop;
  2503. end;
  2504. end;
  2505. inc(Cnt);
  2506. end
  2507. end;
  2508. end;
  2509. end;
  2510. end
  2511. else
  2512. begin
  2513. {$ifdef statedebug}
  2514. hp := tai_comment.Create(strpnew(
  2515. 'destroying all regs: unknown tai: '+tostr(ord(p.typ))));
  2516. insertllitem(list,p, p.next,hp);
  2517. {$endif statedebug}
  2518. DestroyAllRegs(curprop,true,true);
  2519. end;
  2520. end;
  2521. inc(InstrCnt);
  2522. prev := p;
  2523. GetNextInstruction(p, p);
  2524. end;
  2525. end;
  2526. function tdfaobj.pass_2: boolean;
  2527. begin
  2528. if initdfapass2 then
  2529. begin
  2530. dodfapass2;
  2531. pass_2 := true
  2532. end
  2533. else
  2534. pass_2 := false;
  2535. end;
  2536. {$ifopt r+}
  2537. {$define rangewason}
  2538. {$r-}
  2539. {$endif}
  2540. function tdfaobj.getlabelwithsym(sym: tasmlabel): tai;
  2541. begin
  2542. if (sym.labelnr >= lolab) and
  2543. (sym.labelnr <= hilab) then { range check, a jump can go past an assembler block! }
  2544. getlabelwithsym := labeltable^[sym.labelnr-lolab].taiobj
  2545. else
  2546. getlabelwithsym := nil;
  2547. end;
  2548. {$ifdef rangewason}
  2549. {$r+}
  2550. {$undef rangewason}
  2551. {$endif}
  2552. procedure tdfaobj.clear;
  2553. begin
  2554. if labdif <> 0 then
  2555. begin
  2556. freemem(labeltable);
  2557. labeltable := nil;
  2558. end;
  2559. if assigned(taipropblock) then
  2560. begin
  2561. freemem(taipropblock, nroftaiobjs*sizeof(ttaiprop));
  2562. taipropblock := nil;
  2563. end;
  2564. end;
  2565. end.
  2566. {
  2567. $Log$
  2568. Revision 1.73 2004-10-10 15:01:19 jonas
  2569. * several fixes to allocregbetween()
  2570. Revision 1.72 2004/10/06 19:24:38 jonas
  2571. * take into account the size of a write to determine whether a write to
  2572. one reference influences the contents of another reference
  2573. Revision 1.71 2004/10/05 20:41:01 peter
  2574. * more spilling rewrites
  2575. Revision 1.70 2004/10/04 20:46:22 peter
  2576. * spilling code rewritten for x86. It now used the generic
  2577. spilling routines. Special x86 optimization still needs
  2578. to be added.
  2579. * Spilling fixed when both operands needed to be spilled
  2580. * Cleanup of spilling routine, do_spill_readwritten removed
  2581. Revision 1.69 2004/09/26 17:45:30 peter
  2582. * simple regvar support, not yet finished
  2583. Revision 1.68 2004/06/20 08:55:31 florian
  2584. * logs truncated
  2585. Revision 1.67 2004/05/22 23:34:28 peter
  2586. tai_regalloc.allocation changed to ratype to notify rgobj of register size changes
  2587. Revision 1.66 2004/02/27 19:55:23 jonas
  2588. * fixed optimizer for new treference fields
  2589. Revision 1.65 2004/02/27 10:21:05 florian
  2590. * top_symbol killed
  2591. + refaddr to treference added
  2592. + refsymbol to treference added
  2593. * top_local stuff moved to an extra record to save memory
  2594. + aint introduced
  2595. * tppufile.get/putint64/aint implemented
  2596. }