aoptobj.pas 57 KB

123456789101112131415161718192021222324252627282930313233343536373839404142434445464748495051525354555657585960616263646566676869707172737475767778798081828384858687888990919293949596979899100101102103104105106107108109110111112113114115116117118119120121122123124125126127128129130131132133134135136137138139140141142143144145146147148149150151152153154155156157158159160161162163164165166167168169170171172173174175176177178179180181182183184185186187188189190191192193194195196197198199200201202203204205206207208209210211212213214215216217218219220221222223224225226227228229230231232233234235236237238239240241242243244245246247248249250251252253254255256257258259260261262263264265266267268269270271272273274275276277278279280281282283284285286287288289290291292293294295296297298299300301302303304305306307308309310311312313314315316317318319320321322323324325326327328329330331332333334335336337338339340341342343344345346347348349350351352353354355356357358359360361362363364365366367368369370371372373374375376377378379380381382383384385386387388389390391392393394395396397398399400401402403404405406407408409410411412413414415416417418419420421422423424425426427428429430431432433434435436437438439440441442443444445446447448449450451452453454455456457458459460461462463464465466467468469470471472473474475476477478479480481482483484485486487488489490491492493494495496497498499500501502503504505506507508509510511512513514515516517518519520521522523524525526527528529530531532533534535536537538539540541542543544545546547548549550551552553554555556557558559560561562563564565566567568569570571572573574575576577578579580581582583584585586587588589590591592593594595596597598599600601602603604605606607608609610611612613614615616617618619620621622623624625626627628629630631632633634635636637638639640641642643644645646647648649650651652653654655656657658659660661662663664665666667668669670671672673674675676677678679680681682683684685686687688689690691692693694695696697698699700701702703704705706707708709710711712713714715716717718719720721722723724725726727728729730731732733734735736737738739740741742743744745746747748749750751752753754755756757758759760761762763764765766767768769770771772773774775776777778779780781782783784785786787788789790791792793794795796797798799800801802803804805806807808809810811812813814815816817818819820821822823824825826827828829830831832833834835836837838839840841842843844845846847848849850851852853854855856857858859860861862863864865866867868869870871872873874875876877878879880881882883884885886887888889890891892893894895896897898899900901902903904905906907908909910911912913914915916917918919920921922923924925926927928929930931932933934935936937938939940941942943944945946947948949950951952953954955956957958959960961962963964965966967968969970971972973974975976977978979980981982983984985986987988989990991992993994995996997998999100010011002100310041005100610071008100910101011101210131014101510161017101810191020102110221023102410251026102710281029103010311032103310341035103610371038103910401041104210431044104510461047104810491050105110521053105410551056105710581059106010611062106310641065106610671068106910701071107210731074107510761077107810791080108110821083108410851086108710881089109010911092109310941095109610971098109911001101110211031104110511061107110811091110111111121113111411151116111711181119112011211122112311241125112611271128112911301131113211331134113511361137113811391140114111421143114411451146114711481149115011511152115311541155115611571158115911601161116211631164116511661167116811691170117111721173117411751176117711781179118011811182118311841185118611871188118911901191119211931194119511961197119811991200120112021203120412051206120712081209121012111212121312141215121612171218121912201221122212231224122512261227122812291230123112321233123412351236123712381239124012411242124312441245124612471248124912501251125212531254125512561257125812591260126112621263126412651266126712681269127012711272127312741275127612771278127912801281128212831284128512861287128812891290129112921293129412951296129712981299130013011302130313041305130613071308130913101311131213131314131513161317131813191320132113221323132413251326132713281329133013311332133313341335133613371338133913401341134213431344134513461347134813491350135113521353135413551356135713581359136013611362136313641365136613671368136913701371137213731374137513761377137813791380138113821383138413851386138713881389139013911392139313941395139613971398139914001401140214031404140514061407140814091410141114121413141414151416141714181419142014211422142314241425142614271428142914301431143214331434143514361437143814391440144114421443144414451446144714481449145014511452145314541455145614571458145914601461146214631464146514661467146814691470147114721473147414751476147714781479148014811482148314841485148614871488148914901491149214931494149514961497149814991500150115021503150415051506150715081509151015111512151315141515151615171518151915201521152215231524152515261527152815291530153115321533153415351536153715381539154015411542154315441545154615471548154915501551155215531554155515561557155815591560156115621563156415651566156715681569157015711572157315741575
  1. {
  2. Copyright (c) 1998-2004 by Jonas Maebe, member of the Free Pascal
  3. Development Team
  4. This unit contains the processor independent assembler optimizer
  5. object, base for the dataflow analyzer, peepholeoptimizer and
  6. common subexpression elimination objects.
  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 AoptObj;
  21. {$i fpcdefs.inc}
  22. { general, processor independent objects for use by the assembler optimizer }
  23. Interface
  24. uses
  25. globtype,
  26. aasmbase,aasmcpu,aasmtai,aasmdata,
  27. cclasses,
  28. cgbase,cgutils,
  29. cpubase,
  30. aoptbase,aoptcpub,aoptda;
  31. { ************************************************************************* }
  32. { ********************************* Constants ***************************** }
  33. { ************************************************************************* }
  34. Const
  35. {Possible register content types}
  36. con_Unknown = 0;
  37. con_ref = 1;
  38. con_const = 2;
  39. {***************** Types ****************}
  40. Type
  41. { ************************************************************************* }
  42. { ************************* Some general type definitions ***************** }
  43. { ************************************************************************* }
  44. TRefCompare = Function(const r1, r2: TReference): Boolean;
  45. //!!! FIXME
  46. TRegArray = Array[byte] of tsuperregister;
  47. TRegSet = tcpuregisterset;
  48. { possible actions on an operand: read, write or modify (= read & write) }
  49. TOpAction = (OpAct_Read, OpAct_Write, OpAct_Modify, OpAct_Unknown);
  50. { ************************************************************************* }
  51. { * Object to hold information on which regiters are in use and which not * }
  52. { ************************************************************************* }
  53. { TUsedRegs }
  54. TUsedRegs = class
  55. Constructor create(aTyp : TRegisterType);
  56. Constructor create_regset(aTyp : TRegisterType;Const _RegSet: TRegSet);
  57. Destructor Destroy;override;
  58. Procedure Clear;
  59. { update the info with the pairegalloc objects coming after
  60. p }
  61. procedure Update(p: Tai; IgnoreNewAllocs: Boolean=false);
  62. { is Reg currently in use }
  63. Function IsUsed(Reg: TRegister): Boolean;
  64. { get all the currently used registers }
  65. Function GetUsedRegs: TRegSet;
  66. Private
  67. Typ : TRegisterType;
  68. UsedRegs: TRegSet;
  69. End;
  70. { ************************************************************************* }
  71. { ******************* Contents of the integer registers ******************* }
  72. { ************************************************************************* }
  73. { size of the integer that holds the state number of a register. Can be any }
  74. { integer type, so it can be changed to reduce the size of the TContent }
  75. { structure or to improve alignment }
  76. TStateInt = Byte;
  77. TContent = Record
  78. { start and end of block instructions that defines the }
  79. { content of this register. If Typ = con_const, then }
  80. { Longint(StartMod) = value of the constant) }
  81. StartMod: Tai;
  82. { starts at 0, gets increased everytime the register is }
  83. { written to }
  84. WState: TStateInt;
  85. { starts at 0, gets increased everytime the register is read }
  86. { from }
  87. RState: TStateInt;
  88. { how many instructions starting with StarMod does the block }
  89. { consist of }
  90. NrOfMods: Byte;
  91. { the type of the content of the register: unknown, memory }
  92. { (variable) or constant }
  93. Typ: Byte;
  94. End;
  95. //!!! FIXME
  96. TRegContent = Array[byte] Of TContent;
  97. { ************************************************************************** }
  98. { information object with the contents of every register. Every Tai object }
  99. { gets one of these assigned: a pointer to it is stored in the OptInfo field }
  100. { ************************************************************************** }
  101. { TPaiProp }
  102. TPaiProp = class(TAoptBaseCpu)
  103. Regs: TRegContent;
  104. { can this instruction be removed? }
  105. CanBeRemoved: Boolean;
  106. Constructor create; reintroduce;
  107. { checks the whole sequence of which (so regs[which].StartMod and and }
  108. { the next NrOfMods Tai objects) to see whether Reg is used somewhere, }
  109. { without it being loaded with something else first }
  110. Function RegInSequence(Reg, which: TRegister): Boolean;
  111. { destroy the contents of a register, as well as those whose contents }
  112. { are based on those of that register }
  113. Procedure DestroyReg(Reg: TRegister; var InstrSinceLastMod:
  114. TInstrSinceLastMod);
  115. { if the contents of WhichReg (can be R_NO in case of a constant) are }
  116. { written to memory at the location Ref, the contents of the registers }
  117. { that depend on Ref have to be destroyed }
  118. Procedure DestroyRefs(Const Ref: TReference; WhichReg: TRegister; var
  119. InstrSinceLastMod: TInstrSinceLastMod);
  120. { an instruction reads from operand o }
  121. Procedure ReadOp(const o:toper);
  122. { an instruction reads from reference Ref }
  123. Procedure ReadRef(Ref: PReference);
  124. { an instruction reads from register Reg }
  125. Procedure ReadReg(Reg: TRegister);
  126. { an instruction writes/modifies operand o and this has special }
  127. { side-effects or modifies the contents in such a way that we can't }
  128. { simply add this instruction to the sequence of instructions that }
  129. { describe the contents of the operand, so destroy it }
  130. Procedure DestroyOp(const o:Toper; var InstrSinceLastMod:
  131. TInstrSinceLastMod);
  132. { destroy the contents of all registers }
  133. Procedure DestroyAllRegs(var InstrSinceLastMod: TInstrSinceLastMod);
  134. { a register's contents are modified, but not destroyed (the new value
  135. depends on the old one) }
  136. Procedure ModifyReg(reg: TRegister; var InstrSinceLastMod:
  137. TInstrSinceLastMod);
  138. { an operand's contents are modified, but not destroyed (the new value
  139. depends on the old one) }
  140. Procedure ModifyOp(const oper: TOper; var InstrSinceLastMod:
  141. TInstrSinceLastMod);
  142. { increase the write state of a register (call every time a register is
  143. written to) }
  144. Procedure IncWState(Reg: TRegister);
  145. { increase the read state of a register (call every time a register is }
  146. { read from) }
  147. Procedure IncRState(Reg: TRegister);
  148. { get the write state of a register }
  149. Function GetWState(Reg: TRegister): TStateInt;
  150. { get the read state of a register }
  151. Function GetRState(Reg: TRegister): TStateInt;
  152. { get the type of contents of a register }
  153. Function GetRegContentType(Reg: TRegister): Byte;
  154. Destructor Done;
  155. Private
  156. Procedure IncState(var s: TStateInt);
  157. { returns whether the reference Ref is used somewhere in the loading }
  158. { sequence Content }
  159. Function RefInSequence(Const Ref: TReference; Content: TContent;
  160. RefsEq: TRefCompare): Boolean;
  161. { returns whether the instruction P reads from and/or writes }
  162. { to Reg }
  163. Function RefInInstruction(Const Ref: TReference; p: Tai;
  164. RefsEq: TRefCompare): Boolean;
  165. { returns whether two references with at least one pointing to an array }
  166. { may point to the same memory location }
  167. End;
  168. { ************************************************************************* }
  169. { ************************ Label information ****************************** }
  170. { ************************************************************************* }
  171. TLabelTableItem = Record
  172. PaiObj: Tai;
  173. End;
  174. TLabelTable = Array[0..2500000] Of TLabelTableItem;
  175. PLabelTable = ^TLabelTable;
  176. PLabelInfo = ^TLabelInfo;
  177. TLabelInfo = Record
  178. { the highest and lowest label number occurring in the current code }
  179. { fragment }
  180. LowLabel, HighLabel: longint;
  181. LabelDif: cardinal;
  182. { table that contains the addresses of the Pai_Label objects associated
  183. with each label number }
  184. LabelTable: PLabelTable;
  185. End;
  186. { ************************************************************************* }
  187. { ********** General optimizer object, used to derive others from ********* }
  188. { ************************************************************************* }
  189. TAllUsedRegs = array[TRegisterType] of TUsedRegs;
  190. { TAOptObj }
  191. TAOptObj = class(TAoptBaseCpu)
  192. { the PAasmOutput list this optimizer instance works on }
  193. AsmL: TAsmList;
  194. { The labelinfo record contains the addresses of the Tai objects }
  195. { that are labels, how many labels there are and the min and max }
  196. { label numbers }
  197. LabelInfo: PLabelInfo;
  198. { Start and end of the block that is currently being optimized }
  199. BlockStart, BlockEnd: Tai;
  200. DFA: TAOptDFA;
  201. UsedRegs: TAllUsedRegs;
  202. { _AsmL is the PAasmOutpout list that has to be optimized, }
  203. { _BlockStart and _BlockEnd the start and the end of the block }
  204. { that has to be optimized and _LabelInfo a pointer to a }
  205. { TLabelInfo record }
  206. Constructor create(_AsmL: TAsmList; _BlockStart, _BlockEnd: Tai;
  207. _LabelInfo: PLabelInfo); virtual; reintroduce;
  208. Destructor Destroy;override;
  209. { processor independent methods }
  210. Procedure CreateUsedRegs(var regs: TAllUsedRegs);
  211. Procedure ClearUsedRegs;
  212. Procedure UpdateUsedRegs(p : Tai);
  213. class procedure UpdateUsedRegs(var Regs: TAllUsedRegs; p: Tai);
  214. Function CopyUsedRegs(var dest : TAllUsedRegs) : boolean;
  215. class Procedure ReleaseUsedRegs(const regs : TAllUsedRegs);
  216. class Function RegInUsedRegs(reg : TRegister;regs : TAllUsedRegs) : boolean;
  217. class Procedure IncludeRegInUsedRegs(reg : TRegister;var regs : TAllUsedRegs);
  218. class Procedure ExcludeRegFromUsedRegs(reg: TRegister;var regs : TAllUsedRegs);
  219. Function GetAllocationString(const regs : TAllUsedRegs) : string;
  220. { returns true if the label L is found between hp and the next }
  221. { instruction }
  222. Function FindLabel(L: TasmLabel; Var hp: Tai): Boolean;
  223. { inserts new_one between prev and foll in AsmL }
  224. Procedure InsertLLItem(prev, foll, new_one: TLinkedListItem);
  225. { If P is a Tai object releveant to the optimizer, P is returned
  226. If it is not relevant tot he optimizer, the first object after P
  227. that is relevant is returned }
  228. Function SkipHead(P: Tai): Tai;
  229. { returns true if the operands o1 and o2 are completely equal }
  230. Function OpsEqual(const o1,o2:toper): Boolean;
  231. { Returns the next ait_alloc object with ratype ra_alloc for
  232. Reg is found in the block
  233. of Tai's starting with StartPai and ending with the next "real"
  234. instruction. If none is found, it returns
  235. nil
  236. }
  237. Function FindRegAlloc(Reg: TRegister; StartPai: Tai): tai_regalloc;
  238. { Returns the last ait_alloc object with ratype ra_alloc for
  239. Reg is found in the block
  240. of Tai's starting with StartPai and ending with the next "real"
  241. instruction. If none is found, it returns
  242. nil
  243. }
  244. Function FindRegAllocBackward(Reg : TRegister; StartPai : Tai) : tai_regalloc;
  245. { Returns the next ait_alloc object with ratype ra_dealloc
  246. for Reg which is found in the block of Tai's starting with StartPai
  247. and ending with the next "real" instruction. If none is found, it returns
  248. nil }
  249. Function FindRegDeAlloc(Reg: TRegister; StartPai: Tai): tai_regalloc;
  250. { reg used after p? }
  251. function RegUsedAfterInstruction(reg: Tregister; p: tai; var AllUsedRegs: TAllUsedRegs): Boolean;
  252. { returns true if reg reaches it's end of life at p, this means it is either
  253. reloaded with a new value or it is deallocated afterwards }
  254. function RegEndOfLife(reg: TRegister;p: taicpu): boolean;
  255. { traces sucessive jumps to their final destination and sets it, e.g.
  256. je l1 je l3
  257. <code> <code>
  258. l1: becomes l1:
  259. je l2 je l3
  260. <code> <code>
  261. l2: l2:
  262. jmp l3 jmp l3
  263. the level parameter denotes how deeep we have already followed the jump,
  264. to avoid endless loops with constructs such as "l5: ; jmp l5" }
  265. function GetFinalDestination(hp: taicpu; level: longint): boolean;
  266. function getlabelwithsym(sym: tasmlabel): tai;
  267. { Removes an instruction following hp1 (possibly with reg.deallocations in between),
  268. if its opcode is A_NOP. }
  269. procedure RemoveDelaySlot(hp1: tai);
  270. { peephole optimizer }
  271. procedure PrePeepHoleOpts; virtual;
  272. procedure PeepHoleOptPass1; virtual;
  273. procedure PeepHoleOptPass2; virtual;
  274. procedure PostPeepHoleOpts; virtual;
  275. { processor dependent methods }
  276. // if it returns true, perform a "continue"
  277. function PrePeepHoleOptsCpu(var p: tai): boolean; virtual;
  278. function PeepHoleOptPass1Cpu(var p: tai): boolean; virtual;
  279. function PeepHoleOptPass2Cpu(var p: tai): boolean; virtual;
  280. function PostPeepHoleOptsCpu(var p: tai): boolean; virtual;
  281. End;
  282. Function ArrayRefsEq(const r1, r2: TReference): Boolean;
  283. { ***************************** Implementation **************************** }
  284. Implementation
  285. uses
  286. cutils,
  287. globals,
  288. verbose,
  289. procinfo;
  290. function JumpTargetOp(ai: taicpu): poper; inline;
  291. begin
  292. {$if defined(MIPS)}
  293. { MIPS branches can have 1,2 or 3 operands, target label is the last one. }
  294. result:=ai.oper[ai.ops-1];
  295. {$else MIPS}
  296. result:=ai.oper[0];
  297. {$endif MIPS}
  298. end;
  299. { ************************************************************************* }
  300. { ******************************** TUsedRegs ****************************** }
  301. { ************************************************************************* }
  302. Constructor TUsedRegs.create(aTyp : TRegisterType);
  303. Begin
  304. Typ:=aTyp;
  305. UsedRegs := [];
  306. End;
  307. Constructor TUsedRegs.create_regset(aTyp : TRegisterType;Const _RegSet: TRegSet);
  308. Begin
  309. Typ:=aTyp;
  310. UsedRegs := _RegSet;
  311. End;
  312. {
  313. updates UsedRegs with the RegAlloc Information coming after P
  314. }
  315. Procedure TUsedRegs.Update(p: Tai;IgnoreNewAllocs : Boolean = false);
  316. Begin
  317. { this code is normally not used because updating the register allocation information is done in
  318. TAOptObj.UpdateUsedRegs for speed reasons }
  319. repeat
  320. while assigned(p) and
  321. ((p.typ in (SkipInstr - [ait_RegAlloc])) or
  322. (p.typ = ait_label) or
  323. ((p.typ = ait_marker) and
  324. (tai_Marker(p).Kind in [mark_AsmBlockEnd,mark_NoLineInfoStart,mark_NoLineInfoEnd]))) do
  325. p := tai(p.next);
  326. while assigned(p) and
  327. (p.typ=ait_RegAlloc) Do
  328. begin
  329. if (getregtype(tai_regalloc(p).reg) = typ) then
  330. begin
  331. case tai_regalloc(p).ratype of
  332. ra_alloc :
  333. if not(IgnoreNewAllocs) then
  334. Include(UsedRegs, getsupreg(tai_regalloc(p).reg));
  335. ra_dealloc :
  336. Exclude(UsedRegs, getsupreg(tai_regalloc(p).reg));
  337. end;
  338. end;
  339. p := tai(p.next);
  340. end;
  341. until not(assigned(p)) or
  342. (not(p.typ in SkipInstr) and
  343. not((p.typ = ait_label) and
  344. labelCanBeSkipped(tai_label(p))));
  345. End;
  346. Function TUsedRegs.IsUsed(Reg: TRegister): Boolean;
  347. Begin
  348. IsUsed := (getregtype(Reg)=Typ) and (getsupreg(Reg) in UsedRegs);
  349. End;
  350. Function TUsedRegs.GetUsedRegs: TRegSet;
  351. Begin
  352. GetUsedRegs := UsedRegs;
  353. End;
  354. Destructor TUsedRegs.Destroy;
  355. Begin
  356. inherited destroy;
  357. end;
  358. procedure TUsedRegs.Clear;
  359. begin
  360. UsedRegs := [];
  361. end;
  362. { ************************************************************************* }
  363. { **************************** TPaiProp *********************************** }
  364. { ************************************************************************* }
  365. Constructor TPaiProp.Create;
  366. Begin
  367. {!!!!!!
  368. UsedRegs.Init;
  369. CondRegs.init;
  370. }
  371. { DirFlag: TFlagContents; I386 specific}
  372. End;
  373. Function TPaiProp.RegInSequence(Reg, which: TRegister): Boolean;
  374. {
  375. Var p: Tai;
  376. RegsChecked: TRegSet;
  377. content: TContent;
  378. Counter: Byte;
  379. TmpResult: Boolean;
  380. }
  381. begin
  382. Result:=False; { unimplemented }
  383. (*!!!!!!!!!!1
  384. RegsChecked := [];
  385. content := regs[which];
  386. p := content.StartMod;
  387. TmpResult := False;
  388. Counter := 1;
  389. While Not(TmpResult) And
  390. (Counter <= Content.NrOfMods) Do
  391. Begin
  392. If IsLoadMemReg(p) Then
  393. With PInstr(p)^.oper[LoadSrc]^.ref^ Do
  394. If (Base = ProcInfo.FramePointer)
  395. {$ifdef cpurefshaveindexreg}
  396. And (Index = R_NO)
  397. {$endif cpurefshaveindexreg} Then
  398. Begin
  399. RegsChecked := RegsChecked +
  400. [RegMaxSize(PInstr(p)^.oper[LoadDst]^.reg)];
  401. If Reg = RegMaxSize(PInstr(p)^.oper[LoadDst]^.reg) Then
  402. Break;
  403. End
  404. Else
  405. Begin
  406. If (Base = Reg) And
  407. Not(Base In RegsChecked)
  408. Then TmpResult := True;
  409. {$ifdef cpurefshaveindexreg}
  410. If Not(TmpResult) And
  411. (Index = Reg) And
  412. Not(Index In RegsChecked)
  413. Then TmpResult := True;
  414. {$Endif cpurefshaveindexreg}
  415. End
  416. Else TmpResult := RegInInstruction(Reg, p);
  417. Inc(Counter);
  418. GetNextInstruction(p,p)
  419. End;
  420. RegInSequence := TmpResult
  421. *)
  422. End;
  423. Procedure TPaiProp.DestroyReg(Reg: TRegister; var InstrSinceLastMod:
  424. TInstrSinceLastMod);
  425. { Destroys the contents of the register Reg in the PPaiProp p1, as well as }
  426. { the contents of registers are loaded with a memory location based on Reg }
  427. {
  428. Var TmpWState, TmpRState: Byte;
  429. Counter: TRegister;
  430. }
  431. Begin
  432. {!!!!!!!
  433. Reg := RegMaxSize(Reg);
  434. If (Reg in [LoGPReg..HiGPReg]) Then
  435. For Counter := LoGPReg to HiGPReg Do
  436. With Regs[Counter] Do
  437. If (Counter = reg) Or
  438. ((Typ = Con_Ref) And
  439. RegInSequence(Reg, Counter)) Then
  440. Begin
  441. InstrSinceLastMod[Counter] := 0;
  442. IncWState(Counter);
  443. TmpWState := GetWState(Counter);
  444. TmpRState := GetRState(Counter);
  445. FillChar(Regs[Counter], SizeOf(TContent), 0);
  446. WState := TmpWState;
  447. RState := TmpRState
  448. End
  449. }
  450. End;
  451. Function ArrayRefsEq(const r1, r2: TReference): Boolean;
  452. Begin
  453. Result:=False; { unimplemented }
  454. (*!!!!!!!!!!
  455. ArrayRefsEq := (R1.Offset+R1.OffsetFixup = R2.Offset+R2.OffsetFixup) And
  456. {$ifdef refsHaveSegmentReg}
  457. (R1.Segment = R2.Segment) And
  458. {$endif}
  459. (R1.Base = R2.Base) And
  460. (R1.Symbol=R2.Symbol);
  461. *)
  462. End;
  463. Procedure TPaiProp.DestroyRefs(Const Ref: TReference; WhichReg: TRegister;
  464. var InstrSinceLastMod: TInstrSinceLastMod);
  465. { destroys all registers which possibly contain a reference to Ref, WhichReg }
  466. { is the register whose contents are being written to memory (if this proc }
  467. { is called because of a "mov?? %reg, (mem)" instruction) }
  468. {
  469. Var RefsEq: TRefCompare;
  470. Counter: TRegister;
  471. }
  472. Begin
  473. (*!!!!!!!!!!!
  474. WhichReg := RegMaxSize(WhichReg);
  475. If (Ref.base = procinfo.FramePointer) or
  476. Assigned(Ref.Symbol) Then
  477. Begin
  478. If
  479. {$ifdef cpurefshaveindexreg}
  480. (Ref.Index = R_NO) And
  481. {$endif cpurefshaveindexreg}
  482. (Not(Assigned(Ref.Symbol)) or
  483. (Ref.base = R_NO)) Then
  484. { local variable which is not an array }
  485. RefsEq := @RefsEqual
  486. Else
  487. { local variable which is an array }
  488. RefsEq := @ArrayRefsEq;
  489. {write something to a parameter, a local or global variable, so
  490. * with uncertain optimizations on:
  491. - destroy the contents of registers whose contents have somewhere a
  492. "mov?? (Ref), %reg". WhichReg (this is the register whose contents
  493. are being written to memory) is not destroyed if it's StartMod is
  494. of that form and NrOfMods = 1 (so if it holds ref, but is not a
  495. pointer or value based on Ref)
  496. * with uncertain optimizations off:
  497. - also destroy registers that contain any pointer}
  498. For Counter := LoGPReg to HiGPReg Do
  499. With Regs[Counter] Do
  500. Begin
  501. If (typ = Con_Ref) And
  502. ((Not(cs_opt_size in current_settings.optimizerswitches) And
  503. (NrOfMods <> 1)
  504. ) Or
  505. (RefInSequence(Ref,Regs[Counter], RefsEq) And
  506. ((Counter <> WhichReg) Or
  507. ((NrOfMods <> 1) And
  508. {StarMod is always of the type ait_instruction}
  509. (PInstr(StartMod)^.oper[0].typ = top_ref) And
  510. RefsEq(PInstr(StartMod)^.oper[0].ref^, Ref)
  511. )
  512. )
  513. )
  514. )
  515. Then
  516. DestroyReg(Counter, InstrSinceLastMod)
  517. End
  518. End
  519. Else
  520. {write something to a pointer location, so
  521. * with uncertain optimzations on:
  522. - do not destroy registers which contain a local/global variable or a
  523. parameter, except if DestroyRefs is called because of a "movsl"
  524. * with uncertain optimzations off:
  525. - destroy every register which contains a memory location
  526. }
  527. For Counter := LoGPReg to HiGPReg Do
  528. With Regs[Counter] Do
  529. If (typ = Con_Ref) And
  530. (Not(cs_opt_size in current_settings.optimizerswitches) Or
  531. {$ifdef x86}
  532. {for movsl}
  533. (Ref.Base = R_EDI) Or
  534. {$endif}
  535. {don't destroy if reg contains a parameter, local or global variable}
  536. Not((NrOfMods = 1) And
  537. (PInstr(StartMod)^.oper[0].typ = top_ref) And
  538. ((PInstr(StartMod)^.oper[0].ref^.base = ProcInfo.FramePointer) Or
  539. Assigned(PInstr(StartMod)^.oper[0].ref^.Symbol)
  540. )
  541. )
  542. )
  543. Then DestroyReg(Counter, InstrSinceLastMod)
  544. *)
  545. End;
  546. Procedure TPaiProp.DestroyAllRegs(var InstrSinceLastMod: TInstrSinceLastMod);
  547. {Var Counter: TRegister;}
  548. Begin {initializes/desrtoys all registers}
  549. (*!!!!!!!!!
  550. For Counter := LoGPReg To HiGPReg Do
  551. Begin
  552. ReadReg(Counter);
  553. DestroyReg(Counter, InstrSinceLastMod);
  554. End;
  555. CondRegs.Init;
  556. { FPURegs.Init; }
  557. *)
  558. End;
  559. Procedure TPaiProp.DestroyOp(const o:Toper; var InstrSinceLastMod:
  560. TInstrSinceLastMod);
  561. Begin
  562. {!!!!!!!
  563. Case o.typ Of
  564. top_reg: DestroyReg(o.reg, InstrSinceLastMod);
  565. top_ref:
  566. Begin
  567. ReadRef(o.ref);
  568. DestroyRefs(o.ref^, R_NO, InstrSinceLastMod);
  569. End;
  570. top_symbol:;
  571. End;
  572. }
  573. End;
  574. Procedure TPaiProp.ReadReg(Reg: TRegister);
  575. Begin
  576. {!!!!!!!
  577. Reg := RegMaxSize(Reg);
  578. If Reg in General_Registers Then
  579. IncRState(RegMaxSize(Reg))
  580. }
  581. End;
  582. Procedure TPaiProp.ReadRef(Ref: PReference);
  583. Begin
  584. (*!!!!!!
  585. If Ref^.Base <> R_NO Then
  586. ReadReg(Ref^.Base);
  587. {$ifdef cpurefshaveindexreg}
  588. If Ref^.Index <> R_NO Then
  589. ReadReg(Ref^.Index);
  590. {$endif cpurefshaveindexreg}
  591. *)
  592. End;
  593. Procedure TPaiProp.ReadOp(const o:toper);
  594. Begin
  595. Case o.typ Of
  596. top_reg: ReadReg(o.reg);
  597. top_ref: ReadRef(o.ref);
  598. else
  599. internalerror(200410241);
  600. End;
  601. End;
  602. Procedure TPaiProp.ModifyReg(reg: TRegister; Var InstrSinceLastMod:
  603. TInstrSinceLastMod);
  604. Begin
  605. (*!!!!!!!
  606. With Regs[reg] Do
  607. If (Typ = Con_Ref)
  608. Then
  609. Begin
  610. IncState(WState);
  611. {also store how many instructions are part of the sequence in the first
  612. instructions PPaiProp, so it can be easily accessed from within
  613. CheckSequence}
  614. Inc(NrOfMods, InstrSinceLastMod[Reg]);
  615. PPaiProp(StartMod.OptInfo)^.Regs[Reg].NrOfMods := NrOfMods;
  616. InstrSinceLastMod[Reg] := 0;
  617. End
  618. Else
  619. DestroyReg(Reg, InstrSinceLastMod);
  620. *)
  621. End;
  622. Procedure TPaiProp.ModifyOp(const oper: TOper; var InstrSinceLastMod:
  623. TInstrSinceLastMod);
  624. Begin
  625. If oper.typ = top_reg Then
  626. ModifyReg(RegMaxSize(oper.reg),InstrSinceLastMod)
  627. Else
  628. Begin
  629. ReadOp(oper);
  630. DestroyOp(oper, InstrSinceLastMod);
  631. End
  632. End;
  633. Procedure TPaiProp.IncWState(Reg: TRegister);{$ifdef inl} inline;{$endif inl}
  634. Begin
  635. //!!!! IncState(Regs[Reg].WState);
  636. End;
  637. Procedure TPaiProp.IncRState(Reg: TRegister);{$ifdef inl} inline;{$endif inl}
  638. Begin
  639. //!!!! IncState(Regs[Reg].RState);
  640. End;
  641. Function TPaiProp.GetWState(Reg: TRegister): TStateInt; {$ifdef inl} inline;{$endif inl}
  642. Begin
  643. Result:=0; { unimplemented }
  644. //!!!! GetWState := Regs[Reg].WState
  645. End;
  646. Function TPaiProp.GetRState(Reg: TRegister): TStateInt; {$ifdef inl} inline;{$endif inl}
  647. Begin
  648. Result:=0; { unimplemented }
  649. //!!!! GetRState := Regs[Reg].RState
  650. End;
  651. Function TPaiProp.GetRegContentType(Reg: TRegister): Byte; {$ifdef inl} inline;{$endif inl}
  652. Begin
  653. Result:=0; { unimplemented }
  654. //!!!! GetRegContentType := Regs[Reg].typ
  655. End;
  656. Destructor TPaiProp.Done;
  657. Begin
  658. //!!!! UsedRegs.Done;
  659. //!!!! CondRegs.Done;
  660. { DirFlag: TFlagContents; I386 specific}
  661. End;
  662. { ************************ private TPaiProp stuff ************************* }
  663. Procedure TPaiProp.IncState(Var s: TStateInt); {$ifdef inl} inline;{$endif inl}
  664. Begin
  665. If s <> High(TStateInt) Then Inc(s)
  666. Else s := 0
  667. End;
  668. Function TPaiProp.RefInInstruction(Const Ref: TReference; p: Tai;
  669. RefsEq: TRefCompare): Boolean;
  670. Var Count: AWord;
  671. TmpResult: Boolean;
  672. Begin
  673. TmpResult := False;
  674. If (p.typ = ait_instruction) Then
  675. Begin
  676. Count := 0;
  677. Repeat
  678. If (TInstr(p).oper[Count]^.typ = Top_Ref) Then
  679. TmpResult := RefsEq(Ref, PInstr(p)^.oper[Count]^.ref^);
  680. Inc(Count);
  681. Until (Count = MaxOps) or TmpResult;
  682. End;
  683. RefInInstruction := TmpResult;
  684. End;
  685. Function TPaiProp.RefInSequence(Const Ref: TReference; Content: TContent;
  686. RefsEq: TRefCompare): Boolean;
  687. Var p: Tai;
  688. Counter: Byte;
  689. TmpResult: Boolean;
  690. Begin
  691. p := Content.StartMod;
  692. TmpResult := False;
  693. Counter := 1;
  694. While Not(TmpResult) And
  695. (Counter <= Content.NrOfMods) Do
  696. Begin
  697. If (p.typ = ait_instruction) And
  698. RefInInstruction(Ref, p, @references_equal)
  699. Then TmpResult := True;
  700. Inc(Counter);
  701. GetNextInstruction(p,p)
  702. End;
  703. RefInSequence := TmpResult
  704. End;
  705. { ************************************************************************* }
  706. { ***************************** TAoptObj ********************************** }
  707. { ************************************************************************* }
  708. Constructor TAoptObj.create(_AsmL: TAsmList; _BlockStart, _BlockEnd: Tai;
  709. _LabelInfo: PLabelInfo);
  710. Begin
  711. AsmL := _AsmL;
  712. BlockStart := _BlockStart;
  713. BlockEnd := _BlockEnd;
  714. LabelInfo := _LabelInfo;
  715. CreateUsedRegs(UsedRegs);
  716. End;
  717. destructor TAOptObj.Destroy;
  718. var
  719. i : TRegisterType;
  720. begin
  721. for i:=low(TRegisterType) to high(TRegisterType) do
  722. UsedRegs[i].Destroy;
  723. inherited Destroy;
  724. end;
  725. procedure TAOptObj.CreateUsedRegs(var regs: TAllUsedRegs);
  726. var
  727. i : TRegisterType;
  728. begin
  729. for i:=low(TRegisterType) to high(TRegisterType) do
  730. Regs[i]:=TUsedRegs.Create(i);
  731. end;
  732. procedure TAOptObj.ClearUsedRegs;
  733. var
  734. i : TRegisterType;
  735. begin
  736. for i:=low(TRegisterType) to high(TRegisterType) do
  737. UsedRegs[i].Clear;
  738. end;
  739. procedure TAOptObj.UpdateUsedRegs(p : Tai);
  740. begin
  741. { this code is based on TUsedRegs.Update to avoid multiple passes through the asmlist,
  742. the code is duplicated here }
  743. repeat
  744. while assigned(p) and
  745. ((p.typ in (SkipInstr - [ait_RegAlloc])) or
  746. ((p.typ = ait_label) and
  747. labelCanBeSkipped(tai_label(p))) or
  748. ((p.typ = ait_marker) and
  749. (tai_Marker(p).Kind in [mark_AsmBlockEnd,mark_NoLineInfoStart,mark_NoLineInfoEnd]))) do
  750. p := tai(p.next);
  751. while assigned(p) and
  752. (p.typ=ait_RegAlloc) Do
  753. begin
  754. case tai_regalloc(p).ratype of
  755. ra_alloc :
  756. Include(UsedRegs[getregtype(tai_regalloc(p).reg)].UsedRegs, getsupreg(tai_regalloc(p).reg));
  757. ra_dealloc :
  758. Exclude(UsedRegs[getregtype(tai_regalloc(p).reg)].UsedRegs, getsupreg(tai_regalloc(p).reg));
  759. end;
  760. p := tai(p.next);
  761. end;
  762. until not(assigned(p)) or
  763. (not(p.typ in SkipInstr) and
  764. not((p.typ = ait_label) and
  765. labelCanBeSkipped(tai_label(p))));
  766. end;
  767. class procedure TAOptObj.UpdateUsedRegs(var Regs : TAllUsedRegs;p : Tai);
  768. var
  769. i : TRegisterType;
  770. begin
  771. for i:=low(TRegisterType) to high(TRegisterType) do
  772. Regs[i].Update(p);
  773. end;
  774. function TAOptObj.CopyUsedRegs(var dest: TAllUsedRegs): boolean;
  775. var
  776. i : TRegisterType;
  777. begin
  778. Result:=true;
  779. for i:=low(TRegisterType) to high(TRegisterType) do
  780. dest[i]:=TUsedRegs.Create_Regset(i,UsedRegs[i].GetUsedRegs);
  781. end;
  782. class procedure TAOptObj.ReleaseUsedRegs(const regs: TAllUsedRegs);
  783. var
  784. i : TRegisterType;
  785. begin
  786. for i:=low(TRegisterType) to high(TRegisterType) do
  787. regs[i].Free;
  788. end;
  789. class Function TAOptObj.RegInUsedRegs(reg : TRegister;regs : TAllUsedRegs) : boolean;
  790. begin
  791. result:=regs[getregtype(reg)].IsUsed(reg);
  792. end;
  793. class procedure TAOptObj.IncludeRegInUsedRegs(reg: TRegister;
  794. var regs: TAllUsedRegs);
  795. begin
  796. include(regs[getregtype(reg)].UsedRegs,getsupreg(Reg));
  797. end;
  798. class procedure TAOptObj.ExcludeRegFromUsedRegs(reg: TRegister;
  799. var regs: TAllUsedRegs);
  800. begin
  801. exclude(regs[getregtype(reg)].UsedRegs,getsupreg(Reg));
  802. end;
  803. function TAOptObj.GetAllocationString(const regs: TAllUsedRegs): string;
  804. var
  805. i : TRegisterType;
  806. j : TSuperRegister;
  807. begin
  808. Result:='';
  809. for i:=low(TRegisterType) to high(TRegisterType) do
  810. for j in regs[i].UsedRegs do
  811. Result:=Result+std_regname(newreg(i,j,R_SUBWHOLE))+' ';
  812. end;
  813. Function TAOptObj.FindLabel(L: TasmLabel; Var hp: Tai): Boolean;
  814. Var TempP: Tai;
  815. Begin
  816. TempP := hp;
  817. While Assigned(TempP) and
  818. (TempP.typ In SkipInstr + [ait_label,ait_align]) Do
  819. If (TempP.typ <> ait_Label) Or
  820. (Tai_label(TempP).labsym <> L)
  821. Then GetNextInstruction(TempP, TempP)
  822. Else
  823. Begin
  824. hp := TempP;
  825. FindLabel := True;
  826. exit
  827. End;
  828. FindLabel := False;
  829. End;
  830. Procedure TAOptObj.InsertLLItem(prev, foll, new_one : TLinkedListItem);
  831. Begin
  832. If Assigned(prev) Then
  833. If Assigned(foll) Then
  834. Begin
  835. If Assigned(new_one) Then
  836. Begin
  837. new_one.previous := prev;
  838. new_one.next := foll;
  839. prev.next := new_one;
  840. foll.previous := new_one;
  841. { should we update line information? }
  842. if (not (tai(new_one).typ in SkipLineInfo)) and
  843. (not (tai(foll).typ in SkipLineInfo)) then
  844. Tailineinfo(new_one).fileinfo := Tailineinfo(foll).fileinfo
  845. End
  846. End
  847. Else AsmL.Concat(new_one)
  848. Else If Assigned(Foll) Then AsmL.Insert(new_one)
  849. End;
  850. Function TAOptObj.SkipHead(P: Tai): Tai;
  851. Var OldP: Tai;
  852. Begin
  853. Repeat
  854. OldP := P;
  855. If (P.typ in SkipInstr) Or
  856. ((P.typ = ait_marker) And
  857. (Tai_Marker(P).Kind = mark_AsmBlockEnd)) Then
  858. GetNextInstruction(P, P)
  859. Else If ((P.Typ = Ait_Marker) And
  860. (Tai_Marker(P).Kind = mark_NoPropInfoStart)) Then
  861. { a marker of the type mark_NoPropInfoStart can't be the first instruction of a }
  862. { paasmoutput list }
  863. GetNextInstruction(Tai(P.Previous),P);
  864. If (P.Typ = Ait_Marker) And
  865. (Tai_Marker(P).Kind = mark_AsmBlockStart) Then
  866. Begin
  867. P := Tai(P.Next);
  868. While (P.typ <> Ait_Marker) Or
  869. (Tai_Marker(P).Kind <> mark_AsmBlockEnd) Do
  870. P := Tai(P.Next)
  871. End;
  872. Until P = OldP;
  873. SkipHead := P;
  874. End;
  875. Function TAOptObj.OpsEqual(const o1,o2:toper): Boolean;
  876. Begin
  877. if o1.typ=o2.typ then
  878. Case o1.typ Of
  879. Top_Reg :
  880. OpsEqual:=o1.reg=o2.reg;
  881. Top_Ref :
  882. OpsEqual := references_equal(o1.ref^, o2.ref^);
  883. Top_Const :
  884. OpsEqual:=o1.val=o2.val;
  885. Top_None :
  886. OpsEqual := True
  887. else OpsEqual := False
  888. End
  889. else
  890. OpsEqual := False;
  891. End;
  892. Function TAOptObj.FindRegAlloc(Reg: TRegister; StartPai: Tai): tai_regalloc;
  893. Begin
  894. Result:=nil;
  895. Repeat
  896. While Assigned(StartPai) And
  897. ((StartPai.typ in (SkipInstr - [ait_regAlloc])) Or
  898. {$if defined(MIPS) or defined(SPARC)}
  899. ((startpai.typ=ait_instruction) and (taicpu(startpai).opcode=A_NOP)) or
  900. {$endif MIPS or SPARC}
  901. ((StartPai.typ = ait_label) and
  902. Not(Tai_Label(StartPai).labsym.Is_Used))) Do
  903. StartPai := Tai(StartPai.Next);
  904. If Assigned(StartPai) And
  905. (StartPai.typ = ait_regAlloc) Then
  906. Begin
  907. if (tai_regalloc(StartPai).ratype=ra_alloc) and
  908. (getregtype(tai_regalloc(StartPai).Reg) = getregtype(Reg)) and
  909. (getsupreg(tai_regalloc(StartPai).Reg) = getsupreg(Reg)) then
  910. begin
  911. Result:=tai_regalloc(StartPai);
  912. exit;
  913. end;
  914. StartPai := Tai(StartPai.Next);
  915. End
  916. else
  917. exit;
  918. Until false;
  919. End;
  920. Function TAOptObj.FindRegAllocBackward(Reg: TRegister; StartPai: Tai): tai_regalloc;
  921. Begin
  922. Result:=nil;
  923. Repeat
  924. While Assigned(StartPai) And
  925. ((StartPai.typ in (SkipInstr - [ait_regAlloc])) Or
  926. ((StartPai.typ = ait_label) and
  927. Not(Tai_Label(StartPai).labsym.Is_Used))) Do
  928. StartPai := Tai(StartPai.Previous);
  929. If Assigned(StartPai) And
  930. (StartPai.typ = ait_regAlloc) Then
  931. Begin
  932. if (tai_regalloc(StartPai).ratype=ra_alloc) and
  933. SuperRegistersEqual(tai_regalloc(StartPai).Reg,Reg) then
  934. begin
  935. Result:=tai_regalloc(StartPai);
  936. exit;
  937. end;
  938. StartPai := Tai(StartPai.Previous);
  939. End
  940. else
  941. exit;
  942. Until false;
  943. End;
  944. function TAOptObj.FindRegDeAlloc(Reg: TRegister; StartPai: Tai): tai_regalloc;
  945. Begin
  946. Result:=nil;
  947. Repeat
  948. While Assigned(StartPai) And
  949. ((StartPai.typ in (SkipInstr - [ait_regAlloc])) Or
  950. ((StartPai.typ = ait_label) and
  951. Not(Tai_Label(StartPai).labsym.Is_Used))) Do
  952. StartPai := Tai(StartPai.Next);
  953. If Assigned(StartPai) And
  954. (StartPai.typ = ait_regAlloc) Then
  955. Begin
  956. if (tai_regalloc(StartPai).ratype=ra_dealloc) and
  957. (getregtype(tai_regalloc(StartPai).Reg) = getregtype(Reg)) and
  958. (getsupreg(tai_regalloc(StartPai).Reg) = getsupreg(Reg)) then
  959. begin
  960. Result:=tai_regalloc(StartPai);
  961. exit;
  962. end;
  963. StartPai := Tai(StartPai.Next);
  964. End
  965. else
  966. exit;
  967. Until false;
  968. End;
  969. function TAOptObj.RegUsedAfterInstruction(reg: Tregister; p: tai;var AllUsedRegs: TAllUsedRegs): Boolean;
  970. begin
  971. AllUsedRegs[getregtype(reg)].Update(tai(p.Next),true);
  972. RegUsedAfterInstruction :=
  973. AllUsedRegs[getregtype(reg)].IsUsed(reg) and
  974. not(regLoadedWithNewValue(reg,p)) and
  975. (
  976. not(GetNextInstruction(p,p)) or
  977. InstructionLoadsFromReg(reg,p) or
  978. not(regLoadedWithNewValue(reg,p))
  979. );
  980. end;
  981. function TAOptObj.RegEndOfLife(reg : TRegister;p : taicpu) : boolean;
  982. begin
  983. Result:=assigned(FindRegDealloc(reg,tai(p.Next))) or
  984. RegLoadedWithNewValue(reg,p);
  985. end;
  986. function SkipLabels(hp: tai; var hp2: tai): boolean;
  987. {skips all labels and returns the next "real" instruction}
  988. begin
  989. while assigned(hp.next) and
  990. (tai(hp.next).typ in SkipInstr + [ait_label,ait_align]) Do
  991. hp := tai(hp.next);
  992. if assigned(hp.next) then
  993. begin
  994. SkipLabels := True;
  995. hp2 := tai(hp.next)
  996. end
  997. else
  998. begin
  999. hp2 := hp;
  1000. SkipLabels := False
  1001. end;
  1002. end;
  1003. function FindAnyLabel(hp: tai; var l: tasmlabel): Boolean;
  1004. begin
  1005. FindAnyLabel := false;
  1006. while assigned(hp.next) and
  1007. (tai(hp.next).typ in (SkipInstr+[ait_align])) Do
  1008. hp := tai(hp.next);
  1009. if assigned(hp.next) and
  1010. (tai(hp.next).typ = ait_label) then
  1011. begin
  1012. FindAnyLabel := true;
  1013. l := tai_label(hp.next).labsym;
  1014. end
  1015. end;
  1016. {$push}
  1017. {$r-}
  1018. function TAOptObj.getlabelwithsym(sym: tasmlabel): tai;
  1019. begin
  1020. if (int64(sym.labelnr) >= int64(labelinfo^.lowlabel)) and
  1021. (int64(sym.labelnr) <= int64(labelinfo^.highlabel)) then { range check, a jump can go past an assembler block! }
  1022. getlabelwithsym := labelinfo^.labeltable^[sym.labelnr-labelinfo^.lowlabel].paiobj
  1023. else
  1024. getlabelwithsym := nil;
  1025. end;
  1026. {$pop}
  1027. { Returns True if hp is an unconditional jump to a label }
  1028. function IsJumpToLabelUncond(hp: taicpu): boolean;
  1029. begin
  1030. {$if defined(avr)}
  1031. result:=(hp.opcode in aopt_uncondjmp) and
  1032. {$else avr}
  1033. result:=(hp.opcode=aopt_uncondjmp) and
  1034. {$endif avr}
  1035. {$if defined(arm) or defined(aarch64)}
  1036. (hp.condition=c_None) and
  1037. {$endif arm or aarch64}
  1038. (hp.ops>0) and
  1039. (JumpTargetOp(hp)^.typ = top_ref) and
  1040. (JumpTargetOp(hp)^.ref^.symbol is TAsmLabel);
  1041. end;
  1042. { Returns True if hp is any jump to a label }
  1043. function IsJumpToLabel(hp: taicpu): boolean;
  1044. begin
  1045. result:=hp.is_jmp and
  1046. (hp.ops>0) and
  1047. (JumpTargetOp(hp)^.typ = top_ref) and
  1048. (JumpTargetOp(hp)^.ref^.symbol is TAsmLabel);
  1049. end;
  1050. procedure TAOptObj.RemoveDelaySlot(hp1:tai);
  1051. var
  1052. hp2: tai;
  1053. begin
  1054. hp2:=tai(hp1.next);
  1055. while assigned(hp2) and (hp2.typ in SkipInstr) do
  1056. hp2:=tai(hp2.next);
  1057. if assigned(hp2) and (hp2.typ=ait_instruction) and
  1058. (taicpu(hp2).opcode=A_NOP) then
  1059. begin
  1060. asml.remove(hp2);
  1061. hp2.free;
  1062. end;
  1063. { Anything except A_NOP must be left in place: these instructions
  1064. execute before branch, so code stays correct if branch is removed. }
  1065. end;
  1066. function TAOptObj.GetFinalDestination(hp: taicpu; level: longint): boolean;
  1067. {traces sucessive jumps to their final destination and sets it, e.g.
  1068. je l1 je l3
  1069. <code> <code>
  1070. l1: becomes l1:
  1071. je l2 je l3
  1072. <code> <code>
  1073. l2: l2:
  1074. jmp l3 jmp l3
  1075. the level parameter denotes how deeep we have already followed the jump,
  1076. to avoid endless loops with constructs such as "l5: ; jmp l5" }
  1077. var p1: tai;
  1078. {$if not defined(MIPS) and not defined(JVM)}
  1079. p2: tai;
  1080. l: tasmlabel;
  1081. {$endif}
  1082. begin
  1083. GetfinalDestination := false;
  1084. if level > 20 then
  1085. exit;
  1086. p1 := getlabelwithsym(tasmlabel(JumpTargetOp(hp)^.ref^.symbol));
  1087. if assigned(p1) then
  1088. begin
  1089. SkipLabels(p1,p1);
  1090. if (tai(p1).typ = ait_instruction) and
  1091. (taicpu(p1).is_jmp) then
  1092. if { the next instruction after the label where the jump hp arrives}
  1093. { is unconditional or of the same type as hp, so continue }
  1094. IsJumpToLabelUncond(taicpu(p1))
  1095. {$if not defined(MIPS) and not defined(JVM)}
  1096. { for MIPS, it isn't enough to check the condition; first operands must be same, too. }
  1097. or
  1098. conditions_equal(taicpu(p1).condition,hp.condition) or
  1099. { the next instruction after the label where the jump hp arrives
  1100. is the opposite of hp (so this one is never taken), but after
  1101. that one there is a branch that will be taken, so perform a
  1102. little hack: set p1 equal to this instruction (that's what the
  1103. last SkipLabels is for, only works with short bool evaluation)}
  1104. (conditions_equal(taicpu(p1).condition,inverse_cond(hp.condition)) and
  1105. SkipLabels(p1,p2) and
  1106. (p2.typ = ait_instruction) and
  1107. (taicpu(p2).is_jmp) and
  1108. (IsJumpToLabelUncond(taicpu(p2)) or
  1109. (conditions_equal(taicpu(p2).condition,hp.condition))) and
  1110. SkipLabels(p1,p1))
  1111. {$endif not MIPS and not JVM}
  1112. then
  1113. begin
  1114. { quick check for loops of the form "l5: ; jmp l5 }
  1115. if (tasmlabel(JumpTargetOp(taicpu(p1))^.ref^.symbol).labelnr =
  1116. tasmlabel(JumpTargetOp(hp)^.ref^.symbol).labelnr) then
  1117. exit;
  1118. if not GetFinalDestination(taicpu(p1),succ(level)) then
  1119. exit;
  1120. {$if defined(aarch64)}
  1121. { can't have conditional branches to
  1122. global labels on AArch64, because the
  1123. offset may become too big }
  1124. if not(taicpu(hp).condition in [C_None,C_AL,C_NV]) and
  1125. (tasmlabel(JumpTargetOp(taicpu(p1))^.ref^.symbol).bind<>AB_LOCAL) then
  1126. exit;
  1127. {$endif aarch64}
  1128. tasmlabel(JumpTargetOp(hp)^.ref^.symbol).decrefs;
  1129. JumpTargetOp(hp)^.ref^.symbol:=JumpTargetOp(taicpu(p1))^.ref^.symbol;
  1130. tasmlabel(JumpTargetOp(hp)^.ref^.symbol).increfs;
  1131. end
  1132. {$if not defined(MIPS) and not defined(JVM)}
  1133. else
  1134. if conditions_equal(taicpu(p1).condition,inverse_cond(hp.condition)) then
  1135. if not FindAnyLabel(p1,l) then
  1136. begin
  1137. {$ifdef finaldestdebug}
  1138. insertllitem(asml,p1,p1.next,tai_comment.Create(
  1139. strpnew('previous label inserted'))));
  1140. {$endif finaldestdebug}
  1141. current_asmdata.getjumplabel(l);
  1142. insertllitem(p1,p1.next,tai_label.Create(l));
  1143. tasmlabel(JumpTargetOp(hp)^.ref^.symbol).decrefs;
  1144. JumpTargetOp(hp)^.ref^.symbol := l;
  1145. l.increfs;
  1146. { this won't work, since the new label isn't in the labeltable }
  1147. { so it will fail the rangecheck. Labeltable should become a }
  1148. { hashtable to support this: }
  1149. { GetFinalDestination(asml, hp); }
  1150. end
  1151. else
  1152. begin
  1153. {$ifdef finaldestdebug}
  1154. insertllitem(asml,p1,p1.next,tai_comment.Create(
  1155. strpnew('next label reused'))));
  1156. {$endif finaldestdebug}
  1157. l.increfs;
  1158. tasmlabel(JumpTargetOp(hp)^.ref^.symbol).decrefs;
  1159. JumpTargetOp(hp)^.ref^.symbol := l;
  1160. if not GetFinalDestination(hp,succ(level)) then
  1161. exit;
  1162. end;
  1163. {$endif not MIPS and not JVM}
  1164. end;
  1165. GetFinalDestination := true;
  1166. end;
  1167. procedure TAOptObj.PrePeepHoleOpts;
  1168. var
  1169. p: tai;
  1170. begin
  1171. p := BlockStart;
  1172. ClearUsedRegs;
  1173. while (p <> BlockEnd) Do
  1174. begin
  1175. UpdateUsedRegs(tai(p.next));
  1176. if PrePeepHoleOptsCpu(p) then
  1177. continue;
  1178. UpdateUsedRegs(p);
  1179. p:=tai(p.next);
  1180. end;
  1181. end;
  1182. procedure TAOptObj.PeepHoleOptPass1;
  1183. var
  1184. p,hp1,hp2 : tai;
  1185. stoploop:boolean;
  1186. begin
  1187. repeat
  1188. stoploop:=true;
  1189. p := BlockStart;
  1190. ClearUsedRegs;
  1191. while (p <> BlockEnd) Do
  1192. begin
  1193. { I'am not sure why this is done, UsedRegs should reflect the register usage before the instruction
  1194. If an instruction needs the information of this, it can easily create a TempUsedRegs (FK)
  1195. UpdateUsedRegs(tai(p.next));
  1196. }
  1197. {$ifdef DEBUG_OPTALLOC}
  1198. if p.Typ=ait_instruction then
  1199. InsertLLItem(tai(p.Previous),p,tai_comment.create(strpnew(GetAllocationString(UsedRegs))));
  1200. {$endif DEBUG_OPTALLOC}
  1201. if PeepHoleOptPass1Cpu(p) then
  1202. begin
  1203. stoploop:=false;
  1204. UpdateUsedRegs(p);
  1205. continue;
  1206. end;
  1207. case p.Typ Of
  1208. ait_instruction:
  1209. begin
  1210. { Handle Jmp Optimizations }
  1211. if taicpu(p).is_jmp then
  1212. begin
  1213. { the following if-block removes all code between a jmp and the next label,
  1214. because it can never be executed
  1215. }
  1216. if IsJumpToLabelUncond(taicpu(p)) then
  1217. begin
  1218. hp2:=p;
  1219. while GetNextInstruction(hp2, hp1) and
  1220. (hp1.typ <> ait_label)
  1221. {$ifdef JVM}
  1222. and (hp1.typ <> ait_jcatch)
  1223. {$endif}
  1224. do
  1225. if not(hp1.typ in ([ait_label,ait_align]+skipinstr)) then
  1226. begin
  1227. if (hp1.typ = ait_instruction) and
  1228. taicpu(hp1).is_jmp and
  1229. (JumpTargetOp(taicpu(hp1))^.typ = top_ref) and
  1230. (JumpTargetOp(taicpu(hp1))^.ref^.symbol is TAsmLabel) then
  1231. TAsmLabel(JumpTargetOp(taicpu(hp1))^.ref^.symbol).decrefs;
  1232. { don't kill start/end of assembler block,
  1233. no-line-info-start/end etc }
  1234. if hp1.typ<>ait_marker then
  1235. begin
  1236. {$if defined(SPARC) or defined(MIPS) }
  1237. if (hp1.typ=ait_instruction) and (taicpu(hp1).is_jmp) then
  1238. RemoveDelaySlot(hp1);
  1239. {$endif SPARC or MIPS }
  1240. asml.remove(hp1);
  1241. hp1.free;
  1242. stoploop:=false;
  1243. end
  1244. else
  1245. hp2:=hp1;
  1246. end
  1247. else break;
  1248. end;
  1249. if GetNextInstruction(p, hp1) then
  1250. begin
  1251. SkipEntryExitMarker(hp1,hp1);
  1252. { remove unconditional jumps to a label coming right after them }
  1253. if IsJumpToLabelUncond(taicpu(p)) and
  1254. FindLabel(tasmlabel(JumpTargetOp(taicpu(p))^.ref^.symbol), hp1) and
  1255. { TODO: FIXME removing the first instruction fails}
  1256. (p<>blockstart) then
  1257. begin
  1258. tasmlabel(JumpTargetOp(taicpu(p))^.ref^.symbol).decrefs;
  1259. {$if defined(SPARC) or defined(MIPS)}
  1260. RemoveDelaySlot(p);
  1261. {$endif SPARC or MIPS}
  1262. hp2:=tai(hp1.next);
  1263. asml.remove(p);
  1264. p.free;
  1265. p:=hp2;
  1266. stoploop:=false;
  1267. continue;
  1268. end
  1269. else if assigned(hp1) then
  1270. begin
  1271. { change the following jumps:
  1272. jmp<cond> lab_1 jmp<cond_inverted> lab_2
  1273. jmp lab_2 >>> <code>
  1274. lab_1: lab_2:
  1275. <code>
  1276. lab_2:
  1277. }
  1278. if hp1.typ = ait_label then
  1279. SkipLabels(hp1,hp1);
  1280. if (tai(hp1).typ=ait_instruction) and
  1281. IsJumpToLabelUncond(taicpu(hp1)) and
  1282. GetNextInstruction(hp1, hp2) and
  1283. IsJumpToLabel(taicpu(p)) and
  1284. FindLabel(tasmlabel(JumpTargetOp(taicpu(p))^.ref^.symbol), hp2) then
  1285. begin
  1286. if (taicpu(p).opcode=aopt_condjmp)
  1287. {$if defined(arm) or defined(aarch64)}
  1288. and (taicpu(p).condition<>C_None)
  1289. {$endif arm or aarch64}
  1290. {$if defined(aarch64)}
  1291. { can't have conditional branches to
  1292. global labels on AArch64, because the
  1293. offset may become too big }
  1294. and (tasmlabel(JumpTargetOp(taicpu(hp1))^.ref^.symbol).bind=AB_LOCAL)
  1295. {$endif aarch64}
  1296. then
  1297. begin
  1298. taicpu(p).condition:=inverse_cond(taicpu(p).condition);
  1299. tai_label(hp2).labsym.decrefs;
  1300. JumpTargetOp(taicpu(p))^.ref^.symbol:=JumpTargetOp(taicpu(hp1))^.ref^.symbol;
  1301. { when freeing hp1, the reference count
  1302. isn't decreased, so don't increase
  1303. taicpu(p).oper[0]^.ref^.symbol.increfs;
  1304. }
  1305. {$if defined(SPARC) or defined(MIPS)}
  1306. RemoveDelaySlot(hp1);
  1307. {$endif SPARC or MIPS}
  1308. asml.remove(hp1);
  1309. hp1.free;
  1310. stoploop:=false;
  1311. GetFinalDestination(taicpu(p),0);
  1312. end
  1313. else
  1314. begin
  1315. GetFinalDestination(taicpu(p),0);
  1316. p:=tai(p.next);
  1317. continue;
  1318. end;
  1319. end
  1320. else if IsJumpToLabel(taicpu(p)) then
  1321. GetFinalDestination(taicpu(p),0);
  1322. end;
  1323. end;
  1324. end
  1325. else
  1326. { All other optimizes }
  1327. begin
  1328. end; { if is_jmp }
  1329. end;
  1330. end;
  1331. UpdateUsedRegs(p);
  1332. p:=tai(p.next);
  1333. end;
  1334. until stoploop or not(cs_opt_level3 in current_settings.optimizerswitches);
  1335. end;
  1336. procedure TAOptObj.PeepHoleOptPass2;
  1337. var
  1338. p: tai;
  1339. begin
  1340. p := BlockStart;
  1341. ClearUsedRegs;
  1342. while (p <> BlockEnd) Do
  1343. begin
  1344. UpdateUsedRegs(tai(p.next));
  1345. if PeepHoleOptPass2Cpu(p) then
  1346. continue;
  1347. UpdateUsedRegs(p);
  1348. p:=tai(p.next);
  1349. end;
  1350. end;
  1351. procedure TAOptObj.PostPeepHoleOpts;
  1352. var
  1353. p: tai;
  1354. begin
  1355. p := BlockStart;
  1356. ClearUsedRegs;
  1357. while (p <> BlockEnd) Do
  1358. begin
  1359. UpdateUsedRegs(tai(p.next));
  1360. if PostPeepHoleOptsCpu(p) then
  1361. continue;
  1362. UpdateUsedRegs(p);
  1363. p:=tai(p.next);
  1364. end;
  1365. end;
  1366. function TAOptObj.PrePeepHoleOptsCpu(var p : tai) : boolean;
  1367. begin
  1368. result := false;
  1369. end;
  1370. function TAOptObj.PeepHoleOptPass1Cpu(var p: tai): boolean;
  1371. begin
  1372. result := false;
  1373. end;
  1374. function TAOptObj.PeepHoleOptPass2Cpu(var p : tai) : boolean;
  1375. begin
  1376. result := false;
  1377. end;
  1378. function TAOptObj.PostPeepHoleOptsCpu(var p: tai): boolean;
  1379. begin
  1380. result := false;
  1381. end;
  1382. End.