daopt386.pas 84 KB

123456789101112131415161718192021222324252627282930313233343536373839404142434445464748495051525354555657585960616263646566676869707172737475767778798081828384858687888990919293949596979899100101102103104105106107108109110111112113114115116117118119120121122123124125126127128129130131132133134135136137138139140141142143144145146147148149150151152153154155156157158159160161162163164165166167168169170171172173174175176177178179180181182183184185186187188189190191192193194195196197198199200201202203204205206207208209210211212213214215216217218219220221222223224225226227228229230231232233234235236237238239240241242243244245246247248249250251252253254255256257258259260261262263264265266267268269270271272273274275276277278279280281282283284285286287288289290291292293294295296297298299300301302303304305306307308309310311312313314315316317318319320321322323324325326327328329330331332333334335336337338339340341342343344345346347348349350351352353354355356357358359360361362363364365366367368369370371372373374375376377378379380381382383384385386387388389390391392393394395396397398399400401402403404405406407408409410411412413414415416417418419420421422423424425426427428429430431432433434435436437438439440441442443444445446447448449450451452453454455456457458459460461462463464465466467468469470471472473474475476477478479480481482483484485486487488489490491492493494495496497498499500501502503504505506507508509510511512513514515516517518519520521522523524525526527528529530531532533534535536537538539540541542543544545546547548549550551552553554555556557558559560561562563564565566567568569570571572573574575576577578579580581582583584585586587588589590591592593594595596597598599600601602603604605606607608609610611612613614615616617618619620621622623624625626627628629630631632633634635636637638639640641642643644645646647648649650651652653654655656657658659660661662663664665666667668669670671672673674675676677678679680681682683684685686687688689690691692693694695696697698699700701702703704705706707708709710711712713714715716717718719720721722723724725726727728729730731732733734735736737738739740741742743744745746747748749750751752753754755756757758759760761762763764765766767768769770771772773774775776777778779780781782783784785786787788789790791792793794795796797798799800801802803804805806807808809810811812813814815816817818819820821822823824825826827828829830831832833834835836837838839840841842843844845846847848849850851852853854855856857858859860861862863864865866867868869870871872873874875876877878879880881882883884885886887888889890891892893894895896897898899900901902903904905906907908909910911912913914915916917918919920921922923924925926927928929930931932933934935936937938939940941942943944945946947948949950951952953954955956957958959960961962963964965966967968969970971972973974975976977978979980981982983984985986987988989990991992993994995996997998999100010011002100310041005100610071008100910101011101210131014101510161017101810191020102110221023102410251026102710281029103010311032103310341035103610371038103910401041104210431044104510461047104810491050105110521053105410551056105710581059106010611062106310641065106610671068106910701071107210731074107510761077107810791080108110821083108410851086108710881089109010911092109310941095109610971098109911001101110211031104110511061107110811091110111111121113111411151116111711181119112011211122112311241125112611271128112911301131113211331134113511361137113811391140114111421143114411451146114711481149115011511152115311541155115611571158115911601161116211631164116511661167116811691170117111721173117411751176117711781179118011811182118311841185118611871188118911901191119211931194119511961197119811991200120112021203120412051206120712081209121012111212121312141215121612171218121912201221122212231224122512261227122812291230123112321233123412351236123712381239124012411242124312441245124612471248124912501251125212531254125512561257125812591260126112621263126412651266126712681269127012711272127312741275127612771278127912801281128212831284128512861287128812891290129112921293129412951296129712981299130013011302130313041305130613071308130913101311131213131314131513161317131813191320132113221323132413251326132713281329133013311332133313341335133613371338133913401341134213431344134513461347134813491350135113521353135413551356135713581359136013611362136313641365136613671368136913701371137213731374137513761377137813791380138113821383138413851386138713881389139013911392139313941395139613971398139914001401140214031404140514061407140814091410141114121413141414151416141714181419142014211422142314241425142614271428142914301431143214331434143514361437143814391440144114421443144414451446144714481449145014511452145314541455145614571458145914601461146214631464146514661467146814691470147114721473147414751476147714781479148014811482148314841485148614871488148914901491149214931494149514961497149814991500150115021503150415051506150715081509151015111512151315141515151615171518151915201521152215231524152515261527152815291530153115321533153415351536153715381539154015411542154315441545154615471548154915501551155215531554155515561557155815591560156115621563156415651566156715681569157015711572157315741575157615771578157915801581158215831584158515861587158815891590159115921593159415951596159715981599160016011602160316041605160616071608160916101611161216131614161516161617161816191620162116221623162416251626162716281629163016311632163316341635163616371638163916401641164216431644164516461647164816491650165116521653165416551656165716581659166016611662166316641665166616671668166916701671167216731674167516761677167816791680168116821683168416851686168716881689169016911692169316941695169616971698169917001701170217031704170517061707170817091710171117121713171417151716171717181719172017211722172317241725172617271728172917301731173217331734173517361737173817391740174117421743174417451746174717481749175017511752175317541755175617571758175917601761176217631764176517661767176817691770177117721773177417751776177717781779178017811782178317841785178617871788178917901791179217931794179517961797179817991800180118021803180418051806180718081809181018111812181318141815181618171818181918201821182218231824182518261827182818291830183118321833183418351836183718381839184018411842184318441845184618471848184918501851185218531854185518561857185818591860186118621863186418651866186718681869187018711872187318741875187618771878187918801881188218831884188518861887188818891890189118921893189418951896189718981899190019011902190319041905190619071908190919101911191219131914191519161917191819191920192119221923192419251926192719281929193019311932193319341935193619371938193919401941194219431944194519461947194819491950195119521953195419551956195719581959196019611962196319641965196619671968196919701971197219731974197519761977197819791980198119821983198419851986198719881989199019911992199319941995199619971998199920002001200220032004200520062007200820092010201120122013201420152016201720182019202020212022202320242025202620272028202920302031203220332034203520362037203820392040204120422043204420452046204720482049205020512052205320542055205620572058205920602061206220632064206520662067206820692070207120722073207420752076207720782079208020812082208320842085208620872088208920902091209220932094209520962097209820992100210121022103210421052106210721082109211021112112211321142115211621172118211921202121212221232124212521262127212821292130213121322133213421352136213721382139214021412142214321442145214621472148214921502151215221532154215521562157215821592160216121622163216421652166216721682169217021712172217321742175217621772178217921802181218221832184218521862187218821892190219121922193219421952196219721982199220022012202220322042205220622072208220922102211221222132214221522162217221822192220222122222223222422252226222722282229223022312232223322342235223622372238223922402241224222432244224522462247224822492250225122522253225422552256225722582259226022612262226322642265226622672268226922702271227222732274227522762277227822792280228122822283228422852286228722882289229022912292229322942295229622972298229923002301230223032304230523062307230823092310231123122313231423152316231723182319232023212322232323242325232623272328232923302331233223332334233523362337233823392340234123422343234423452346234723482349235023512352235323542355235623572358235923602361236223632364236523662367236823692370237123722373237423752376237723782379238023812382238323842385238623872388238923902391239223932394
  1. {
  2. $Id$
  3. Copyright (c) 1998-2000 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 defines.inc}
  22. Interface
  23. Uses
  24. GlobType,
  25. CObjects,Aasm,
  26. cpubase,cpuasm;
  27. Type
  28. TRegArray = Array[R_EAX..R_BL] of TRegister;
  29. TRegSet = Set of R_EAX..R_BL;
  30. TRegInfo = Record
  31. NewRegsEncountered, OldRegsEncountered: TRegSet;
  32. RegsLoadedForRef: TRegSet;
  33. regsStillUsedAfterSeq: TRegSet;
  34. lastReload: array[R_EAX..R_EDI] of pai;
  35. New2OldReg: TRegArray;
  36. End;
  37. {possible actions on an operand: read, write or modify (= read & write)}
  38. TOpAction = (OpAct_Read, OpAct_Write, OpAct_Modify, OpAct_Unknown);
  39. {*********************** Procedures and Functions ************************}
  40. Procedure InsertLLItem(AsmL: PAasmOutput; prev, foll, new_one: PLinkedList_Item);
  41. Function Reg32(Reg: TRegister): TRegister;
  42. Function RefsEquivalent(Const R1, R2: TReference; Var RegInfo: TRegInfo; OpAct: TOpAction): Boolean;
  43. Function RefsEqual(Const R1, R2: TReference): Boolean;
  44. Function IsGP32Reg(Reg: TRegister): Boolean;
  45. Function RegInRef(Reg: TRegister; Const Ref: TReference): Boolean;
  46. function RegReadByInstruction(reg: TRegister; hp: pai): boolean;
  47. function RegModifiedByInstruction(Reg: TRegister; p1: Pai): Boolean;
  48. function RegInInstruction(Reg: TRegister; p1: Pai): Boolean;
  49. function RegInOp(Reg: TRegister; const o:toper): Boolean;
  50. Function GetNextInstruction(Current: Pai; Var Next: Pai): Boolean;
  51. Function GetLastInstruction(Current: Pai; Var Last: Pai): Boolean;
  52. Procedure SkipHead(var P: Pai);
  53. function labelCanBeSkipped(p: pai_label): boolean;
  54. Procedure RemoveLastDeallocForFuncRes(asmL: PAasmOutput; p: pai);
  55. Function regLoadedWithNewValue(reg: tregister; canDependOnPrevValue: boolean;
  56. hp: pai): boolean;
  57. Procedure UpdateUsedRegs(Var UsedRegs: TRegSet; p: Pai);
  58. Procedure AllocRegBetween(AsmL: PAasmOutput; Reg: TRegister; p1, p2: Pai);
  59. Function RegsEquivalent(OldReg, NewReg: TRegister; Var RegInfo: TRegInfo; OpAct: TopAction): Boolean;
  60. Function InstructionsEquivalent(p1, p2: Pai; Var RegInfo: TRegInfo): Boolean;
  61. Function OpsEqual(const o1,o2:toper): Boolean;
  62. Function DFAPass1(AsmL: PAasmOutput; BlockStart: Pai): Pai;
  63. Function DFAPass2(
  64. {$ifdef statedebug}
  65. AsmL: PAasmOutPut;
  66. {$endif statedebug}
  67. BlockStart, BlockEnd: Pai): Boolean;
  68. Procedure ShutDownDFA;
  69. Function FindLabel(L: PasmLabel; Var hp: Pai): Boolean;
  70. Procedure IncState(Var S: Byte; amount: longint);
  71. {******************************* Constants *******************************}
  72. Const
  73. {Possible register content types}
  74. con_Unknown = 0;
  75. con_ref = 1;
  76. con_const = 2;
  77. { The contents aren't usable anymore for CSE, but they may still be }
  78. { usefull for detecting whether the result of a load is actually used }
  79. con_invalid = 3;
  80. { the reverse of the above (in case a (conditional) jump is encountered): }
  81. { CSE is still possible, but the original instruction can't be removed }
  82. con_noRemoveRef = 4;
  83. { same, but for constants }
  84. con_noRemoveConst = 5;
  85. {********************************* Types *********************************}
  86. type
  87. {the possible states of a flag}
  88. TFlagContents = (F_Unknown, F_NotSet, F_Set);
  89. TContent = Packed Record
  90. {start and end of block instructions that defines the
  91. content of this register.}
  92. StartMod: pai;
  93. {how many instructions starting with StarMod does the block consist of}
  94. NrOfMods: Byte;
  95. {the type of the content of the register: unknown, memory, constant}
  96. Typ: Byte;
  97. case byte of
  98. {starts at 0, gets increased everytime the register is written to}
  99. 1: (WState: Byte;
  100. {starts at 0, gets increased everytime the register is read from}
  101. RState: Byte);
  102. { to compare both states in one operation }
  103. 2: (state: word);
  104. End;
  105. {Contents of the integer registers}
  106. TRegContent = Array[R_EAX..R_EDI] Of TContent;
  107. {contents of the FPU registers}
  108. TRegFPUContent = Array[R_ST..R_ST7] Of TContent;
  109. {$ifdef tempOpts}
  110. { linked list which allows searching/deleting based on value, no extra frills}
  111. PSearchLinkedListItem = ^TSearchLinkedListItem;
  112. TSearchLinkedListItem = object(TLinkedList_Item)
  113. constructor init;
  114. function equals(p: PSearchLinkedListItem): boolean; virtual;
  115. end;
  116. PSearchDoubleIntItem = ^TSearchDoubleInttem;
  117. TSearchDoubleIntItem = object(TLinkedList_Item)
  118. constructor init(_int1,_int2: longint);
  119. function equals(p: PSearchLinkedListItem): boolean; virtual;
  120. private
  121. int1, int2: longint;
  122. end;
  123. PSearchLinkedList = ^TSearchLinkedList;
  124. TSearchLinkedList = object(TLinkedList)
  125. function searchByValue(p: PSearchLinkedListItem): boolean;
  126. procedure removeByValue(p: PSearchLinkedListItem);
  127. end;
  128. {$endif tempOpts}
  129. {information record with the contents of every register. Every Pai object
  130. gets one of these assigned: a pointer to it is stored in the OptInfo field}
  131. TPaiProp = Record
  132. Regs: TRegContent;
  133. { FPURegs: TRegFPUContent;} {currently not yet used}
  134. { allocated Registers }
  135. UsedRegs: TRegSet;
  136. { status of the direction flag }
  137. DirFlag: TFlagContents;
  138. {$ifdef tempOpts}
  139. { currently used temps }
  140. tempAllocs: PSearchLinkedList;
  141. {$endif tempOpts}
  142. { can this instruction be removed? }
  143. CanBeRemoved: Boolean;
  144. End;
  145. PPaiProp = ^TPaiProp;
  146. {$IfNDef TP}
  147. TPaiPropBlock = Array[1..250000] Of TPaiProp;
  148. PPaiPropBlock = ^TPaiPropBlock;
  149. {$EndIf TP}
  150. TInstrSinceLastMod = Array[R_EAX..R_EDI] Of Byte;
  151. TLabelTableItem = Record
  152. PaiObj: Pai;
  153. {$IfDef JumpAnal}
  154. InstrNr: Longint;
  155. RefsFound: Word;
  156. JmpsProcessed: Word
  157. {$EndIf JumpAnal}
  158. End;
  159. {$IfDef tp}
  160. TLabelTable = Array[0..10000] Of TLabelTableItem;
  161. {$Else tp}
  162. TLabelTable = Array[0..2500000] Of TLabelTableItem;
  163. {$Endif tp}
  164. PLabelTable = ^TLabelTable;
  165. {******************************* Variables *******************************}
  166. Var
  167. {the amount of PaiObjects in the current assembler list}
  168. NrOfPaiObjs: Longint;
  169. {$IfNDef TP}
  170. {Array which holds all TPaiProps}
  171. PaiPropBlock: PPaiPropBlock;
  172. {$EndIf TP}
  173. LoLab, HiLab, LabDif: Longint;
  174. LTable: PLabelTable;
  175. {*********************** End of Interface section ************************}
  176. Implementation
  177. Uses
  178. globals, systems, strings, verbose, hcodegen, symconst, tgeni386;
  179. Type
  180. TRefCompare = function(const r1, r2: TReference): Boolean;
  181. Var
  182. {How many instructions are between the current instruction and the last one
  183. that modified the register}
  184. NrOfInstrSinceLastMod: TInstrSinceLastMod;
  185. {$ifdef tempOpts}
  186. constructor TSearchLinkedListItem.init;
  187. begin
  188. end;
  189. function TSearchLinkedListItem.equals(p: PSearchLinkedListItem): boolean;
  190. begin
  191. equals := false;
  192. end;
  193. constructor TSearchDoubleIntItem.init(_int1,_int2: longint);
  194. begin
  195. int1 := _int1;
  196. int2 := _int2;
  197. end;
  198. function TSearchDoubleIntItem.equals(p: PSearchLinkedListItem): boolean;
  199. begin
  200. equals := (TSearchDoubleIntItem(p).int1 = int1) and
  201. (TSearchDoubleIntItem(p).int2 = int2);
  202. end;
  203. function TSearchLinkedList.searchByValue(p: PSearchLinkedListItem): boolean;
  204. var temp: PSearchLinkedListItem;
  205. begin
  206. temp := first;
  207. while (temp <> last^.next) and
  208. not(temp^.equals(p)) do
  209. temp := temp^.next;
  210. searchByValue := temp <> last^.next;
  211. end;
  212. procedure TSearchLinkedList.removeByValue(p: PSearchLinkedListItem);
  213. begin
  214. temp := first;
  215. while (temp <> last^.next) and
  216. not(temp^.equals(p)) do
  217. temp := temp^.next;
  218. if temp <> last^.next then
  219. begin
  220. remove(temp);
  221. dispose(temp,done);
  222. end;
  223. end;
  224. Procedure updateTempAllocs(Var UsedRegs: TRegSet; p: Pai);
  225. {updates UsedRegs with the RegAlloc Information coming after P}
  226. Begin
  227. Repeat
  228. While Assigned(p) And
  229. ((p^.typ in (SkipInstr - [ait_RegAlloc])) or
  230. ((p^.typ = ait_label) And
  231. labelCanBeSkipped(pai_label(current)))) Do
  232. p := Pai(p^.next);
  233. While Assigned(p) And
  234. (p^.typ=ait_RegAlloc) Do
  235. Begin
  236. if pairegalloc(p)^.allocation then
  237. UsedRegs := UsedRegs + [PaiRegAlloc(p)^.Reg]
  238. else
  239. UsedRegs := UsedRegs - [PaiRegAlloc(p)^.Reg];
  240. p := pai(p^.next);
  241. End;
  242. Until Not(Assigned(p)) Or
  243. (Not(p^.typ in SkipInstr) And
  244. Not((p^.typ = ait_label) And
  245. labelCanBeSkipped(pai_label(current))));
  246. End;
  247. {$endif tempOpts}
  248. {************************ Create the Label table ************************}
  249. Function FindLoHiLabels(Var LowLabel, HighLabel, LabelDif: Longint; BlockStart: Pai): Pai;
  250. {Walks through the paasmlist to find the lowest and highest label number}
  251. Var LabelFound: Boolean;
  252. P, lastP: Pai;
  253. Begin
  254. LabelFound := False;
  255. LowLabel := MaxLongint;
  256. HighLabel := 0;
  257. P := BlockStart;
  258. lastP := p;
  259. While Assigned(P) Do
  260. Begin
  261. If (Pai(p)^.typ = ait_label) Then
  262. If not labelCanBeSkipped(pai_label(p))
  263. Then
  264. Begin
  265. LabelFound := True;
  266. If (Pai_Label(p)^.l^.labelnr < LowLabel) Then
  267. LowLabel := Pai_Label(p)^.l^.labelnr;
  268. If (Pai_Label(p)^.l^.labelnr > HighLabel) Then
  269. HighLabel := Pai_Label(p)^.l^.labelnr;
  270. End;
  271. lastP := p;
  272. GetNextInstruction(p, p);
  273. End;
  274. if (lastP^.typ = ait_marker) and
  275. (pai_marker(lastP)^.kind = asmBlockStart) then
  276. FindLoHiLabels := lastP
  277. else FindLoHiLabels := nil;
  278. If LabelFound
  279. Then LabelDif := HighLabel+1-LowLabel
  280. Else LabelDif := 0;
  281. End;
  282. Function FindRegAlloc(Reg: TRegister; StartPai: Pai; alloc: boolean): Boolean;
  283. { Returns true if a ait_alloc object for Reg is found in the block of Pai's }
  284. { starting with StartPai and ending with the next "real" instruction }
  285. Begin
  286. FindRegAlloc := false;
  287. Repeat
  288. While Assigned(StartPai) And
  289. ((StartPai^.typ in (SkipInstr - [ait_regAlloc])) Or
  290. ((StartPai^.typ = ait_label) and
  291. labelCanBeSkipped(pai_label(startPai)))) Do
  292. StartPai := Pai(StartPai^.Next);
  293. If Assigned(StartPai) and
  294. (StartPai^.typ = ait_regAlloc) then
  295. begin
  296. if (PairegAlloc(StartPai)^.allocation = alloc) and
  297. (PairegAlloc(StartPai)^.Reg = Reg) then
  298. begin
  299. FindRegAlloc:=true;
  300. break;
  301. end;
  302. StartPai := Pai(StartPai^.Next);
  303. end
  304. else
  305. break;
  306. Until false;
  307. End;
  308. Procedure RemoveLastDeallocForFuncRes(asmL: PAasmOutput; p: pai);
  309. Procedure DoRemoveLastDeallocForFuncRes(asmL: PAasmOutput; reg: TRegister);
  310. var
  311. hp2: pai;
  312. begin
  313. hp2 := p;
  314. repeat
  315. hp2 := pai(hp2^.previous);
  316. if assigned(hp2) and
  317. (hp2^.typ = ait_regalloc) and
  318. not(pairegalloc(hp2)^.allocation) and
  319. (pairegalloc(hp2)^.reg = reg) then
  320. begin
  321. asml^.remove(hp2);
  322. dispose(hp2,done);
  323. break;
  324. end;
  325. until not(assigned(hp2)) or
  326. regInInstruction(reg,hp2);
  327. end;
  328. begin
  329. if assigned(procinfo^.returntype.def) then
  330. case procinfo^.returntype.def^.deftype of
  331. arraydef,recorddef,pointerdef,
  332. stringdef,enumdef,procdef,objectdef,errordef,
  333. filedef,setdef,procvardef,
  334. classrefdef,forwarddef:
  335. DoRemoveLastDeallocForFuncRes(asmL,R_EAX);
  336. orddef:
  337. if procinfo^.returntype.def^.size <> 0 then
  338. begin
  339. DoRemoveLastDeallocForFuncRes(asmL,R_EAX);
  340. { for int64/qword }
  341. if procinfo^.returntype.def^.size = 8 then
  342. DoRemoveLastDeallocForFuncRes(asmL,R_EDX);
  343. end;
  344. end;
  345. end;
  346. procedure getNoDeallocRegs(var regs: TRegSet);
  347. var regCounter: TRegister;
  348. begin
  349. regs := [];
  350. if assigned(procinfo^.returntype.def) then
  351. case procinfo^.returntype.def^.deftype of
  352. arraydef,recorddef,pointerdef,
  353. stringdef,enumdef,procdef,objectdef,errordef,
  354. filedef,setdef,procvardef,
  355. classrefdef,forwarddef:
  356. regs := [R_EAX];
  357. orddef:
  358. if procinfo^.returntype.def^.size <> 0 then
  359. begin
  360. regs := [R_EAX];
  361. { for int64/qword }
  362. if procinfo^.returntype.def^.size = 8 then
  363. regs := regs + [R_EDX];
  364. end;
  365. end;
  366. for regCounter := R_EAX to R_EBX do
  367. if not(regCounter in usableregs) then
  368. regs := regs + [regCounter];
  369. end;
  370. Procedure AddRegDeallocFor(asmL: paasmOutput; reg: TRegister; p: pai);
  371. var hp1: pai;
  372. funcResRegs: TRegset;
  373. funcResReg: boolean;
  374. begin
  375. if not(reg in usableregs) then
  376. exit;
  377. getNoDeallocRegs(funcResRegs);
  378. funcResRegs := funcResRegs - usableregs;
  379. funcResReg := reg in funcResRegs;
  380. hp1 := p;
  381. while not(funcResReg and
  382. (p^.typ = ait_instruction) and
  383. (paicpu(p)^.opcode = A_JMP) and
  384. (pasmlabel(paicpu(p)^.oper[0].sym) = aktexit2label)) and
  385. getLastInstruction(p, p) And
  386. not(regInInstruction(reg, p)) Do
  387. hp1 := p;
  388. { don't insert a dealloc for registers which contain the function result }
  389. { if they are followed by a jump to the exit label (for exit(...)) }
  390. if not(funcResReg) or
  391. not((hp1^.typ = ait_instruction) and
  392. (paicpu(hp1)^.opcode = A_JMP) and
  393. (pasmlabel(paicpu(hp1)^.oper[0].sym) = aktexit2label)) then
  394. begin
  395. p := new(paiRegAlloc, deAlloc(reg));
  396. insertLLItem(AsmL, hp1^.previous, hp1, p);
  397. end;
  398. end;
  399. Procedure BuildLabelTableAndFixRegAlloc(asmL: PAasmOutput; Var LabelTable: PLabelTable; LowLabel: Longint;
  400. Var LabelDif: Longint; BlockStart, BlockEnd: Pai);
  401. {Builds a table with the locations of the labels in the paasmoutput.
  402. Also fixes some RegDeallocs like "# %eax released; push (%eax)"}
  403. Var p, hp1, hp2, lastP: Pai;
  404. regCounter: TRegister;
  405. UsedRegs, noDeallocRegs: TRegSet;
  406. Begin
  407. UsedRegs := [];
  408. If (LabelDif <> 0) Then
  409. Begin
  410. {$IfDef TP}
  411. If (MaxAvail >= LabelDif*SizeOf(Pai))
  412. Then
  413. Begin
  414. {$EndIf TP}
  415. GetMem(LabelTable, LabelDif*SizeOf(TLabelTableItem));
  416. FillChar(LabelTable^, LabelDif*SizeOf(TLabelTableItem), 0);
  417. {$IfDef TP}
  418. End
  419. Else LabelDif := 0;
  420. {$EndIf TP}
  421. End;
  422. p := BlockStart;
  423. lastP := p;
  424. While (P <> BlockEnd) Do
  425. Begin
  426. Case p^.typ Of
  427. ait_Label:
  428. If not labelCanBeSkipped(pai_label(p)) Then
  429. LabelTable^[Pai_Label(p)^.l^.labelnr-LowLabel].PaiObj := p;
  430. ait_regAlloc:
  431. { ESI and EDI are (de)allocated manually, don't mess with them }
  432. if not(paiRegAlloc(p)^.Reg in [R_EDI,R_ESI]) then
  433. begin
  434. if PairegAlloc(p)^.Allocation then
  435. Begin
  436. If Not(paiRegAlloc(p)^.Reg in UsedRegs) Then
  437. UsedRegs := UsedRegs + [paiRegAlloc(p)^.Reg]
  438. Else
  439. addRegDeallocFor(asmL, paiRegAlloc(p)^.reg, p);
  440. End
  441. else
  442. begin
  443. UsedRegs := UsedRegs - [paiRegAlloc(p)^.Reg];
  444. hp1 := p;
  445. hp2 := nil;
  446. While Not(FindRegAlloc(paiRegAlloc(p)^.Reg, Pai(hp1^.Next),true)) And
  447. GetNextInstruction(hp1, hp1) And
  448. RegInInstruction(paiRegAlloc(p)^.Reg, hp1) Do
  449. hp2 := hp1;
  450. If hp2 <> nil Then
  451. Begin
  452. hp1 := Pai(p^.previous);
  453. AsmL^.Remove(p);
  454. InsertLLItem(AsmL, hp2, Pai(hp2^.Next), p);
  455. p := hp1;
  456. end;
  457. end;
  458. end;
  459. end;
  460. repeat
  461. lastP := p;
  462. P := Pai(P^.Next);
  463. until not(Assigned(p)) or
  464. not(p^.typ in (SkipInstr - [ait_regalloc]));
  465. End;
  466. { don't add deallocation for function result variable or for regvars}
  467. getNoDeallocRegs(noDeallocRegs);
  468. usedRegs := usedRegs - noDeallocRegs;
  469. for regCounter := R_EAX to R_EDI do
  470. if regCounter in usedRegs then
  471. addRegDeallocFor(asmL,regCounter,lastP);
  472. End;
  473. {************************ Search the Label table ************************}
  474. Function FindLabel(L: PasmLabel; Var hp: Pai): Boolean;
  475. {searches for the specified label starting from hp as long as the
  476. encountered instructions are labels, to be able to optimize constructs like
  477. jne l2 jmp l2
  478. jmp l3 and l1:
  479. l1: l2:
  480. l2:}
  481. Var TempP: Pai;
  482. Begin
  483. TempP := hp;
  484. While Assigned(TempP) and
  485. (TempP^.typ In SkipInstr + [ait_label,ait_align]) Do
  486. If (TempP^.typ <> ait_Label) Or
  487. (pai_label(TempP)^.l <> L)
  488. Then GetNextInstruction(TempP, TempP)
  489. Else
  490. Begin
  491. hp := TempP;
  492. FindLabel := True;
  493. exit
  494. End;
  495. FindLabel := False;
  496. End;
  497. {************************ Some general functions ************************}
  498. Function TCh2Reg(Ch: TInsChange): TRegister;
  499. {converts a TChange variable to a TRegister}
  500. Begin
  501. If (Ch <= Ch_REDI) Then
  502. TCh2Reg := TRegister(Byte(Ch))
  503. Else
  504. If (Ch <= Ch_WEDI) Then
  505. TCh2Reg := TRegister(Byte(Ch) - Byte(Ch_REDI))
  506. Else
  507. If (Ch <= Ch_RWEDI) Then
  508. TCh2Reg := TRegister(Byte(Ch) - Byte(Ch_WEDI))
  509. Else
  510. If (Ch <= Ch_MEDI) Then
  511. TCh2Reg := TRegister(Byte(Ch) - Byte(Ch_RWEDI))
  512. Else InternalError($db)
  513. End;
  514. Function Reg32(Reg: TRegister): TRegister;
  515. {Returns the 32 bit component of Reg if it exists, otherwise Reg is returned}
  516. Begin
  517. Reg32 := Reg;
  518. If (Reg >= R_AX)
  519. Then
  520. If (Reg <= R_DI)
  521. Then Reg32 := Reg16ToReg32(Reg)
  522. Else
  523. If (Reg <= R_BL)
  524. Then Reg32 := Reg8toReg32(Reg);
  525. End;
  526. { inserts new_one between prev and foll }
  527. Procedure InsertLLItem(AsmL: PAasmOutput; prev, foll, new_one: PLinkedList_Item);
  528. Begin
  529. If Assigned(prev) Then
  530. If Assigned(foll) Then
  531. Begin
  532. If Assigned(new_one) Then
  533. Begin
  534. new_one^.previous := prev;
  535. new_one^.next := foll;
  536. prev^.next := new_one;
  537. foll^.previous := new_one;
  538. Pai(new_one)^.fileinfo := Pai(foll)^.fileinfo;
  539. End;
  540. End
  541. Else AsmL^.Concat(new_one)
  542. Else If Assigned(Foll) Then AsmL^.Insert(new_one)
  543. End;
  544. {********************* Compare parts of Pai objects *********************}
  545. Function RegsSameSize(Reg1, Reg2: TRegister): Boolean;
  546. {returns true if Reg1 and Reg2 are of the same size (so if they're both
  547. 8bit, 16bit or 32bit)}
  548. Begin
  549. If (Reg1 <= R_EDI)
  550. Then RegsSameSize := (Reg2 <= R_EDI)
  551. Else
  552. If (Reg1 <= R_DI)
  553. Then RegsSameSize := (Reg2 in [R_AX..R_DI])
  554. Else
  555. If (Reg1 <= R_BL)
  556. Then RegsSameSize := (Reg2 in [R_AL..R_BL])
  557. Else RegsSameSize := False
  558. End;
  559. Procedure AddReg2RegInfo(OldReg, NewReg: TRegister; Var RegInfo: TRegInfo);
  560. {updates the ???RegsEncountered and ???2???Reg fields of RegInfo. Assumes that
  561. OldReg and NewReg have the same size (has to be chcked in advance with
  562. RegsSameSize) and that neither equals R_NO}
  563. Begin
  564. With RegInfo Do
  565. Begin
  566. NewRegsEncountered := NewRegsEncountered + [NewReg];
  567. OldRegsEncountered := OldRegsEncountered + [OldReg];
  568. New2OldReg[NewReg] := OldReg;
  569. Case OldReg Of
  570. R_EAX..R_EDI:
  571. Begin
  572. NewRegsEncountered := NewRegsEncountered + [Reg32toReg16(NewReg)];
  573. OldRegsEncountered := OldRegsEncountered + [Reg32toReg16(OldReg)];
  574. New2OldReg[Reg32toReg16(NewReg)] := Reg32toReg16(OldReg);
  575. If (NewReg in [R_EAX..R_EBX]) And
  576. (OldReg in [R_EAX..R_EBX]) Then
  577. Begin
  578. NewRegsEncountered := NewRegsEncountered + [Reg32toReg8(NewReg)];
  579. OldRegsEncountered := OldRegsEncountered + [Reg32toReg8(OldReg)];
  580. New2OldReg[Reg32toReg8(NewReg)] := Reg32toReg8(OldReg);
  581. End;
  582. End;
  583. R_AX..R_DI:
  584. Begin
  585. NewRegsEncountered := NewRegsEncountered + [Reg16toReg32(NewReg)];
  586. OldRegsEncountered := OldRegsEncountered + [Reg16toReg32(OldReg)];
  587. New2OldReg[Reg16toReg32(NewReg)] := Reg16toReg32(OldReg);
  588. If (NewReg in [R_AX..R_BX]) And
  589. (OldReg in [R_AX..R_BX]) Then
  590. Begin
  591. NewRegsEncountered := NewRegsEncountered + [Reg16toReg8(NewReg)];
  592. OldRegsEncountered := OldRegsEncountered + [Reg16toReg8(OldReg)];
  593. New2OldReg[Reg16toReg8(NewReg)] := Reg16toReg8(OldReg);
  594. End;
  595. End;
  596. R_AL..R_BL:
  597. Begin
  598. NewRegsEncountered := NewRegsEncountered + [Reg8toReg32(NewReg)]
  599. + [Reg8toReg16(NewReg)];
  600. OldRegsEncountered := OldRegsEncountered + [Reg8toReg32(OldReg)]
  601. + [Reg8toReg16(OldReg)];
  602. New2OldReg[Reg8toReg32(NewReg)] := Reg8toReg32(OldReg);
  603. End;
  604. End;
  605. End;
  606. End;
  607. Procedure AddOp2RegInfo(const o:Toper; Var RegInfo: TRegInfo);
  608. Begin
  609. Case o.typ Of
  610. Top_Reg:
  611. If (o.reg <> R_NO) Then
  612. AddReg2RegInfo(o.reg, o.reg, RegInfo);
  613. Top_Ref:
  614. Begin
  615. If o.ref^.base <> R_NO Then
  616. AddReg2RegInfo(o.ref^.base, o.ref^.base, RegInfo);
  617. If o.ref^.index <> R_NO Then
  618. AddReg2RegInfo(o.ref^.index, o.ref^.index, RegInfo);
  619. End;
  620. End;
  621. End;
  622. Function RegsEquivalent(OldReg, NewReg: TRegister; Var RegInfo: TRegInfo; OPAct: TOpAction): Boolean;
  623. Begin
  624. If Not((OldReg = R_NO) Or (NewReg = R_NO)) Then
  625. If RegsSameSize(OldReg, NewReg) Then
  626. With RegInfo Do
  627. {here we always check for the 32 bit component, because it is possible that
  628. the 8 bit component has not been set, event though NewReg already has been
  629. processed. This happens if it has been compared with a register that doesn't
  630. have an 8 bit component (such as EDI). In that case the 8 bit component is
  631. still set to R_NO and the comparison in the Else-part will fail}
  632. If (Reg32(OldReg) in OldRegsEncountered) Then
  633. If (Reg32(NewReg) in NewRegsEncountered) Then
  634. RegsEquivalent := (OldReg = New2OldReg[NewReg])
  635. { If we haven't encountered the new register yet, but we have encountered the
  636. old one already, the new one can only be correct if it's being written to
  637. (and consequently the old one is also being written to), otherwise
  638. movl -8(%ebp), %eax and movl -8(%ebp), %eax
  639. movl (%eax), %eax movl (%edx), %edx
  640. are considered equivalent}
  641. Else
  642. If (OpAct = OpAct_Write) Then
  643. Begin
  644. AddReg2RegInfo(OldReg, NewReg, RegInfo);
  645. RegsEquivalent := True
  646. End
  647. Else Regsequivalent := False
  648. Else
  649. If Not(Reg32(NewReg) in NewRegsEncountered) and
  650. ((OpAct = OpAct_Write) or
  651. ((newReg = oldReg) and
  652. not(newReg in usableregs + [R_EDI]))) Then
  653. Begin
  654. AddReg2RegInfo(OldReg, NewReg, RegInfo);
  655. RegsEquivalent := True
  656. End
  657. Else RegsEquivalent := False
  658. Else RegsEquivalent := False
  659. Else RegsEquivalent := OldReg = NewReg
  660. End;
  661. Function RefsEquivalent(Const R1, R2: TReference; var RegInfo: TRegInfo; OpAct: TOpAction): Boolean;
  662. Begin
  663. If R1.is_immediate Then
  664. RefsEquivalent := R2.is_immediate and (R1.Offset = R2.Offset)
  665. Else
  666. RefsEquivalent := (R1.Offset+R1.OffsetFixup = R2.Offset+R2.OffsetFixup) And
  667. RegsEquivalent(R1.Base, R2.Base, RegInfo, OpAct) And
  668. RegsEquivalent(R1.Index, R2.Index, RegInfo, OpAct) And
  669. (R1.Segment = R2.Segment) And (R1.ScaleFactor = R2.ScaleFactor) And
  670. (R1.Symbol = R2.Symbol);
  671. End;
  672. Function RefsEqual(Const R1, R2: TReference): Boolean;
  673. Begin
  674. If R1.is_immediate Then
  675. RefsEqual := R2.is_immediate and (R1.Offset = R2.Offset)
  676. Else
  677. RefsEqual := (R1.Offset+R1.OffsetFixup = R2.Offset+R2.OffsetFixup) And
  678. (R1.Segment = R2.Segment) And (R1.Base = R2.Base) And
  679. (R1.Index = R2.Index) And (R1.ScaleFactor = R2.ScaleFactor) And
  680. (R1.Symbol=R2.Symbol);
  681. End;
  682. Function IsGP32Reg(Reg: TRegister): Boolean;
  683. {Checks if the register is a 32 bit general purpose register}
  684. Begin
  685. If (Reg >= R_EAX) and (Reg <= R_EBX)
  686. Then IsGP32Reg := True
  687. Else IsGP32reg := False
  688. End;
  689. Function RegInRef(Reg: TRegister; Const Ref: TReference): Boolean;
  690. Begin {checks whether Ref contains a reference to Reg}
  691. Reg := Reg32(Reg);
  692. RegInRef := (Ref.Base = Reg) Or (Ref.Index = Reg)
  693. End;
  694. function RegReadByInstruction(reg: TRegister; hp: pai): boolean;
  695. var p: paicpu;
  696. opCount: byte;
  697. begin
  698. RegReadByInstruction := false;
  699. reg := reg32(reg);
  700. p := paicpu(hp);
  701. if hp^.typ <> ait_instruction then
  702. exit;
  703. case p^.opcode of
  704. A_IMUL:
  705. case p^.ops of
  706. 1: regReadByInstruction := (reg = R_EAX) or reginOp(reg,p^.oper[0]);
  707. 2,3:
  708. regReadByInstruction := regInOp(reg,p^.oper[0]) or
  709. regInOp(reg,p^.oper[1]);
  710. end;
  711. A_IDIV,A_DIV,A_MUL:
  712. begin
  713. regReadByInstruction :=
  714. regInOp(reg,p^.oper[0]) or (reg = R_EAX);
  715. end;
  716. else
  717. begin
  718. for opCount := 0 to 2 do
  719. if (p^.oper[opCount].typ = top_ref) and
  720. RegInRef(reg,p^.oper[opCount].ref^) then
  721. begin
  722. RegReadByInstruction := true;
  723. exit
  724. end;
  725. for opCount := 1 to MaxCh do
  726. case InsProp[p^.opcode].Ch[opCount] of
  727. Ch_REAX..CH_REDI,CH_RWEAX..Ch_MEDI:
  728. if reg = TCh2Reg(InsProp[p^.opcode].Ch[opCount]) then
  729. begin
  730. RegReadByInstruction := true;
  731. exit
  732. end;
  733. Ch_RWOp1,Ch_ROp1,Ch_MOp1:
  734. if (p^.oper[0].typ = top_reg) and
  735. (reg32(p^.oper[0].reg) = reg) then
  736. begin
  737. RegReadByInstruction := true;
  738. exit
  739. end;
  740. Ch_RWOp2,Ch_ROp2,Ch_MOp2:
  741. if (p^.oper[1].typ = top_reg) and
  742. (reg32(p^.oper[1].reg) = reg) then
  743. begin
  744. RegReadByInstruction := true;
  745. exit
  746. end;
  747. Ch_RWOp3,Ch_ROp3,Ch_MOp3:
  748. if (p^.oper[2].typ = top_reg) and
  749. (reg32(p^.oper[2].reg) = reg) then
  750. begin
  751. RegReadByInstruction := true;
  752. exit
  753. end;
  754. end;
  755. end;
  756. end;
  757. end;
  758. function regInInstruction(Reg: TRegister; p1: Pai): Boolean;
  759. { Checks if Reg is used by the instruction p1 }
  760. { Difference with "regReadBysinstruction() or regModifiedByInstruction()": }
  761. { this one ignores CH_ALL opcodes, while regModifiedByInstruction doesn't }
  762. var p: paicpu;
  763. opCount: byte;
  764. begin
  765. reg := reg32(reg);
  766. regInInstruction := false;
  767. p := paicpu(p1);
  768. if p1^.typ <> ait_instruction then
  769. exit;
  770. case p^.opcode of
  771. A_IMUL:
  772. case p^.ops of
  773. 1: regInInstruction := (reg = R_EAX) or reginOp(reg,p^.oper[0]);
  774. 2,3:
  775. regInInstruction := regInOp(reg,p^.oper[0]) or
  776. regInOp(reg,p^.oper[1]) or regInOp(reg,p^.oper[2]);
  777. end;
  778. A_IDIV,A_DIV,A_MUL:
  779. regInInstruction :=
  780. regInOp(reg,p^.oper[0]) or
  781. (reg = R_EAX) or (reg = R_EDX)
  782. else
  783. begin
  784. for opCount := 1 to MaxCh do
  785. case InsProp[p^.opcode].Ch[opCount] of
  786. CH_REAX..CH_MEDI:
  787. if tch2reg(InsProp[p^.opcode].Ch[opCount]) = reg then
  788. begin
  789. regInInstruction := true;
  790. exit;
  791. end;
  792. Ch_ROp1..Ch_MOp1:
  793. if regInOp(reg,p^.oper[0]) then
  794. begin
  795. regInInstruction := true;
  796. exit
  797. end;
  798. Ch_ROp2..Ch_MOp2:
  799. if regInOp(reg,p^.oper[1]) then
  800. begin
  801. regInInstruction := true;
  802. exit
  803. end;
  804. Ch_ROp3..Ch_MOp3:
  805. if regInOp(reg,p^.oper[2]) then
  806. begin
  807. regInInstruction := true;
  808. exit
  809. end;
  810. end;
  811. end;
  812. end;
  813. end;
  814. Function RegInOp(Reg: TRegister; const o:toper): Boolean;
  815. Begin
  816. RegInOp := False;
  817. reg := reg32(reg);
  818. Case o.typ Of
  819. top_reg: RegInOp := Reg = reg32(o.reg);
  820. top_ref: RegInOp := (Reg = o.ref^.Base) Or
  821. (Reg = o.ref^.Index);
  822. End;
  823. End;
  824. Function RegModifiedByInstruction(Reg: TRegister; p1: Pai): Boolean;
  825. Var InstrProp: TInsProp;
  826. TmpResult: Boolean;
  827. Cnt: Byte;
  828. Begin
  829. TmpResult := False;
  830. Reg := Reg32(Reg);
  831. If (p1^.typ = ait_instruction) Then
  832. Case paicpu(p1)^.opcode of
  833. A_IMUL:
  834. With paicpu(p1)^ Do
  835. TmpResult :=
  836. ((ops = 1) and (reg in [R_EAX,R_EDX])) or
  837. ((ops = 2) and (Reg32(oper[1].reg) = reg)) or
  838. ((ops = 3) and (Reg32(oper[2].reg) = reg));
  839. A_DIV, A_IDIV, A_MUL:
  840. With paicpu(p1)^ Do
  841. TmpResult :=
  842. (Reg = R_EAX) or
  843. (Reg = R_EDX);
  844. Else
  845. Begin
  846. Cnt := 1;
  847. InstrProp := InsProp[paicpu(p1)^.OpCode];
  848. While (Cnt <= MaxCh) And
  849. (InstrProp.Ch[Cnt] <> Ch_None) And
  850. Not(TmpResult) Do
  851. Begin
  852. Case InstrProp.Ch[Cnt] Of
  853. Ch_WEAX..Ch_MEDI:
  854. TmpResult := Reg = TCh2Reg(InstrProp.Ch[Cnt]);
  855. Ch_RWOp1,Ch_WOp1,Ch_Mop1:
  856. TmpResult := (paicpu(p1)^.oper[0].typ = top_reg) and
  857. (Reg32(paicpu(p1)^.oper[0].reg) = reg);
  858. Ch_RWOp2,Ch_WOp2,Ch_Mop2:
  859. TmpResult := (paicpu(p1)^.oper[1].typ = top_reg) and
  860. (Reg32(paicpu(p1)^.oper[1].reg) = reg);
  861. Ch_RWOp3,Ch_WOp3,Ch_Mop3:
  862. TmpResult := (paicpu(p1)^.oper[2].typ = top_reg) and
  863. (Reg32(paicpu(p1)^.oper[2].reg) = reg);
  864. Ch_FPU: TmpResult := Reg in [R_ST..R_ST7,R_MM0..R_MM7];
  865. Ch_ALL: TmpResult := true;
  866. End;
  867. Inc(Cnt)
  868. End
  869. End
  870. End;
  871. RegModifiedByInstruction := TmpResult
  872. End;
  873. {********************* GetNext and GetLastInstruction *********************}
  874. Function GetNextInstruction(Current: Pai; Var Next: Pai): Boolean;
  875. { skips ait_regalloc, ait_regdealloc and ait_stab* objects and puts the }
  876. { next pai object in Next. Returns false if there isn't any }
  877. Begin
  878. Repeat
  879. If (Current^.typ = ait_marker) And
  880. (Pai_Marker(Current)^.Kind = AsmBlockStart) Then
  881. Begin
  882. GetNextInstruction := False;
  883. Next := Nil;
  884. Exit
  885. End;
  886. Current := Pai(Current^.Next);
  887. While Assigned(Current) And
  888. ((current^.typ In skipInstr) or
  889. ((current^.typ = ait_label) and
  890. labelCanBeSkipped(pai_label(current)))) do
  891. Current := Pai(Current^.Next);
  892. If Assigned(Current) And
  893. (Current^.typ = ait_Marker) And
  894. (Pai_Marker(Current)^.Kind = NoPropInfoStart) Then
  895. Begin
  896. While Assigned(Current) And
  897. ((Current^.typ <> ait_Marker) Or
  898. (Pai_Marker(Current)^.Kind <> NoPropInfoEnd)) Do
  899. Current := Pai(Current^.Next);
  900. End;
  901. Until Not(Assigned(Current)) Or
  902. (Current^.typ <> ait_Marker) Or
  903. (Pai_Marker(Current)^.Kind <> NoPropInfoEnd);
  904. Next := Current;
  905. If Assigned(Current) And
  906. Not((Current^.typ In SkipInstr) or
  907. ((Current^.typ = ait_label) And
  908. labelCanBeSkipped(pai_label(current))))
  909. Then
  910. GetNextInstruction :=
  911. not((current^.typ = ait_marker) and
  912. (pai_marker(current)^.kind = asmBlockStart))
  913. Else
  914. Begin
  915. GetNextInstruction := False;
  916. Next := nil;
  917. End;
  918. End;
  919. Function GetLastInstruction(Current: Pai; Var Last: Pai): Boolean;
  920. {skips the ait-types in SkipInstr puts the previous pai object in
  921. Last. Returns false if there isn't any}
  922. Begin
  923. Repeat
  924. Current := Pai(Current^.previous);
  925. While Assigned(Current) And
  926. (((Current^.typ = ait_Marker) And
  927. Not(Pai_Marker(Current)^.Kind in [AsmBlockEnd,NoPropInfoEnd])) or
  928. (Current^.typ In SkipInstr) or
  929. ((Current^.typ = ait_label) And
  930. labelCanBeSkipped(pai_label(current)))) Do
  931. Current := Pai(Current^.previous);
  932. If Assigned(Current) And
  933. (Current^.typ = ait_Marker) And
  934. (Pai_Marker(Current)^.Kind = NoPropInfoEnd) Then
  935. Begin
  936. While Assigned(Current) And
  937. ((Current^.typ <> ait_Marker) Or
  938. (Pai_Marker(Current)^.Kind <> NoPropInfoStart)) Do
  939. Current := Pai(Current^.previous);
  940. End;
  941. Until Not(Assigned(Current)) Or
  942. (Current^.typ <> ait_Marker) Or
  943. (Pai_Marker(Current)^.Kind <> NoPropInfoStart);
  944. If Not(Assigned(Current)) or
  945. (Current^.typ In SkipInstr) or
  946. ((Current^.typ = ait_label) And
  947. labelCanBeSkipped(pai_label(current))) or
  948. ((Current^.typ = ait_Marker) And
  949. (Pai_Marker(Current)^.Kind = AsmBlockEnd))
  950. Then
  951. Begin
  952. Last := nil;
  953. GetLastInstruction := False
  954. End
  955. Else
  956. Begin
  957. Last := Current;
  958. GetLastInstruction := True;
  959. End;
  960. End;
  961. Procedure SkipHead(var P: Pai);
  962. Var OldP: Pai;
  963. Begin
  964. Repeat
  965. OldP := P;
  966. If (P^.typ in SkipInstr) Or
  967. ((P^.typ = ait_marker) And
  968. (Pai_Marker(P)^.Kind = AsmBlockEnd)) Then
  969. GetNextInstruction(P, P)
  970. Else If ((P^.Typ = Ait_Marker) And
  971. (Pai_Marker(P)^.Kind = NoPropInfoStart)) Then
  972. {a marker of the NoPropInfoStart can't be the first instruction of a
  973. paasmoutput list}
  974. GetNextInstruction(Pai(P^.Previous),P);
  975. Until P = OldP
  976. End;
  977. function labelCanBeSkipped(p: pai_label): boolean;
  978. begin
  979. labelCanBeSkipped := not(p^.l^.is_used) or p^.l^.is_addr;
  980. end;
  981. {******************* The Data Flow Analyzer functions ********************}
  982. function regLoadedWithNewValue(reg: tregister; canDependOnPrevValue: boolean;
  983. hp: pai): boolean;
  984. { assumes reg is a 32bit register }
  985. var p: paicpu;
  986. begin
  987. p := paicpu(hp);
  988. regLoadedWithNewValue :=
  989. assigned(hp) and
  990. (hp^.typ = ait_instruction) and
  991. (((p^.opcode = A_MOV) or
  992. (p^.opcode = A_MOVZX) or
  993. (p^.opcode = A_MOVSX) or
  994. (p^.opcode = A_LEA)) and
  995. (p^.oper[1].typ = top_reg) and
  996. (Reg32(p^.oper[1].reg) = reg) and
  997. (canDependOnPrevValue or
  998. (p^.oper[0].typ <> top_ref) or
  999. not regInRef(reg,p^.oper[0].ref^)) or
  1000. ((p^.opcode = A_POP) and
  1001. (Reg32(p^.oper[0].reg) = reg)));
  1002. end;
  1003. Procedure UpdateUsedRegs(Var UsedRegs: TRegSet; p: Pai);
  1004. {updates UsedRegs with the RegAlloc Information coming after P}
  1005. Begin
  1006. Repeat
  1007. While Assigned(p) And
  1008. ((p^.typ in (SkipInstr - [ait_RegAlloc])) or
  1009. ((p^.typ = ait_label) And
  1010. labelCanBeSkipped(pai_label(p)))) Do
  1011. p := Pai(p^.next);
  1012. While Assigned(p) And
  1013. (p^.typ=ait_RegAlloc) Do
  1014. Begin
  1015. if pairegalloc(p)^.allocation then
  1016. UsedRegs := UsedRegs + [PaiRegAlloc(p)^.Reg]
  1017. else
  1018. UsedRegs := UsedRegs - [PaiRegAlloc(p)^.Reg];
  1019. p := pai(p^.next);
  1020. End;
  1021. Until Not(Assigned(p)) Or
  1022. (Not(p^.typ in SkipInstr) And
  1023. Not((p^.typ = ait_label) And
  1024. labelCanBeSkipped(pai_label(p))));
  1025. End;
  1026. Procedure AllocRegBetween(AsmL: PAasmOutput; Reg: TRegister; p1, p2: Pai);
  1027. { allocates register Reg between (and including) instructions p1 and p2 }
  1028. { the type of p1 and p2 must not be in SkipInstr }
  1029. var
  1030. hp: pai;
  1031. lastRemovedWasDealloc: boolean;
  1032. Begin
  1033. If not(reg in usableregs+[R_EDI,R_ESI]) or
  1034. not(assigned(p1)) Then
  1035. { this happens with registers which are loaded implicitely, outside the }
  1036. { current block (e.g. esi with self) }
  1037. exit;
  1038. lastRemovedWasDealloc := false;
  1039. {$ifdef allocregdebug}
  1040. hp := new(pai_asm_comment,init(strpnew('allocating '+att_reg2str[reg]+
  1041. ' from here...')));
  1042. insertllitem(asml,p1^.previous,p1,hp);
  1043. hp := new(pai_asm_comment,init(strpnew('allocated '+att_reg2str[reg]+
  1044. ' till here...')));
  1045. insertllitem(asml,p2,p1^.next,hp);
  1046. {$endif allocregdebug}
  1047. if Assigned(p1^.optInfo) and
  1048. not (reg in PPaiProp(p1^.OptInfo)^.UsedRegs) then
  1049. begin
  1050. hp := new(paiRegalloc,alloc(reg));
  1051. insertLLItem(asmL,p1^.previous,p1,hp);
  1052. end;
  1053. Repeat
  1054. If Assigned(p1^.OptInfo) Then
  1055. Include(PPaiProp(p1^.OptInfo)^.UsedRegs,Reg);
  1056. p1 := Pai(p1^.next);
  1057. Repeat
  1058. While assigned(p1) and
  1059. (p1^.typ in (SkipInstr-[ait_regalloc])) Do
  1060. p1 := Pai(p1^.next);
  1061. { remove all allocation/deallocation info about the register in between }
  1062. If assigned(p1) and
  1063. (p1^.typ = ait_regalloc) Then
  1064. If (PaiRegAlloc(p1)^.Reg = Reg) Then
  1065. Begin
  1066. lastRemovedWasDealloc := not PaiRegAlloc(p1)^.allocation;
  1067. hp := Pai(p1^.Next);
  1068. AsmL^.Remove(p1);
  1069. Dispose(p1, Done);
  1070. p1 := hp;
  1071. End
  1072. Else p1 := Pai(p1^.next);
  1073. Until not(assigned(p1)) or
  1074. Not(p1^.typ in SkipInstr);
  1075. Until not(assigned(p1)) or
  1076. (p1 = p2);
  1077. if assigned(p1) and lastRemovedWasDealloc then
  1078. begin
  1079. hp := new(paiRegalloc,dealloc(reg));
  1080. insertLLItem(asmL,p1,p1^.next,hp);
  1081. end;
  1082. End;
  1083. Procedure IncState(Var S: Byte; amount: longint);
  1084. {Increases S by 1, wraps around at $ffff to 0 (so we won't get overflow
  1085. errors}
  1086. Begin
  1087. if (s <= $ff - amount) then
  1088. inc(s, amount)
  1089. else s := longint(s) + amount - $ff;
  1090. End;
  1091. Function sequenceDependsonReg(Const Content: TContent; seqReg, Reg: TRegister): Boolean;
  1092. { Content is the sequence of instructions that describes the contents of }
  1093. { seqReg. Reg is being overwritten by the current instruction. If the }
  1094. { content of seqReg depends on reg (ie. because of a }
  1095. { "movl (seqreg,reg), seqReg" instruction), this function returns true }
  1096. Var p: Pai;
  1097. Counter: Byte;
  1098. TmpResult: Boolean;
  1099. RegsChecked: TRegSet;
  1100. Begin
  1101. RegsChecked := [];
  1102. p := Content.StartMod;
  1103. TmpResult := False;
  1104. Counter := 1;
  1105. While Not(TmpResult) And
  1106. (Counter <= Content.NrOfMods) Do
  1107. Begin
  1108. If (p^.typ = ait_instruction) and
  1109. ((Paicpu(p)^.opcode = A_MOV) or
  1110. (Paicpu(p)^.opcode = A_MOVZX) or
  1111. (Paicpu(p)^.opcode = A_MOVSX) or
  1112. (paicpu(p)^.opcode = A_LEA)) and
  1113. (Paicpu(p)^.oper[0].typ = top_ref) Then
  1114. With Paicpu(p)^.oper[0].ref^ Do
  1115. If ((Base = procinfo^.FramePointer) or
  1116. (assigned(symbol) and (base = R_NO))) And
  1117. (Index = R_NO) Then
  1118. Begin
  1119. RegsChecked := RegsChecked + [Reg32(Paicpu(p)^.oper[1].reg)];
  1120. If Reg = Reg32(Paicpu(p)^.oper[1].reg) Then
  1121. Break;
  1122. End
  1123. Else
  1124. tmpResult :=
  1125. regReadByInstruction(reg,p) and
  1126. regModifiedByInstruction(seqReg,p)
  1127. Else
  1128. tmpResult :=
  1129. regReadByInstruction(reg,p) and
  1130. regModifiedByInstruction(seqReg,p);
  1131. Inc(Counter);
  1132. GetNextInstruction(p,p)
  1133. End;
  1134. sequenceDependsonReg := TmpResult
  1135. End;
  1136. procedure invalidateDepedingRegs(p1: ppaiProp; reg: tregister);
  1137. var
  1138. counter: tregister;
  1139. begin
  1140. for counter := R_EAX to R_EDI Do
  1141. if counter <> reg then
  1142. with p1^.regs[counter] Do
  1143. if (typ in [con_ref,con_noRemoveRef]) and
  1144. sequenceDependsOnReg(p1^.Regs[counter],counter,reg) then
  1145. if typ in [con_ref,con_invalid] then
  1146. typ := con_invalid
  1147. { con_invalid and con_noRemoveRef = con_unknown }
  1148. else typ := con_unknown;
  1149. end;
  1150. Procedure DestroyReg(p1: PPaiProp; Reg: TRegister; doIncState:Boolean);
  1151. {Destroys the contents of the register Reg in the PPaiProp p1, as well as the
  1152. contents of registers are loaded with a memory location based on Reg.
  1153. doIncState is false when this register has to be destroyed not because
  1154. it's contents are directly modified/overwritten, but because of an indirect
  1155. action (e.g. this register holds the contents of a variable and the value
  1156. of the variable in memory is changed) }
  1157. Var TmpWState, TmpRState: Byte;
  1158. Counter: TRegister;
  1159. Begin
  1160. Reg := Reg32(Reg);
  1161. { the following happens for fpu registers }
  1162. if (reg < low(NrOfInstrSinceLastMod)) or
  1163. (reg > high(NrOfInstrSinceLastMod)) then
  1164. exit;
  1165. NrOfInstrSinceLastMod[Reg] := 0;
  1166. if (reg >= R_EAX) and (reg <= R_EDI) then
  1167. begin
  1168. with p1^.regs[reg] do
  1169. begin
  1170. if doIncState then
  1171. begin
  1172. incState(wstate,1);
  1173. typ := con_unknown;
  1174. end
  1175. else
  1176. typ := con_invalid;
  1177. end;
  1178. invalidateDepedingRegs(p1,reg);
  1179. end;
  1180. End;
  1181. {Procedure AddRegsToSet(p: Pai; Var RegSet: TRegSet);
  1182. Begin
  1183. If (p^.typ = ait_instruction) Then
  1184. Begin
  1185. Case Paicpu(p)^.oper[0].typ Of
  1186. top_reg:
  1187. If Not(Paicpu(p)^.oper[0].reg in [R_NO,R_ESP,procinfo^.FramePointer]) Then
  1188. RegSet := RegSet + [Paicpu(p)^.oper[0].reg];
  1189. top_ref:
  1190. With TReference(Paicpu(p)^.oper[0]^) Do
  1191. Begin
  1192. If Not(Base in [procinfo^.FramePointer,R_NO,R_ESP])
  1193. Then RegSet := RegSet + [Base];
  1194. If Not(Index in [procinfo^.FramePointer,R_NO,R_ESP])
  1195. Then RegSet := RegSet + [Index];
  1196. End;
  1197. End;
  1198. Case Paicpu(p)^.oper[1].typ Of
  1199. top_reg:
  1200. If Not(Paicpu(p)^.oper[1].reg in [R_NO,R_ESP,procinfo^.FramePointer]) Then
  1201. If RegSet := RegSet + [TRegister(TwoWords(Paicpu(p)^.oper[1]).Word1];
  1202. top_ref:
  1203. With TReference(Paicpu(p)^.oper[1]^) Do
  1204. Begin
  1205. If Not(Base in [procinfo^.FramePointer,R_NO,R_ESP])
  1206. Then RegSet := RegSet + [Base];
  1207. If Not(Index in [procinfo^.FramePointer,R_NO,R_ESP])
  1208. Then RegSet := RegSet + [Index];
  1209. End;
  1210. End;
  1211. End;
  1212. End;}
  1213. Function OpsEquivalent(const o1, o2: toper; Var RegInfo: TRegInfo; OpAct: TopAction): Boolean;
  1214. Begin {checks whether the two ops are equivalent}
  1215. OpsEquivalent := False;
  1216. if o1.typ=o2.typ then
  1217. Case o1.typ Of
  1218. Top_Reg:
  1219. OpsEquivalent :=RegsEquivalent(o1.reg,o2.reg, RegInfo, OpAct);
  1220. Top_Ref:
  1221. OpsEquivalent := RefsEquivalent(o1.ref^, o2.ref^, RegInfo, OpAct);
  1222. Top_Const:
  1223. OpsEquivalent := o1.val = o2.val;
  1224. Top_None:
  1225. OpsEquivalent := True
  1226. End;
  1227. End;
  1228. Function OpsEqual(const o1,o2:toper): Boolean;
  1229. Begin {checks whether the two ops are equal}
  1230. OpsEqual := False;
  1231. if o1.typ=o2.typ then
  1232. Case o1.typ Of
  1233. Top_Reg :
  1234. OpsEqual:=o1.reg=o2.reg;
  1235. Top_Ref :
  1236. OpsEqual := RefsEqual(o1.ref^, o2.ref^);
  1237. Top_Const :
  1238. OpsEqual:=o1.val=o2.val;
  1239. Top_Symbol :
  1240. OpsEqual:=(o1.sym=o2.sym) and (o1.symofs=o2.symofs);
  1241. Top_None :
  1242. OpsEqual := True
  1243. End;
  1244. End;
  1245. Function InstructionsEquivalent(p1, p2: Pai; Var RegInfo: TRegInfo): Boolean;
  1246. {$ifdef csdebug}
  1247. var
  1248. hp: pai;
  1249. {$endif csdebug}
  1250. Begin {checks whether two Paicpu instructions are equal}
  1251. If Assigned(p1) And Assigned(p2) And
  1252. (Pai(p1)^.typ = ait_instruction) And
  1253. (Pai(p1)^.typ = ait_instruction) And
  1254. (Paicpu(p1)^.opcode = Paicpu(p2)^.opcode) And
  1255. (Paicpu(p1)^.oper[0].typ = Paicpu(p2)^.oper[0].typ) And
  1256. (Paicpu(p1)^.oper[1].typ = Paicpu(p2)^.oper[1].typ) And
  1257. (Paicpu(p1)^.oper[2].typ = Paicpu(p2)^.oper[2].typ)
  1258. Then
  1259. {both instructions have the same structure:
  1260. "<operator> <operand of type1>, <operand of type 2>"}
  1261. If ((Paicpu(p1)^.opcode = A_MOV) or
  1262. (Paicpu(p1)^.opcode = A_MOVZX) or
  1263. (Paicpu(p1)^.opcode = A_MOVSX)) And
  1264. (Paicpu(p1)^.oper[0].typ = top_ref) {then .oper[1]t = top_reg} Then
  1265. If Not(RegInRef(Paicpu(p1)^.oper[1].reg, Paicpu(p1)^.oper[0].ref^)) Then
  1266. {the "old" instruction is a load of a register with a new value, not with
  1267. a value based on the contents of this register (so no "mov (reg), reg")}
  1268. If Not(RegInRef(Paicpu(p2)^.oper[1].reg, Paicpu(p2)^.oper[0].ref^)) And
  1269. RefsEqual(Paicpu(p1)^.oper[0].ref^, Paicpu(p2)^.oper[0].ref^)
  1270. Then
  1271. {the "new" instruction is also a load of a register with a new value, and
  1272. this value is fetched from the same memory location}
  1273. Begin
  1274. With Paicpu(p2)^.oper[0].ref^ Do
  1275. Begin
  1276. If Not(Base in [procinfo^.FramePointer, R_NO, R_ESP]) Then
  1277. RegInfo.RegsLoadedForRef := RegInfo.RegsLoadedForRef + [Base];
  1278. If Not(Index in [procinfo^.FramePointer, R_NO, R_ESP]) Then
  1279. RegInfo.RegsLoadedForRef := RegInfo.RegsLoadedForRef + [Index];
  1280. End;
  1281. {add the registers from the reference (.oper[0]) to the RegInfo, all registers
  1282. from the reference are the same in the old and in the new instruction
  1283. sequence}
  1284. AddOp2RegInfo(Paicpu(p1)^.oper[0], RegInfo);
  1285. {the registers from .oper[1] have to be equivalent, but not necessarily equal}
  1286. InstructionsEquivalent :=
  1287. RegsEquivalent(Paicpu(p1)^.oper[1].reg, Paicpu(p2)^.oper[1].reg, RegInfo, OpAct_Write);
  1288. End
  1289. {the registers are loaded with values from different memory locations. If
  1290. this was allowed, the instructions "mov -4(esi),eax" and "mov -4(ebp),eax"
  1291. would be considered equivalent}
  1292. Else InstructionsEquivalent := False
  1293. Else
  1294. {load register with a value based on the current value of this register}
  1295. Begin
  1296. With Paicpu(p2)^.oper[0].ref^ Do
  1297. Begin
  1298. If Not(Base in [procinfo^.FramePointer,
  1299. Reg32(Paicpu(p2)^.oper[1].reg),R_NO,R_ESP]) Then
  1300. {it won't do any harm if the register is already in RegsLoadedForRef}
  1301. Begin
  1302. RegInfo.RegsLoadedForRef := RegInfo.RegsLoadedForRef + [Base];
  1303. {$ifdef csdebug}
  1304. Writeln(att_reg2str[base], ' added');
  1305. {$endif csdebug}
  1306. end;
  1307. If Not(Index in [procinfo^.FramePointer,
  1308. Reg32(Paicpu(p2)^.oper[1].reg),R_NO,R_ESP]) Then
  1309. Begin
  1310. RegInfo.RegsLoadedForRef := RegInfo.RegsLoadedForRef + [Index];
  1311. {$ifdef csdebug}
  1312. Writeln(att_reg2str[index], ' added');
  1313. {$endif csdebug}
  1314. end;
  1315. End;
  1316. If Not(Reg32(Paicpu(p2)^.oper[1].reg) In [procinfo^.FramePointer,R_NO,R_ESP])
  1317. Then
  1318. Begin
  1319. RegInfo.RegsLoadedForRef := RegInfo.RegsLoadedForRef -
  1320. [Reg32(Paicpu(p2)^.oper[1].reg)];
  1321. {$ifdef csdebug}
  1322. Writeln(att_reg2str[Reg32(Paicpu(p2)^.oper[1].reg)], ' removed');
  1323. {$endif csdebug}
  1324. end;
  1325. InstructionsEquivalent :=
  1326. OpsEquivalent(Paicpu(p1)^.oper[0], Paicpu(p2)^.oper[0], RegInfo, OpAct_Read) And
  1327. OpsEquivalent(Paicpu(p1)^.oper[1], Paicpu(p2)^.oper[1], RegInfo, OpAct_Write)
  1328. End
  1329. Else
  1330. {an instruction <> mov, movzx, movsx}
  1331. begin
  1332. {$ifdef csdebug}
  1333. hp := new(pai_asm_comment,init(strpnew('checking if equivalent')));
  1334. hp^.previous := p2;
  1335. hp^.next := p2^.next;
  1336. p2^.next^.previous := hp;
  1337. p2^.next := hp;
  1338. {$endif csdebug}
  1339. InstructionsEquivalent :=
  1340. OpsEquivalent(Paicpu(p1)^.oper[0], Paicpu(p2)^.oper[0], RegInfo, OpAct_Unknown) And
  1341. OpsEquivalent(Paicpu(p1)^.oper[1], Paicpu(p2)^.oper[1], RegInfo, OpAct_Unknown) And
  1342. OpsEquivalent(Paicpu(p1)^.oper[2], Paicpu(p2)^.oper[2], RegInfo, OpAct_Unknown)
  1343. end
  1344. {the instructions haven't even got the same structure, so they're certainly
  1345. not equivalent}
  1346. Else
  1347. begin
  1348. {$ifdef csdebug}
  1349. hp := new(pai_asm_comment,init(strpnew('different opcodes/format')));
  1350. hp^.previous := p2;
  1351. hp^.next := p2^.next;
  1352. p2^.next^.previous := hp;
  1353. p2^.next := hp;
  1354. {$endif csdebug}
  1355. InstructionsEquivalent := False;
  1356. end;
  1357. {$ifdef csdebug}
  1358. hp := new(pai_asm_comment,init(strpnew('instreq: '+tostr(byte(instructionsequivalent)))));
  1359. hp^.previous := p2;
  1360. hp^.next := p2^.next;
  1361. p2^.next^.previous := hp;
  1362. p2^.next := hp;
  1363. {$endif csdebug}
  1364. End;
  1365. (*
  1366. Function InstructionsEqual(p1, p2: Pai): Boolean;
  1367. Begin {checks whether two Paicpu instructions are equal}
  1368. InstructionsEqual :=
  1369. Assigned(p1) And Assigned(p2) And
  1370. ((Pai(p1)^.typ = ait_instruction) And
  1371. (Pai(p1)^.typ = ait_instruction) And
  1372. (Paicpu(p1)^.opcode = Paicpu(p2)^.opcode) And
  1373. (Paicpu(p1)^.oper[0].typ = Paicpu(p2)^.oper[0].typ) And
  1374. (Paicpu(p1)^.oper[1].typ = Paicpu(p2)^.oper[1].typ) And
  1375. OpsEqual(Paicpu(p1)^.oper[0].typ, Paicpu(p1)^.oper[0], Paicpu(p2)^.oper[0]) And
  1376. OpsEqual(Paicpu(p1)^.oper[1].typ, Paicpu(p1)^.oper[1], Paicpu(p2)^.oper[1]))
  1377. End;
  1378. *)
  1379. Procedure ReadReg(p: PPaiProp; Reg: TRegister);
  1380. Begin
  1381. Reg := Reg32(Reg);
  1382. If Reg in [R_EAX..R_EDI] Then
  1383. incState(p^.regs[Reg].rstate,1)
  1384. End;
  1385. Procedure ReadRef(p: PPaiProp; Ref: PReference);
  1386. Begin
  1387. If Ref^.Base <> R_NO Then
  1388. ReadReg(p, Ref^.Base);
  1389. If Ref^.Index <> R_NO Then
  1390. ReadReg(p, Ref^.Index);
  1391. End;
  1392. Procedure ReadOp(P: PPaiProp;const o:toper);
  1393. Begin
  1394. Case o.typ Of
  1395. top_reg: ReadReg(P, o.reg);
  1396. top_ref: ReadRef(P, o.ref);
  1397. top_symbol : ;
  1398. End;
  1399. End;
  1400. Function RefInInstruction(Const Ref: TReference; p: Pai;
  1401. RefsEq: TRefCompare): Boolean;
  1402. {checks whehter Ref is used in P}
  1403. Var TmpResult: Boolean;
  1404. Begin
  1405. TmpResult := False;
  1406. If (p^.typ = ait_instruction) Then
  1407. Begin
  1408. If (Paicpu(p)^.oper[0].typ = Top_Ref) Then
  1409. TmpResult := RefsEq(Ref, Paicpu(p)^.oper[0].ref^);
  1410. If Not(TmpResult) And (Paicpu(p)^.oper[1].typ = Top_Ref) Then
  1411. TmpResult := RefsEq(Ref, Paicpu(p)^.oper[1].ref^);
  1412. If Not(TmpResult) And (Paicpu(p)^.oper[2].typ = Top_Ref) Then
  1413. TmpResult := RefsEq(Ref, Paicpu(p)^.oper[2].ref^);
  1414. End;
  1415. RefInInstruction := TmpResult;
  1416. End;
  1417. Function RefInSequence(Const Ref: TReference; Content: TContent;
  1418. RefsEq: TRefCompare): Boolean;
  1419. {checks the whole sequence of Content (so StartMod and and the next NrOfMods
  1420. Pai objects) to see whether Ref is used somewhere}
  1421. Var p: Pai;
  1422. Counter: Byte;
  1423. TmpResult: Boolean;
  1424. Begin
  1425. p := Content.StartMod;
  1426. TmpResult := False;
  1427. Counter := 1;
  1428. While Not(TmpResult) And
  1429. (Counter <= Content.NrOfMods) Do
  1430. Begin
  1431. If (p^.typ = ait_instruction) And
  1432. RefInInstruction(Ref, p, RefsEq)
  1433. Then TmpResult := True;
  1434. Inc(Counter);
  1435. GetNextInstruction(p,p)
  1436. End;
  1437. RefInSequence := TmpResult
  1438. End;
  1439. Function ArrayRefsEq(const r1, r2: TReference): Boolean;
  1440. Begin
  1441. ArrayRefsEq := (R1.Offset+R1.OffsetFixup = R2.Offset+R2.OffsetFixup) And
  1442. (R1.Segment = R2.Segment) And
  1443. (R1.Symbol=R2.Symbol) And
  1444. ((Assigned(R1.Symbol)) Or
  1445. (R1.Base = R2.Base))
  1446. End;
  1447. Procedure DestroyRefs(p: pai; Const Ref: TReference; WhichReg: TRegister);
  1448. {destroys all registers which possibly contain a reference to Ref, WhichReg
  1449. is the register whose contents are being written to memory (if this proc
  1450. is called because of a "mov?? %reg, (mem)" instruction)}
  1451. Var RefsEq: TRefCompare;
  1452. Counter: TRegister;
  1453. Begin
  1454. WhichReg := Reg32(WhichReg);
  1455. If (Ref.base = procinfo^.FramePointer) or
  1456. Assigned(Ref.Symbol) Then
  1457. Begin
  1458. If (ref.index <> R_NO) or
  1459. (assigned(ref.symbol) and
  1460. (ref.base <> R_NO)) then
  1461. { local/global variable or parameter which is an array }
  1462. RefsEq := {$ifdef fpc}@{$endif}ArrayRefsEq
  1463. Else
  1464. { local/global variable or parameter which is not an array }
  1465. RefsEq := {$ifdef fpc}@{$endif}RefsEqual;
  1466. {write something to a parameter, a local or global variable, so
  1467. * with uncertain optimizations on:
  1468. - destroy the contents of registers whose contents have somewhere a
  1469. "mov?? (Ref), %reg". WhichReg (this is the register whose contents
  1470. are being written to memory) is not destroyed if it's StartMod is
  1471. of that form and NrOfMods = 1 (so if it holds ref, but is not a
  1472. pointer based on Ref)
  1473. * with uncertain optimizations off:
  1474. - also destroy registers that contain any pointer}
  1475. For Counter := R_EAX to R_EDI Do
  1476. With PPaiProp(p^.OptInfo)^.Regs[Counter] Do
  1477. Begin
  1478. if (typ in [con_ref,con_noRemoveRef]) and
  1479. ((Not(cs_UncertainOpts in aktglobalswitches) And
  1480. (NrOfMods <> 1)
  1481. ) Or
  1482. (RefInSequence(Ref,PPaiProp(p^.OptInfo)^.Regs[Counter],RefsEq) And
  1483. ((Counter <> WhichReg) Or
  1484. ((NrOfMods <> 1) And
  1485. {StarMod is always of the type ait_instruction}
  1486. (Paicpu(StartMod)^.oper[0].typ = top_ref) And
  1487. RefsEq(Paicpu(StartMod)^.oper[0].ref^, Ref)
  1488. )
  1489. )
  1490. )
  1491. )
  1492. Then
  1493. DestroyReg(PPaiProp(p^.OptInfo), Counter, false)
  1494. End
  1495. End
  1496. Else
  1497. {write something to a pointer location, so
  1498. * with uncertain optimzations on:
  1499. - do not destroy registers which contain a local/global variable or a
  1500. parameter, except if DestroyRefs is called because of a "movsl"
  1501. * with uncertain optimzations off:
  1502. - destroy every register which contains a memory location
  1503. }
  1504. For Counter := R_EAX to R_EDI Do
  1505. With PPaiProp(p^.OptInfo)^.Regs[Counter] Do
  1506. if (typ in [con_ref,con_noRemoveRef]) And
  1507. (Not(cs_UncertainOpts in aktglobalswitches) Or
  1508. {for movsl}
  1509. (Ref.Base = R_EDI) Or
  1510. {don't destroy if reg contains a parameter, local or global variable}
  1511. Not((NrOfMods = 1) And
  1512. (Paicpu(StartMod)^.oper[0].typ = top_ref) And
  1513. ((Paicpu(StartMod)^.oper[0].ref^.base = procinfo^.FramePointer) Or
  1514. Assigned(Paicpu(StartMod)^.oper[0].ref^.Symbol)
  1515. )
  1516. )
  1517. )
  1518. Then DestroyReg(PPaiProp(p^.OptInfo), Counter, false)
  1519. End;
  1520. Procedure DestroyAllRegs(p: PPaiProp);
  1521. Var Counter: TRegister;
  1522. Begin {initializes/desrtoys all registers}
  1523. For Counter := R_EAX To R_EDI Do
  1524. Begin
  1525. ReadReg(p, Counter);
  1526. DestroyReg(p, Counter, true);
  1527. End;
  1528. p^.DirFlag := F_Unknown;
  1529. End;
  1530. Procedure DestroyOp(PaiObj: Pai; const o:Toper);
  1531. {$ifdef statedebug}
  1532. var hp: pai;
  1533. {$endif statedebug}
  1534. Begin
  1535. Case o.typ Of
  1536. top_reg:
  1537. begin
  1538. {$ifdef statedebug}
  1539. hp := new(pai_asm_comment,init(strpnew('destroying '+att_reg2str[o.reg])));
  1540. hp^.next := paiobj^.next;
  1541. hp^.previous := paiobj;
  1542. paiobj^.next := hp;
  1543. if assigned(hp^.next) then
  1544. hp^.next^.previous := hp;
  1545. {$endif statedebug}
  1546. DestroyReg(PPaiProp(PaiObj^.OptInfo), reg32(o.reg), true);
  1547. end;
  1548. top_ref:
  1549. Begin
  1550. ReadRef(PPaiProp(PaiObj^.OptInfo), o.ref);
  1551. DestroyRefs(PaiObj, o.ref^, R_NO);
  1552. End;
  1553. top_symbol:;
  1554. End;
  1555. End;
  1556. Function DFAPass1(AsmL: PAasmOutput; BlockStart: Pai): Pai;
  1557. {gathers the RegAlloc data... still need to think about where to store it to
  1558. avoid global vars}
  1559. Var BlockEnd: Pai;
  1560. Begin
  1561. BlockEnd := FindLoHiLabels(LoLab, HiLab, LabDif, BlockStart);
  1562. BuildLabelTableAndFixRegAlloc(AsmL, LTable, LoLab, LabDif, BlockStart, BlockEnd);
  1563. DFAPass1 := BlockEnd;
  1564. End;
  1565. Procedure AddInstr2RegContents({$ifdef statedebug} asml: paasmoutput; {$endif}
  1566. p: paicpu; reg: TRegister);
  1567. {$ifdef statedebug}
  1568. var hp: pai;
  1569. {$endif statedebug}
  1570. Begin
  1571. Reg := Reg32(Reg);
  1572. With PPaiProp(p^.optinfo)^.Regs[reg] Do
  1573. if (typ in [con_ref,con_noRemoveRef])
  1574. Then
  1575. Begin
  1576. incState(wstate,1);
  1577. {also store how many instructions are part of the sequence in the first
  1578. instructions PPaiProp, so it can be easily accessed from within
  1579. CheckSequence}
  1580. Inc(NrOfMods, NrOfInstrSinceLastMod[Reg]);
  1581. PPaiProp(Pai(StartMod)^.OptInfo)^.Regs[Reg].NrOfMods := NrOfMods;
  1582. NrOfInstrSinceLastMod[Reg] := 0;
  1583. {$ifdef StateDebug}
  1584. hp := new(pai_asm_comment,init(strpnew(att_reg2str[reg]+': '+tostr(PPaiProp(p^.optinfo)^.Regs[reg].WState)
  1585. + ' -- ' + tostr(PPaiProp(p^.optinfo)^.Regs[reg].nrofmods))));
  1586. InsertLLItem(AsmL, p, p^.next, hp);
  1587. {$endif StateDebug}
  1588. End
  1589. Else
  1590. Begin
  1591. {$ifdef statedebug}
  1592. hp := new(pai_asm_comment,init(strpnew('destroying '+att_reg2str[reg])));
  1593. insertllitem(asml,p,p^.next,hp);
  1594. {$endif statedebug}
  1595. DestroyReg(PPaiProp(p^.optinfo), Reg, true);
  1596. {$ifdef StateDebug}
  1597. hp := new(pai_asm_comment,init(strpnew(att_reg2str[reg]+': '+tostr(PPaiProp(p^.optinfo)^.Regs[reg].WState))));
  1598. InsertLLItem(AsmL, p, p^.next, hp);
  1599. {$endif StateDebug}
  1600. End
  1601. End;
  1602. Procedure AddInstr2OpContents({$ifdef statedebug} asml: paasmoutput; {$endif}
  1603. p: paicpu; const oper: TOper);
  1604. Begin
  1605. If oper.typ = top_reg Then
  1606. AddInstr2RegContents({$ifdef statedebug} asml, {$endif}p, oper.reg)
  1607. Else
  1608. Begin
  1609. ReadOp(PPaiProp(p^.optinfo), oper);
  1610. DestroyOp(p, oper);
  1611. End
  1612. End;
  1613. Procedure DoDFAPass2(
  1614. {$Ifdef StateDebug}
  1615. AsmL: PAasmOutput;
  1616. {$endif statedebug}
  1617. BlockStart, BlockEnd: Pai);
  1618. {Analyzes the Data Flow of an assembler list. Starts creating the reg
  1619. contents for the instructions starting with p. Returns the last pai which has
  1620. been processed}
  1621. Var
  1622. CurProp: PPaiProp;
  1623. Cnt, InstrCnt : Longint;
  1624. InstrProp: TInsProp;
  1625. UsedRegs: TRegSet;
  1626. p, hp : Pai;
  1627. TmpRef: TReference;
  1628. TmpReg: TRegister;
  1629. {$ifdef AnalyzeLoops}
  1630. TmpState: Byte;
  1631. {$endif AnalyzeLoops}
  1632. Begin
  1633. p := BlockStart;
  1634. UsedRegs := [];
  1635. UpdateUsedregs(UsedRegs, p);
  1636. SkipHead(P);
  1637. BlockStart := p;
  1638. InstrCnt := 1;
  1639. FillChar(NrOfInstrSinceLastMod, SizeOf(NrOfInstrSinceLastMod), 0);
  1640. While (P <> BlockEnd) Do
  1641. Begin
  1642. {$IfDef TP}
  1643. New(CurProp);
  1644. {$Else TP}
  1645. CurProp := @PaiPropBlock^[InstrCnt];
  1646. {$EndIf TP}
  1647. If (p <> BlockStart)
  1648. Then
  1649. Begin
  1650. {$ifdef JumpAnal}
  1651. If (p^.Typ <> ait_label) Then
  1652. {$endif JumpAnal}
  1653. Begin
  1654. GetLastInstruction(p, hp);
  1655. CurProp^.Regs := PPaiProp(hp^.OptInfo)^.Regs;
  1656. CurProp^.DirFlag := PPaiProp(hp^.OptInfo)^.DirFlag;
  1657. End
  1658. End
  1659. Else
  1660. Begin
  1661. FillChar(CurProp^, SizeOf(CurProp^), 0);
  1662. { For TmpReg := R_EAX to R_EDI Do
  1663. CurProp^.Regs[TmpReg].WState := 1;}
  1664. End;
  1665. CurProp^.UsedRegs := UsedRegs;
  1666. CurProp^.CanBeRemoved := False;
  1667. UpdateUsedRegs(UsedRegs, Pai(p^.Next));
  1668. {$ifdef TP}
  1669. PPaiProp(p^.OptInfo) := CurProp;
  1670. {$Endif TP}
  1671. For TmpReg := R_EAX To R_EDI Do
  1672. Inc(NrOfInstrSinceLastMod[TmpReg]);
  1673. Case p^.typ Of
  1674. ait_marker:;
  1675. ait_label:
  1676. {$Ifndef JumpAnal}
  1677. If not labelCanBeSkipped(pai_label(p)) Then
  1678. DestroyAllRegs(CurProp);
  1679. {$Else JumpAnal}
  1680. Begin
  1681. If not labelCanBeSkipped(pai_label(p)) Then
  1682. With LTable^[Pai_Label(p)^.l^.labelnr-LoLab] Do
  1683. {$IfDef AnalyzeLoops}
  1684. If (RefsFound = Pai_Label(p)^.l^.RefCount)
  1685. {$Else AnalyzeLoops}
  1686. If (JmpsProcessed = Pai_Label(p)^.l^.RefCount)
  1687. {$EndIf AnalyzeLoops}
  1688. Then
  1689. {all jumps to this label have been found}
  1690. {$IfDef AnalyzeLoops}
  1691. If (JmpsProcessed > 0)
  1692. Then
  1693. {$EndIf AnalyzeLoops}
  1694. {we've processed at least one jump to this label}
  1695. Begin
  1696. If (GetLastInstruction(p, hp) And
  1697. Not(((hp^.typ = ait_instruction)) And
  1698. (paicpu_labeled(hp)^.is_jmp))
  1699. Then
  1700. {previous instruction not a JMP -> the contents of the registers after the
  1701. previous intruction has been executed have to be taken into account as well}
  1702. For TmpReg := R_EAX to R_EDI Do
  1703. Begin
  1704. If (CurProp^.Regs[TmpReg].WState <>
  1705. PPaiProp(hp^.OptInfo)^.Regs[TmpReg].WState)
  1706. Then DestroyReg(CurProp, TmpReg, true)
  1707. End
  1708. End
  1709. {$IfDef AnalyzeLoops}
  1710. Else
  1711. {a label from a backward jump (e.g. a loop), no jump to this label has
  1712. already been processed}
  1713. If GetLastInstruction(p, hp) And
  1714. Not(hp^.typ = ait_instruction) And
  1715. (paicpu_labeled(hp)^.opcode = A_JMP))
  1716. Then
  1717. {previous instruction not a jmp, so keep all the registers' contents from the
  1718. previous instruction}
  1719. Begin
  1720. CurProp^.Regs := PPaiProp(hp^.OptInfo)^.Regs;
  1721. CurProp^.DirFlag := PPaiProp(hp^.OptInfo)^.DirFlag;
  1722. End
  1723. Else
  1724. {previous instruction a jmp and no jump to this label processed yet}
  1725. Begin
  1726. hp := p;
  1727. Cnt := InstrCnt;
  1728. {continue until we find a jump to the label or a label which has already
  1729. been processed}
  1730. While GetNextInstruction(hp, hp) And
  1731. Not((hp^.typ = ait_instruction) And
  1732. (paicpu(hp)^.is_jmp) and
  1733. (pasmlabel(paicpu(hp)^.oper[0].sym)^.labelnr = Pai_Label(p)^.l^.labelnr)) And
  1734. Not((hp^.typ = ait_label) And
  1735. (LTable^[Pai_Label(hp)^.l^.labelnr-LoLab].RefsFound
  1736. = Pai_Label(hp)^.l^.RefCount) And
  1737. (LTable^[Pai_Label(hp)^.l^.labelnr-LoLab].JmpsProcessed > 0)) Do
  1738. Inc(Cnt);
  1739. If (hp^.typ = ait_label)
  1740. Then
  1741. {there's a processed label after the current one}
  1742. Begin
  1743. CurProp^.Regs := PaiPropBlock^[Cnt].Regs;
  1744. CurProp^.DirFlag := PaiPropBlock^[Cnt].DirFlag;
  1745. End
  1746. Else
  1747. {there's no label anymore after the current one, or they haven't been
  1748. processed yet}
  1749. Begin
  1750. GetLastInstruction(p, hp);
  1751. CurProp^.Regs := PPaiProp(hp^.OptInfo)^.Regs;
  1752. CurProp^.DirFlag := PPaiProp(hp^.OptInfo)^.DirFlag;
  1753. DestroyAllRegs(PPaiProp(hp^.OptInfo))
  1754. End
  1755. End
  1756. {$EndIf AnalyzeLoops}
  1757. Else
  1758. {not all references to this label have been found, so destroy all registers}
  1759. Begin
  1760. GetLastInstruction(p, hp);
  1761. CurProp^.Regs := PPaiProp(hp^.OptInfo)^.Regs;
  1762. CurProp^.DirFlag := PPaiProp(hp^.OptInfo)^.DirFlag;
  1763. DestroyAllRegs(CurProp)
  1764. End;
  1765. End;
  1766. {$EndIf JumpAnal}
  1767. {$ifdef GDB}
  1768. ait_stabs, ait_stabn, ait_stab_function_name:;
  1769. {$endif GDB}
  1770. ait_align: ; { may destroy flags !!! }
  1771. ait_instruction:
  1772. Begin
  1773. if paicpu(p)^.is_jmp then
  1774. begin
  1775. {$IfNDef JumpAnal}
  1776. for tmpReg := R_EAX to R_EDI do
  1777. with curProp^.regs[tmpReg] do
  1778. case typ of
  1779. con_ref: typ := con_noRemoveRef;
  1780. con_const: typ := con_noRemoveConst;
  1781. con_invalid: typ := con_unknown;
  1782. end;
  1783. {$Else JumpAnal}
  1784. With LTable^[pasmlabel(paicpu(p)^.oper[0].sym)^.labelnr-LoLab] Do
  1785. If (RefsFound = pasmlabel(paicpu(p)^.oper[0].sym)^.RefCount) Then
  1786. Begin
  1787. If (InstrCnt < InstrNr)
  1788. Then
  1789. {forward jump}
  1790. If (JmpsProcessed = 0) Then
  1791. {no jump to this label has been processed yet}
  1792. Begin
  1793. PaiPropBlock^[InstrNr].Regs := CurProp^.Regs;
  1794. PaiPropBlock^[InstrNr].DirFlag := CurProp^.DirFlag;
  1795. Inc(JmpsProcessed);
  1796. End
  1797. Else
  1798. Begin
  1799. For TmpReg := R_EAX to R_EDI Do
  1800. If (PaiPropBlock^[InstrNr].Regs[TmpReg].WState <>
  1801. CurProp^.Regs[TmpReg].WState) Then
  1802. DestroyReg(@PaiPropBlock^[InstrNr], TmpReg, true);
  1803. Inc(JmpsProcessed);
  1804. End
  1805. {$ifdef AnalyzeLoops}
  1806. Else
  1807. { backward jump, a loop for example}
  1808. { If (JmpsProcessed > 0) Or
  1809. Not(GetLastInstruction(PaiObj, hp) And
  1810. (hp^.typ = ait_labeled_instruction) And
  1811. (paicpu_labeled(hp)^.opcode = A_JMP))
  1812. Then}
  1813. {instruction prior to label is not a jmp, or at least one jump to the label
  1814. has yet been processed}
  1815. Begin
  1816. Inc(JmpsProcessed);
  1817. For TmpReg := R_EAX to R_EDI Do
  1818. If (PaiPropBlock^[InstrNr].Regs[TmpReg].WState <>
  1819. CurProp^.Regs[TmpReg].WState)
  1820. Then
  1821. Begin
  1822. TmpState := PaiPropBlock^[InstrNr].Regs[TmpReg].WState;
  1823. Cnt := InstrNr;
  1824. While (TmpState = PaiPropBlock^[Cnt].Regs[TmpReg].WState) Do
  1825. Begin
  1826. DestroyReg(@PaiPropBlock^[Cnt], TmpReg, true);
  1827. Inc(Cnt);
  1828. End;
  1829. While (Cnt <= InstrCnt) Do
  1830. Begin
  1831. Inc(PaiPropBlock^[Cnt].Regs[TmpReg].WState);
  1832. Inc(Cnt)
  1833. End
  1834. End;
  1835. End
  1836. { Else }
  1837. {instruction prior to label is a jmp and no jumps to the label have yet been
  1838. processed}
  1839. { Begin
  1840. Inc(JmpsProcessed);
  1841. For TmpReg := R_EAX to R_EDI Do
  1842. Begin
  1843. TmpState := PaiPropBlock^[InstrNr].Regs[TmpReg].WState;
  1844. Cnt := InstrNr;
  1845. While (TmpState = PaiPropBlock^[Cnt].Regs[TmpReg].WState) Do
  1846. Begin
  1847. PaiPropBlock^[Cnt].Regs[TmpReg] := CurProp^.Regs[TmpReg];
  1848. Inc(Cnt);
  1849. End;
  1850. TmpState := PaiPropBlock^[InstrNr].Regs[TmpReg].WState;
  1851. While (TmpState = PaiPropBlock^[Cnt].Regs[TmpReg].WState) Do
  1852. Begin
  1853. DestroyReg(@PaiPropBlock^[Cnt], TmpReg, true);
  1854. Inc(Cnt);
  1855. End;
  1856. While (Cnt <= InstrCnt) Do
  1857. Begin
  1858. Inc(PaiPropBlock^[Cnt].Regs[TmpReg].WState);
  1859. Inc(Cnt)
  1860. End
  1861. End
  1862. End}
  1863. {$endif AnalyzeLoops}
  1864. End;
  1865. {$EndIf JumpAnal}
  1866. end
  1867. else
  1868. begin
  1869. InstrProp := InsProp[Paicpu(p)^.opcode];
  1870. Case Paicpu(p)^.opcode Of
  1871. A_MOV, A_MOVZX, A_MOVSX:
  1872. Begin
  1873. Case Paicpu(p)^.oper[0].typ Of
  1874. Top_Reg:
  1875. Case Paicpu(p)^.oper[1].typ Of
  1876. Top_Reg:
  1877. Begin
  1878. {$ifdef statedebug}
  1879. hp := new(pai_asm_comment,init(strpnew('destroying '+
  1880. att_reg2str[Paicpu(p)^.oper[1].reg])));
  1881. insertllitem(asml,p,p^.next,hp);
  1882. {$endif statedebug}
  1883. DestroyReg(CurProp, Paicpu(p)^.oper[1].reg, true);
  1884. ReadReg(CurProp, Paicpu(p)^.oper[0].reg);
  1885. { CurProp^.Regs[Paicpu(p)^.oper[1].reg] :=
  1886. CurProp^.Regs[Paicpu(p)^.oper[0].reg];
  1887. If (CurProp^.Regs[Paicpu(p)^.oper[1].reg].ModReg = R_NO) Then
  1888. CurProp^.Regs[Paicpu(p)^.oper[1].reg].ModReg :=
  1889. Paicpu(p)^.oper[0].reg;}
  1890. End;
  1891. Top_Ref:
  1892. Begin
  1893. ReadReg(CurProp, Paicpu(p)^.oper[0].reg);
  1894. ReadRef(CurProp, Paicpu(p)^.oper[1].ref);
  1895. DestroyRefs(p, Paicpu(p)^.oper[1].ref^, Paicpu(p)^.oper[0].reg);
  1896. End;
  1897. End;
  1898. Top_Ref:
  1899. Begin {destination is always a register in this case}
  1900. ReadRef(CurProp, Paicpu(p)^.oper[0].ref);
  1901. TmpReg := Reg32(Paicpu(p)^.oper[1].reg);
  1902. If RegInRef(TmpReg, Paicpu(p)^.oper[0].ref^) And
  1903. (curProp^.regs[tmpReg].typ in [con_ref,con_noRemoveRef])
  1904. Then
  1905. Begin
  1906. With CurProp^.Regs[TmpReg] Do
  1907. Begin
  1908. incState(wstate,1);
  1909. {also store how many instructions are part of the sequence in the first
  1910. instructions PPaiProp, so it can be easily accessed from within
  1911. CheckSequence}
  1912. Inc(NrOfMods, NrOfInstrSinceLastMod[TmpReg]);
  1913. PPaiProp(Pai(StartMod)^.OptInfo)^.Regs[TmpReg].NrOfMods := NrOfMods;
  1914. NrOfInstrSinceLastMod[TmpReg] := 0;
  1915. { Destroy the contents of the registers }
  1916. { that depended on the previous value of }
  1917. { this register }
  1918. invalidateDepedingRegs(curProp,tmpReg);
  1919. End;
  1920. End
  1921. Else
  1922. Begin
  1923. {$ifdef statedebug}
  1924. hp := new(pai_asm_comment,init(strpnew('destroying & initing '+att_reg2str[tmpreg])));
  1925. insertllitem(asml,p,p^.next,hp);
  1926. {$endif statedebug}
  1927. DestroyReg(CurProp, TmpReg, true);
  1928. If Not(RegInRef(TmpReg, Paicpu(p)^.oper[0].ref^)) Then
  1929. With CurProp^.Regs[TmpReg] Do
  1930. Begin
  1931. Typ := Con_Ref;
  1932. StartMod := p;
  1933. NrOfMods := 1;
  1934. End
  1935. End;
  1936. {$ifdef StateDebug}
  1937. hp := new(pai_asm_comment,init(strpnew(att_reg2str[TmpReg]+': '+tostr(CurProp^.Regs[TmpReg].WState))));
  1938. InsertLLItem(AsmL, p, p^.next, hp);
  1939. {$endif StateDebug}
  1940. End;
  1941. top_symbol,Top_Const:
  1942. Begin
  1943. Case Paicpu(p)^.oper[1].typ Of
  1944. Top_Reg:
  1945. Begin
  1946. TmpReg := Reg32(Paicpu(p)^.oper[1].reg);
  1947. {$ifdef statedebug}
  1948. hp := new(pai_asm_comment,init(strpnew('destroying '+att_reg2str[tmpreg])));
  1949. insertllitem(asml,p,p^.next,hp);
  1950. {$endif statedebug}
  1951. With CurProp^.Regs[TmpReg] Do
  1952. Begin
  1953. DestroyReg(CurProp, TmpReg, true);
  1954. typ := Con_Const;
  1955. StartMod := p;
  1956. End
  1957. End;
  1958. Top_Ref:
  1959. Begin
  1960. ReadRef(CurProp, Paicpu(p)^.oper[1].ref);
  1961. DestroyRefs(P, Paicpu(p)^.oper[1].ref^, R_NO);
  1962. End;
  1963. End;
  1964. End;
  1965. End;
  1966. End;
  1967. A_DIV, A_IDIV, A_MUL:
  1968. Begin
  1969. ReadOp(Curprop, Paicpu(p)^.oper[0]);
  1970. ReadReg(CurProp,R_EAX);
  1971. If (Paicpu(p)^.OpCode = A_IDIV) or
  1972. (Paicpu(p)^.OpCode = A_DIV) Then
  1973. ReadReg(CurProp,R_EDX);
  1974. {$ifdef statedebug}
  1975. hp := new(pai_asm_comment,init(strpnew('destroying eax and edx')));
  1976. insertllitem(asml,p,p^.next,hp);
  1977. {$endif statedebug}
  1978. DestroyReg(CurProp, R_EAX, true);
  1979. DestroyReg(CurProp, R_EDX, true)
  1980. End;
  1981. A_IMUL:
  1982. Begin
  1983. ReadOp(CurProp,Paicpu(p)^.oper[0]);
  1984. ReadOp(CurProp,Paicpu(p)^.oper[1]);
  1985. If (Paicpu(p)^.oper[2].typ = top_none) Then
  1986. If (Paicpu(p)^.oper[1].typ = top_none) Then
  1987. Begin
  1988. ReadReg(CurProp,R_EAX);
  1989. {$ifdef statedebug}
  1990. hp := new(pai_asm_comment,init(strpnew('destroying eax and edx')));
  1991. insertllitem(asml,p,p^.next,hp);
  1992. {$endif statedebug}
  1993. DestroyReg(CurProp, R_EAX, true);
  1994. DestroyReg(CurProp, R_EDX, true)
  1995. End
  1996. Else
  1997. AddInstr2OpContents(
  1998. {$ifdef statedebug}asml,{$endif}
  1999. Paicpu(p), Paicpu(p)^.oper[1])
  2000. Else
  2001. AddInstr2OpContents({$ifdef statedebug}asml,{$endif}
  2002. Paicpu(p), Paicpu(p)^.oper[2]);
  2003. End;
  2004. A_LEA:
  2005. begin
  2006. readop(curprop,paicpu(p)^.oper[0]);
  2007. if reginref(paicpu(p)^.oper[1].reg,paicpu(p)^.oper[0].ref^) then
  2008. AddInstr2RegContents({$ifdef statedebug}asml,{$endif}
  2009. paicpu(p), paicpu(p)^.oper[1].reg)
  2010. else
  2011. begin
  2012. {$ifdef statedebug}
  2013. hp := new(pai_asm_comment,init(strpnew('destroying '+
  2014. att_reg2str[paicpu(p)^.oper[1].reg])));
  2015. insertllitem(asml,p,p^.next,hp);
  2016. {$endif statedebug}
  2017. destroyreg(curprop,paicpu(p)^.oper[1].reg,true);
  2018. end;
  2019. end;
  2020. Else
  2021. Begin
  2022. Cnt := 1;
  2023. While (Cnt <= MaxCh) And
  2024. (InstrProp.Ch[Cnt] <> Ch_None) Do
  2025. Begin
  2026. Case InstrProp.Ch[Cnt] Of
  2027. Ch_REAX..Ch_REDI: ReadReg(CurProp,TCh2Reg(InstrProp.Ch[Cnt]));
  2028. Ch_WEAX..Ch_RWEDI:
  2029. Begin
  2030. If (InstrProp.Ch[Cnt] >= Ch_RWEAX) Then
  2031. ReadReg(CurProp, TCh2Reg(InstrProp.Ch[Cnt]));
  2032. {$ifdef statedebug}
  2033. hp := new(pai_asm_comment,init(strpnew('destroying '+
  2034. att_reg2str[TCh2Reg(InstrProp.Ch[Cnt])])));
  2035. insertllitem(asml,p,p^.next,hp);
  2036. {$endif statedebug}
  2037. DestroyReg(CurProp, TCh2Reg(InstrProp.Ch[Cnt]), true);
  2038. End;
  2039. Ch_MEAX..Ch_MEDI:
  2040. AddInstr2RegContents({$ifdef statedebug} asml,{$endif}
  2041. Paicpu(p),TCh2Reg(InstrProp.Ch[Cnt]));
  2042. Ch_CDirFlag: CurProp^.DirFlag := F_NotSet;
  2043. Ch_SDirFlag: CurProp^.DirFlag := F_Set;
  2044. Ch_Rop1: ReadOp(CurProp, Paicpu(p)^.oper[0]);
  2045. Ch_Rop2: ReadOp(CurProp, Paicpu(p)^.oper[1]);
  2046. Ch_ROp3: ReadOp(CurProp, Paicpu(p)^.oper[2]);
  2047. Ch_Wop1..Ch_RWop1:
  2048. Begin
  2049. If (InstrProp.Ch[Cnt] in [Ch_RWop1]) Then
  2050. ReadOp(CurProp, Paicpu(p)^.oper[0]);
  2051. DestroyOp(p, Paicpu(p)^.oper[0]);
  2052. End;
  2053. Ch_Mop1:
  2054. AddInstr2OpContents({$ifdef statedebug} asml, {$endif}
  2055. Paicpu(p), Paicpu(p)^.oper[0]);
  2056. Ch_Wop2..Ch_RWop2:
  2057. Begin
  2058. If (InstrProp.Ch[Cnt] = Ch_RWop2) Then
  2059. ReadOp(CurProp, Paicpu(p)^.oper[1]);
  2060. DestroyOp(p, Paicpu(p)^.oper[1]);
  2061. End;
  2062. Ch_Mop2:
  2063. AddInstr2OpContents({$ifdef statedebug} asml, {$endif}
  2064. Paicpu(p), Paicpu(p)^.oper[1]);
  2065. Ch_WOp3..Ch_RWOp3:
  2066. Begin
  2067. If (InstrProp.Ch[Cnt] = Ch_RWOp3) Then
  2068. ReadOp(CurProp, Paicpu(p)^.oper[2]);
  2069. DestroyOp(p, Paicpu(p)^.oper[2]);
  2070. End;
  2071. Ch_Mop3:
  2072. AddInstr2OpContents({$ifdef statedebug} asml, {$endif}
  2073. Paicpu(p), Paicpu(p)^.oper[2]);
  2074. Ch_WMemEDI:
  2075. Begin
  2076. ReadReg(CurProp, R_EDI);
  2077. FillChar(TmpRef, SizeOf(TmpRef), 0);
  2078. TmpRef.Base := R_EDI;
  2079. DestroyRefs(p, TmpRef, R_NO)
  2080. End;
  2081. Ch_RFlags, Ch_WFlags, Ch_RWFlags, Ch_FPU:
  2082. Else
  2083. Begin
  2084. {$ifdef statedebug}
  2085. hp := new(pai_asm_comment,init(strpnew(
  2086. 'destroying all regs for prev instruction')));
  2087. insertllitem(asml,p, p^.next,hp);
  2088. {$endif statedebug}
  2089. DestroyAllRegs(CurProp);
  2090. End;
  2091. End;
  2092. Inc(Cnt);
  2093. End
  2094. End;
  2095. end;
  2096. End;
  2097. End
  2098. Else
  2099. Begin
  2100. {$ifdef statedebug}
  2101. hp := new(pai_asm_comment,init(strpnew(
  2102. 'destroying all regs: unknown pai: '+tostr(ord(p^.typ)))));
  2103. insertllitem(asml,p, p^.next,hp);
  2104. {$endif statedebug}
  2105. DestroyAllRegs(CurProp);
  2106. End;
  2107. End;
  2108. Inc(InstrCnt);
  2109. GetNextInstruction(p, p);
  2110. End;
  2111. End;
  2112. Function InitDFAPass2(BlockStart, BlockEnd: Pai): Boolean;
  2113. {reserves memory for the PPaiProps in one big memory block when not using
  2114. TP, returns False if not enough memory is available for the optimizer in all
  2115. cases}
  2116. Var p: Pai;
  2117. Count: Longint;
  2118. { TmpStr: String; }
  2119. Begin
  2120. P := BlockStart;
  2121. SkipHead(P);
  2122. NrOfPaiObjs := 0;
  2123. While (P <> BlockEnd) Do
  2124. Begin
  2125. {$IfDef JumpAnal}
  2126. Case P^.Typ Of
  2127. ait_label:
  2128. Begin
  2129. If not labelCanBeSkipped(pai_label(p)) Then
  2130. LTable^[Pai_Label(P)^.l^.labelnr-LoLab].InstrNr := NrOfPaiObjs
  2131. End;
  2132. ait_instruction:
  2133. begin
  2134. if paicpu(p)^.is_jmp then
  2135. begin
  2136. If (pasmlabel(paicpu(P)^.oper[0].sym)^.labelnr >= LoLab) And
  2137. (pasmlabel(paicpu(P)^.oper[0].sym)^.labelnr <= HiLab) Then
  2138. Inc(LTable^[pasmlabel(paicpu(P)^.oper[0].sym)^.labelnr-LoLab].RefsFound);
  2139. end;
  2140. end;
  2141. { ait_instruction:
  2142. Begin
  2143. If (Paicpu(p)^.opcode = A_PUSH) And
  2144. (Paicpu(p)^.oper[0].typ = top_symbol) And
  2145. (PCSymbol(Paicpu(p)^.oper[0])^.offset = 0) Then
  2146. Begin
  2147. TmpStr := StrPas(PCSymbol(Paicpu(p)^.oper[0])^.symbol);
  2148. If}
  2149. End;
  2150. {$EndIf JumpAnal}
  2151. Inc(NrOfPaiObjs);
  2152. GetNextInstruction(p, p);
  2153. End;
  2154. {$IfDef TP}
  2155. If (MemAvail < (SizeOf(TPaiProp)*NrOfPaiObjs))
  2156. Or (NrOfPaiObjs = 0)
  2157. {this doesn't have to be one contiguous block}
  2158. Then InitDFAPass2 := False
  2159. Else InitDFAPass2 := True;
  2160. {$Else}
  2161. {Uncomment the next line to see how much memory the reloading optimizer needs}
  2162. { Writeln((NrOfPaiObjs*(((SizeOf(TPaiProp)+3)div 4)*4)));}
  2163. {no need to check mem/maxavail, we've got as much virtual memory as we want}
  2164. If NrOfPaiObjs <> 0 Then
  2165. Begin
  2166. InitDFAPass2 := True;
  2167. GetMem(PaiPropBlock, NrOfPaiObjs*(((SizeOf(TPaiProp)+3)div 4)*4));
  2168. p := BlockStart;
  2169. SkipHead(p);
  2170. For Count := 1 To NrOfPaiObjs Do
  2171. Begin
  2172. PPaiProp(p^.OptInfo) := @PaiPropBlock^[Count];
  2173. GetNextInstruction(p, p);
  2174. End;
  2175. End
  2176. Else InitDFAPass2 := False;
  2177. {$EndIf TP}
  2178. End;
  2179. Function DFAPass2(
  2180. {$ifdef statedebug}
  2181. AsmL: PAasmOutPut;
  2182. {$endif statedebug}
  2183. BlockStart, BlockEnd: Pai): Boolean;
  2184. Begin
  2185. If InitDFAPass2(BlockStart, BlockEnd) Then
  2186. Begin
  2187. DoDFAPass2(
  2188. {$ifdef statedebug}
  2189. asml,
  2190. {$endif statedebug}
  2191. BlockStart, BlockEnd);
  2192. DFAPass2 := True
  2193. End
  2194. Else DFAPass2 := False;
  2195. End;
  2196. Procedure ShutDownDFA;
  2197. Begin
  2198. If LabDif <> 0 Then
  2199. FreeMem(LTable, LabDif*SizeOf(TLabelTableItem));
  2200. End;
  2201. End.
  2202. {
  2203. $Log$
  2204. Revision 1.11 2000-09-24 15:06:15 peter
  2205. * use defines.inc
  2206. Revision 1.10 2000/09/22 15:00:20 jonas
  2207. * fixed bug in regsEquivalent (in some rare cases, registers with
  2208. completely unrelated content were considered equivalent) (merged
  2209. from fixes branch)
  2210. Revision 1.9 2000/09/20 15:00:58 jonas
  2211. + much improved CSE: the CSE now searches further back for sequences it
  2212. can reuse. After I've also implemented register renaming, the effect
  2213. should be even better (afaik web bug 1088 will then even be optimized
  2214. properly). I don't know about the slow down factor this adds. Maybe
  2215. a new optimization level should be introduced?
  2216. Revision 1.8 2000/08/25 19:39:18 jonas
  2217. * bugfix to FindRegAlloc function (caused wrong regalloc info in
  2218. some cases) (merged from fixes branch)
  2219. Revision 1.7 2000/08/23 12:55:10 jonas
  2220. * fix for web bug 1112 and a bit of clean up in csopt386 (merged from
  2221. fixes branch)
  2222. Revision 1.6 2000/08/19 17:53:29 jonas
  2223. * fixed a potential bug in destroyregs regarding the removal of
  2224. unused loads
  2225. * added destroyDependingRegs() procedure and use it for the fix in
  2226. the previous commit (safer/more complete than what was done before)
  2227. Revision 1.5 2000/08/19 09:08:59 jonas
  2228. * fixed bug where the contents of a register would not be destroyed
  2229. if another register on which these contents depend is modified
  2230. (not really merged, but same idea as fix in fixes branch,
  2231. LAST_MERGE tag is updated)
  2232. Revision 1.4 2000/07/21 15:19:54 jonas
  2233. * daopt386: changes to getnextinstruction/getlastinstruction so they
  2234. ignore labels who have is_addr set
  2235. + daopt386/csopt386: remove loads of registers which are overwritten
  2236. before their contents are used (especially usefull for removing superfluous
  2237. maybe_loadesi outputs and push/pops transformed by below optimization
  2238. + popt386: transform pop/pop/pop/.../push/push/push to sequences of
  2239. 'movl x(%esp),%reg' (only active when compiling a go32v2 compiler
  2240. currently because I don't know whether it's safe to do this under Win32/
  2241. Linux (because of problems we had when using esp as frame pointer on
  2242. those os'es)
  2243. Revision 1.3 2000/07/14 05:11:48 michael
  2244. + Patch to 1.1
  2245. Revision 1.2 2000/07/13 11:32:40 michael
  2246. + removed logs
  2247. }