aoptobj.pas 57 KB

123456789101112131415161718192021222324252627282930313233343536373839404142434445464748495051525354555657585960616263646566676869707172737475767778798081828384858687888990919293949596979899100101102103104105106107108109110111112113114115116117118119120121122123124125126127128129130131132133134135136137138139140141142143144145146147148149150151152153154155156157158159160161162163164165166167168169170171172173174175176177178179180181182183184185186187188189190191192193194195196197198199200201202203204205206207208209210211212213214215216217218219220221222223224225226227228229230231232233234235236237238239240241242243244245246247248249250251252253254255256257258259260261262263264265266267268269270271272273274275276277278279280281282283284285286287288289290291292293294295296297298299300301302303304305306307308309310311312313314315316317318319320321322323324325326327328329330331332333334335336337338339340341342343344345346347348349350351352353354355356357358359360361362363364365366367368369370371372373374375376377378379380381382383384385386387388389390391392393394395396397398399400401402403404405406407408409410411412413414415416417418419420421422423424425426427428429430431432433434435436437438439440441442443444445446447448449450451452453454455456457458459460461462463464465466467468469470471472473474475476477478479480481482483484485486487488489490491492493494495496497498499500501502503504505506507508509510511512513514515516517518519520521522523524525526527528529530531532533534535536537538539540541542543544545546547548549550551552553554555556557558559560561562563564565566567568569570571572573574575576577578579580581582583584585586587588589590591592593594595596597598599600601602603604605606607608609610611612613614615616617618619620621622623624625626627628629630631632633634635636637638639640641642643644645646647648649650651652653654655656657658659660661662663664665666667668669670671672673674675676677678679680681682683684685686687688689690691692693694695696697698699700701702703704705706707708709710711712713714715716717718719720721722723724725726727728729730731732733734735736737738739740741742743744745746747748749750751752753754755756757758759760761762763764765766767768769770771772773774775776777778779780781782783784785786787788789790791792793794795796797798799800801802803804805806807808809810811812813814815816817818819820821822823824825826827828829830831832833834835836837838839840841842843844845846847848849850851852853854855856857858859860861862863864865866867868869870871872873874875876877878879880881882883884885886887888889890891892893894895896897898899900901902903904905906907908909910911912913914915916917918919920921922923924925926927928929930931932933934935936937938939940941942943944945946947948949950951952953954955956957958959960961962963964965966967968969970971972973974975976977978979980981982983984985986987988989990991992993994995996997998999100010011002100310041005100610071008100910101011101210131014101510161017101810191020102110221023102410251026102710281029103010311032103310341035103610371038103910401041104210431044104510461047104810491050105110521053105410551056105710581059106010611062106310641065106610671068106910701071107210731074107510761077107810791080108110821083108410851086108710881089109010911092109310941095109610971098109911001101110211031104110511061107110811091110111111121113111411151116111711181119112011211122112311241125112611271128112911301131113211331134113511361137113811391140114111421143114411451146114711481149115011511152115311541155115611571158115911601161116211631164116511661167116811691170117111721173117411751176117711781179118011811182118311841185118611871188118911901191119211931194119511961197119811991200120112021203120412051206120712081209121012111212121312141215121612171218121912201221122212231224122512261227122812291230123112321233123412351236123712381239124012411242124312441245124612471248124912501251125212531254125512561257125812591260126112621263126412651266126712681269127012711272127312741275127612771278127912801281128212831284128512861287128812891290129112921293129412951296129712981299130013011302130313041305130613071308130913101311131213131314131513161317131813191320132113221323132413251326132713281329133013311332133313341335133613371338133913401341134213431344134513461347134813491350135113521353135413551356135713581359136013611362136313641365136613671368136913701371137213731374137513761377137813791380138113821383138413851386138713881389139013911392139313941395139613971398139914001401140214031404140514061407140814091410141114121413141414151416141714181419142014211422142314241425142614271428142914301431143214331434143514361437143814391440144114421443144414451446144714481449145014511452145314541455145614571458145914601461146214631464146514661467146814691470147114721473147414751476147714781479148014811482148314841485148614871488148914901491149214931494149514961497149814991500150115021503150415051506150715081509151015111512151315141515151615171518151915201521152215231524152515261527152815291530153115321533153415351536153715381539
  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. procedure UpdateUsedRegs(var Regs: TAllUsedRegs; p: Tai);
  214. Function CopyUsedRegs(var dest : TAllUsedRegs) : boolean;
  215. Procedure ReleaseUsedRegs(const regs : TAllUsedRegs);
  216. Function RegInUsedRegs(reg : TRegister;regs : TAllUsedRegs) : boolean;
  217. Procedure IncludeRegInUsedRegs(reg : TRegister;var regs : TAllUsedRegs);
  218. 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;
  272. procedure PeepHoleOptPass1;
  273. procedure PeepHoleOptPass2; virtual;
  274. procedure PostPeepHoleOpts;
  275. { processor dependent methods }
  276. // if it returns true, perform a "continue"
  277. function PeepHoleOptPass1Cpu(var p: tai): boolean; virtual;
  278. function PostPeepHoleOptsCpu(var p: tai): boolean; virtual;
  279. End;
  280. Function ArrayRefsEq(const r1, r2: TReference): Boolean;
  281. { ***************************** Implementation **************************** }
  282. Implementation
  283. uses
  284. cutils,
  285. globals,
  286. verbose,
  287. procinfo;
  288. function JumpTargetOp(ai: taicpu): poper; inline;
  289. begin
  290. {$if defined(MIPS)}
  291. { MIPS branches can have 1,2 or 3 operands, target label is the last one. }
  292. result:=ai.oper[ai.ops-1];
  293. {$else MIPS}
  294. result:=ai.oper[0];
  295. {$endif MIPS}
  296. end;
  297. { ************************************************************************* }
  298. { ******************************** TUsedRegs ****************************** }
  299. { ************************************************************************* }
  300. Constructor TUsedRegs.create(aTyp : TRegisterType);
  301. Begin
  302. Typ:=aTyp;
  303. UsedRegs := [];
  304. End;
  305. Constructor TUsedRegs.create_regset(aTyp : TRegisterType;Const _RegSet: TRegSet);
  306. Begin
  307. Typ:=aTyp;
  308. UsedRegs := _RegSet;
  309. End;
  310. {
  311. updates UsedRegs with the RegAlloc Information coming after P
  312. }
  313. Procedure TUsedRegs.Update(p: Tai;IgnoreNewAllocs : Boolean = false);
  314. Begin
  315. { this code is normally not used because updating the register allocation information is done in
  316. TAOptObj.UpdateUsedRegs for speed reasons }
  317. repeat
  318. while assigned(p) and
  319. ((p.typ in (SkipInstr - [ait_RegAlloc])) or
  320. ((p.typ = ait_label) and
  321. labelCanBeSkipped(tai_label(p))) or
  322. ((p.typ = ait_marker) and
  323. (tai_Marker(p).Kind in [mark_AsmBlockEnd,mark_NoLineInfoStart,mark_NoLineInfoEnd]))) do
  324. p := tai(p.next);
  325. while assigned(p) and
  326. (p.typ=ait_RegAlloc) Do
  327. begin
  328. if (getregtype(tai_regalloc(p).reg) = typ) then
  329. begin
  330. case tai_regalloc(p).ratype of
  331. ra_alloc :
  332. if not(IgnoreNewAllocs) then
  333. Include(UsedRegs, getsupreg(tai_regalloc(p).reg));
  334. ra_dealloc :
  335. Exclude(UsedRegs, getsupreg(tai_regalloc(p).reg));
  336. end;
  337. end;
  338. p := tai(p.next);
  339. end;
  340. until not(assigned(p)) or
  341. (not(p.typ in SkipInstr) and
  342. not((p.typ = ait_label) and
  343. labelCanBeSkipped(tai_label(p))));
  344. End;
  345. Function TUsedRegs.IsUsed(Reg: TRegister): Boolean;
  346. Begin
  347. IsUsed := (getregtype(Reg)=Typ) and (getsupreg(Reg) in UsedRegs);
  348. End;
  349. Function TUsedRegs.GetUsedRegs: TRegSet;
  350. Begin
  351. GetUsedRegs := UsedRegs;
  352. End;
  353. Destructor TUsedRegs.Destroy;
  354. Begin
  355. inherited destroy;
  356. end;
  357. procedure TUsedRegs.Clear;
  358. begin
  359. UsedRegs := [];
  360. end;
  361. { ************************************************************************* }
  362. { **************************** TPaiProp *********************************** }
  363. { ************************************************************************* }
  364. Constructor TPaiProp.Create;
  365. Begin
  366. {!!!!!!
  367. UsedRegs.Init;
  368. CondRegs.init;
  369. }
  370. { DirFlag: TFlagContents; I386 specific}
  371. End;
  372. Function TPaiProp.RegInSequence(Reg, which: TRegister): Boolean;
  373. {
  374. Var p: Tai;
  375. RegsChecked: TRegSet;
  376. content: TContent;
  377. Counter: Byte;
  378. TmpResult: Boolean;
  379. }
  380. begin
  381. Result:=False; { unimplemented }
  382. (*!!!!!!!!!!1
  383. RegsChecked := [];
  384. content := regs[which];
  385. p := content.StartMod;
  386. TmpResult := False;
  387. Counter := 1;
  388. While Not(TmpResult) And
  389. (Counter <= Content.NrOfMods) Do
  390. Begin
  391. If IsLoadMemReg(p) Then
  392. With PInstr(p)^.oper[LoadSrc]^.ref^ Do
  393. If (Base = ProcInfo.FramePointer)
  394. {$ifdef cpurefshaveindexreg}
  395. And (Index = R_NO)
  396. {$endif cpurefshaveindexreg} Then
  397. Begin
  398. RegsChecked := RegsChecked +
  399. [RegMaxSize(PInstr(p)^.oper[LoadDst]^.reg)];
  400. If Reg = RegMaxSize(PInstr(p)^.oper[LoadDst]^.reg) Then
  401. Break;
  402. End
  403. Else
  404. Begin
  405. If (Base = Reg) And
  406. Not(Base In RegsChecked)
  407. Then TmpResult := True;
  408. {$ifdef cpurefshaveindexreg}
  409. If Not(TmpResult) And
  410. (Index = Reg) And
  411. Not(Index In RegsChecked)
  412. Then TmpResult := True;
  413. {$Endif cpurefshaveindexreg}
  414. End
  415. Else TmpResult := RegInInstruction(Reg, p);
  416. Inc(Counter);
  417. GetNextInstruction(p,p)
  418. End;
  419. RegInSequence := TmpResult
  420. *)
  421. End;
  422. Procedure TPaiProp.DestroyReg(Reg: TRegister; var InstrSinceLastMod:
  423. TInstrSinceLastMod);
  424. { Destroys the contents of the register Reg in the PPaiProp p1, as well as }
  425. { the contents of registers are loaded with a memory location based on Reg }
  426. {
  427. Var TmpWState, TmpRState: Byte;
  428. Counter: TRegister;
  429. }
  430. Begin
  431. {!!!!!!!
  432. Reg := RegMaxSize(Reg);
  433. If (Reg in [LoGPReg..HiGPReg]) Then
  434. For Counter := LoGPReg to HiGPReg Do
  435. With Regs[Counter] Do
  436. If (Counter = reg) Or
  437. ((Typ = Con_Ref) And
  438. RegInSequence(Reg, Counter)) Then
  439. Begin
  440. InstrSinceLastMod[Counter] := 0;
  441. IncWState(Counter);
  442. TmpWState := GetWState(Counter);
  443. TmpRState := GetRState(Counter);
  444. FillChar(Regs[Counter], SizeOf(TContent), 0);
  445. WState := TmpWState;
  446. RState := TmpRState
  447. End
  448. }
  449. End;
  450. Function ArrayRefsEq(const r1, r2: TReference): Boolean;
  451. Begin
  452. Result:=False; { unimplemented }
  453. (*!!!!!!!!!!
  454. ArrayRefsEq := (R1.Offset+R1.OffsetFixup = R2.Offset+R2.OffsetFixup) And
  455. {$ifdef refsHaveSegmentReg}
  456. (R1.Segment = R2.Segment) And
  457. {$endif}
  458. (R1.Base = R2.Base) And
  459. (R1.Symbol=R2.Symbol);
  460. *)
  461. End;
  462. Procedure TPaiProp.DestroyRefs(Const Ref: TReference; WhichReg: TRegister;
  463. var InstrSinceLastMod: TInstrSinceLastMod);
  464. { destroys all registers which possibly contain a reference to Ref, WhichReg }
  465. { is the register whose contents are being written to memory (if this proc }
  466. { is called because of a "mov?? %reg, (mem)" instruction) }
  467. {
  468. Var RefsEq: TRefCompare;
  469. Counter: TRegister;
  470. }
  471. Begin
  472. (*!!!!!!!!!!!
  473. WhichReg := RegMaxSize(WhichReg);
  474. If (Ref.base = procinfo.FramePointer) or
  475. Assigned(Ref.Symbol) Then
  476. Begin
  477. If
  478. {$ifdef cpurefshaveindexreg}
  479. (Ref.Index = R_NO) And
  480. {$endif cpurefshaveindexreg}
  481. (Not(Assigned(Ref.Symbol)) or
  482. (Ref.base = R_NO)) Then
  483. { local variable which is not an array }
  484. RefsEq := @RefsEqual
  485. Else
  486. { local variable which is an array }
  487. RefsEq := @ArrayRefsEq;
  488. {write something to a parameter, a local or global variable, so
  489. * with uncertain optimizations on:
  490. - destroy the contents of registers whose contents have somewhere a
  491. "mov?? (Ref), %reg". WhichReg (this is the register whose contents
  492. are being written to memory) is not destroyed if it's StartMod is
  493. of that form and NrOfMods = 1 (so if it holds ref, but is not a
  494. pointer or value based on Ref)
  495. * with uncertain optimizations off:
  496. - also destroy registers that contain any pointer}
  497. For Counter := LoGPReg to HiGPReg Do
  498. With Regs[Counter] Do
  499. Begin
  500. If (typ = Con_Ref) And
  501. ((Not(cs_opt_size in current_settings.optimizerswitches) And
  502. (NrOfMods <> 1)
  503. ) Or
  504. (RefInSequence(Ref,Regs[Counter], RefsEq) And
  505. ((Counter <> WhichReg) Or
  506. ((NrOfMods <> 1) And
  507. {StarMod is always of the type ait_instruction}
  508. (PInstr(StartMod)^.oper[0].typ = top_ref) And
  509. RefsEq(PInstr(StartMod)^.oper[0].ref^, Ref)
  510. )
  511. )
  512. )
  513. )
  514. Then
  515. DestroyReg(Counter, InstrSinceLastMod)
  516. End
  517. End
  518. Else
  519. {write something to a pointer location, so
  520. * with uncertain optimzations on:
  521. - do not destroy registers which contain a local/global variable or a
  522. parameter, except if DestroyRefs is called because of a "movsl"
  523. * with uncertain optimzations off:
  524. - destroy every register which contains a memory location
  525. }
  526. For Counter := LoGPReg to HiGPReg Do
  527. With Regs[Counter] Do
  528. If (typ = Con_Ref) And
  529. (Not(cs_opt_size in current_settings.optimizerswitches) Or
  530. {$ifdef x86}
  531. {for movsl}
  532. (Ref.Base = R_EDI) Or
  533. {$endif}
  534. {don't destroy if reg contains a parameter, local or global variable}
  535. Not((NrOfMods = 1) And
  536. (PInstr(StartMod)^.oper[0].typ = top_ref) And
  537. ((PInstr(StartMod)^.oper[0].ref^.base = ProcInfo.FramePointer) Or
  538. Assigned(PInstr(StartMod)^.oper[0].ref^.Symbol)
  539. )
  540. )
  541. )
  542. Then DestroyReg(Counter, InstrSinceLastMod)
  543. *)
  544. End;
  545. Procedure TPaiProp.DestroyAllRegs(var InstrSinceLastMod: TInstrSinceLastMod);
  546. {Var Counter: TRegister;}
  547. Begin {initializes/desrtoys all registers}
  548. (*!!!!!!!!!
  549. For Counter := LoGPReg To HiGPReg Do
  550. Begin
  551. ReadReg(Counter);
  552. DestroyReg(Counter, InstrSinceLastMod);
  553. End;
  554. CondRegs.Init;
  555. { FPURegs.Init; }
  556. *)
  557. End;
  558. Procedure TPaiProp.DestroyOp(const o:Toper; var InstrSinceLastMod:
  559. TInstrSinceLastMod);
  560. Begin
  561. {!!!!!!!
  562. Case o.typ Of
  563. top_reg: DestroyReg(o.reg, InstrSinceLastMod);
  564. top_ref:
  565. Begin
  566. ReadRef(o.ref);
  567. DestroyRefs(o.ref^, R_NO, InstrSinceLastMod);
  568. End;
  569. top_symbol:;
  570. End;
  571. }
  572. End;
  573. Procedure TPaiProp.ReadReg(Reg: TRegister);
  574. Begin
  575. {!!!!!!!
  576. Reg := RegMaxSize(Reg);
  577. If Reg in General_Registers Then
  578. IncRState(RegMaxSize(Reg))
  579. }
  580. End;
  581. Procedure TPaiProp.ReadRef(Ref: PReference);
  582. Begin
  583. (*!!!!!!
  584. If Ref^.Base <> R_NO Then
  585. ReadReg(Ref^.Base);
  586. {$ifdef cpurefshaveindexreg}
  587. If Ref^.Index <> R_NO Then
  588. ReadReg(Ref^.Index);
  589. {$endif cpurefshaveindexreg}
  590. *)
  591. End;
  592. Procedure TPaiProp.ReadOp(const o:toper);
  593. Begin
  594. Case o.typ Of
  595. top_reg: ReadReg(o.reg);
  596. top_ref: ReadRef(o.ref);
  597. else
  598. internalerror(200410241);
  599. End;
  600. End;
  601. Procedure TPaiProp.ModifyReg(reg: TRegister; Var InstrSinceLastMod:
  602. TInstrSinceLastMod);
  603. Begin
  604. (*!!!!!!!
  605. With Regs[reg] Do
  606. If (Typ = Con_Ref)
  607. Then
  608. Begin
  609. IncState(WState);
  610. {also store how many instructions are part of the sequence in the first
  611. instructions PPaiProp, so it can be easily accessed from within
  612. CheckSequence}
  613. Inc(NrOfMods, InstrSinceLastMod[Reg]);
  614. PPaiProp(StartMod.OptInfo)^.Regs[Reg].NrOfMods := NrOfMods;
  615. InstrSinceLastMod[Reg] := 0;
  616. End
  617. Else
  618. DestroyReg(Reg, InstrSinceLastMod);
  619. *)
  620. End;
  621. Procedure TPaiProp.ModifyOp(const oper: TOper; var InstrSinceLastMod:
  622. TInstrSinceLastMod);
  623. Begin
  624. If oper.typ = top_reg Then
  625. ModifyReg(RegMaxSize(oper.reg),InstrSinceLastMod)
  626. Else
  627. Begin
  628. ReadOp(oper);
  629. DestroyOp(oper, InstrSinceLastMod);
  630. End
  631. End;
  632. Procedure TPaiProp.IncWState(Reg: TRegister);{$ifdef inl} inline;{$endif inl}
  633. Begin
  634. //!!!! IncState(Regs[Reg].WState);
  635. End;
  636. Procedure TPaiProp.IncRState(Reg: TRegister);{$ifdef inl} inline;{$endif inl}
  637. Begin
  638. //!!!! IncState(Regs[Reg].RState);
  639. End;
  640. Function TPaiProp.GetWState(Reg: TRegister): TStateInt; {$ifdef inl} inline;{$endif inl}
  641. Begin
  642. Result:=0; { unimplemented }
  643. //!!!! GetWState := Regs[Reg].WState
  644. End;
  645. Function TPaiProp.GetRState(Reg: TRegister): TStateInt; {$ifdef inl} inline;{$endif inl}
  646. Begin
  647. Result:=0; { unimplemented }
  648. //!!!! GetRState := Regs[Reg].RState
  649. End;
  650. Function TPaiProp.GetRegContentType(Reg: TRegister): Byte; {$ifdef inl} inline;{$endif inl}
  651. Begin
  652. Result:=0; { unimplemented }
  653. //!!!! GetRegContentType := Regs[Reg].typ
  654. End;
  655. Destructor TPaiProp.Done;
  656. Begin
  657. //!!!! UsedRegs.Done;
  658. //!!!! CondRegs.Done;
  659. { DirFlag: TFlagContents; I386 specific}
  660. End;
  661. { ************************ private TPaiProp stuff ************************* }
  662. Procedure TPaiProp.IncState(Var s: TStateInt); {$ifdef inl} inline;{$endif inl}
  663. Begin
  664. If s <> High(TStateInt) Then Inc(s)
  665. Else s := 0
  666. End;
  667. Function TPaiProp.RefInInstruction(Const Ref: TReference; p: Tai;
  668. RefsEq: TRefCompare): Boolean;
  669. Var Count: AWord;
  670. TmpResult: Boolean;
  671. Begin
  672. TmpResult := False;
  673. If (p.typ = ait_instruction) Then
  674. Begin
  675. Count := 0;
  676. Repeat
  677. If (TInstr(p).oper[Count]^.typ = Top_Ref) Then
  678. TmpResult := RefsEq(Ref, PInstr(p)^.oper[Count]^.ref^);
  679. Inc(Count);
  680. Until (Count = MaxOps) or TmpResult;
  681. End;
  682. RefInInstruction := TmpResult;
  683. End;
  684. Function TPaiProp.RefInSequence(Const Ref: TReference; Content: TContent;
  685. RefsEq: TRefCompare): Boolean;
  686. Var p: Tai;
  687. Counter: Byte;
  688. TmpResult: Boolean;
  689. Begin
  690. p := Content.StartMod;
  691. TmpResult := False;
  692. Counter := 1;
  693. While Not(TmpResult) And
  694. (Counter <= Content.NrOfMods) Do
  695. Begin
  696. If (p.typ = ait_instruction) And
  697. RefInInstruction(Ref, p, @references_equal)
  698. Then TmpResult := True;
  699. Inc(Counter);
  700. GetNextInstruction(p,p)
  701. End;
  702. RefInSequence := TmpResult
  703. End;
  704. { ************************************************************************* }
  705. { ***************************** TAoptObj ********************************** }
  706. { ************************************************************************* }
  707. Constructor TAoptObj.create(_AsmL: TAsmList; _BlockStart, _BlockEnd: Tai;
  708. _LabelInfo: PLabelInfo);
  709. Begin
  710. AsmL := _AsmL;
  711. BlockStart := _BlockStart;
  712. BlockEnd := _BlockEnd;
  713. LabelInfo := _LabelInfo;
  714. CreateUsedRegs(UsedRegs);
  715. End;
  716. destructor TAOptObj.Destroy;
  717. var
  718. i : TRegisterType;
  719. begin
  720. for i:=low(TRegisterType) to high(TRegisterType) do
  721. UsedRegs[i].Destroy;
  722. inherited Destroy;
  723. end;
  724. procedure TAOptObj.CreateUsedRegs(var regs: TAllUsedRegs);
  725. var
  726. i : TRegisterType;
  727. begin
  728. for i:=low(TRegisterType) to high(TRegisterType) do
  729. Regs[i]:=TUsedRegs.Create(i);
  730. end;
  731. procedure TAOptObj.ClearUsedRegs;
  732. var
  733. i : TRegisterType;
  734. begin
  735. for i:=low(TRegisterType) to high(TRegisterType) do
  736. UsedRegs[i].Clear;
  737. end;
  738. procedure TAOptObj.UpdateUsedRegs(p : Tai);
  739. begin
  740. { this code is based on TUsedRegs.Update to avoid multiple passes through the asmlist,
  741. the code is duplicated here }
  742. repeat
  743. while assigned(p) and
  744. ((p.typ in (SkipInstr - [ait_RegAlloc])) or
  745. ((p.typ = ait_label) and
  746. labelCanBeSkipped(tai_label(p))) or
  747. ((p.typ = ait_marker) and
  748. (tai_Marker(p).Kind in [mark_AsmBlockEnd,mark_NoLineInfoStart,mark_NoLineInfoEnd]))) do
  749. p := tai(p.next);
  750. while assigned(p) and
  751. (p.typ=ait_RegAlloc) Do
  752. begin
  753. case tai_regalloc(p).ratype of
  754. ra_alloc :
  755. Include(UsedRegs[getregtype(tai_regalloc(p).reg)].UsedRegs, getsupreg(tai_regalloc(p).reg));
  756. ra_dealloc :
  757. Exclude(UsedRegs[getregtype(tai_regalloc(p).reg)].UsedRegs, getsupreg(tai_regalloc(p).reg));
  758. end;
  759. p := tai(p.next);
  760. end;
  761. until not(assigned(p)) or
  762. (not(p.typ in SkipInstr) and
  763. not((p.typ = ait_label) and
  764. labelCanBeSkipped(tai_label(p))));
  765. end;
  766. procedure TAOptObj.UpdateUsedRegs(var Regs : TAllUsedRegs;p : Tai);
  767. var
  768. i : TRegisterType;
  769. begin
  770. for i:=low(TRegisterType) to high(TRegisterType) do
  771. Regs[i].Update(p);
  772. end;
  773. function TAOptObj.CopyUsedRegs(var dest: TAllUsedRegs): boolean;
  774. var
  775. i : TRegisterType;
  776. begin
  777. Result:=true;
  778. for i:=low(TRegisterType) to high(TRegisterType) do
  779. dest[i]:=TUsedRegs.Create_Regset(i,UsedRegs[i].GetUsedRegs);
  780. end;
  781. procedure TAOptObj.ReleaseUsedRegs(const regs: TAllUsedRegs);
  782. var
  783. i : TRegisterType;
  784. begin
  785. for i:=low(TRegisterType) to high(TRegisterType) do
  786. regs[i].Free;
  787. end;
  788. Function TAOptObj.RegInUsedRegs(reg : TRegister;regs : TAllUsedRegs) : boolean;
  789. begin
  790. result:=regs[getregtype(reg)].IsUsed(reg);
  791. end;
  792. procedure TAOptObj.IncludeRegInUsedRegs(reg: TRegister;
  793. var regs: TAllUsedRegs);
  794. begin
  795. include(regs[getregtype(reg)].UsedRegs,getsupreg(Reg));
  796. end;
  797. procedure TAOptObj.ExcludeRegFromUsedRegs(reg: TRegister;
  798. var regs: TAllUsedRegs);
  799. begin
  800. exclude(regs[getregtype(reg)].UsedRegs,getsupreg(Reg));
  801. end;
  802. function TAOptObj.GetAllocationString(const regs: TAllUsedRegs): string;
  803. var
  804. i : TRegisterType;
  805. j : TSuperRegister;
  806. begin
  807. Result:='';
  808. for i:=low(TRegisterType) to high(TRegisterType) do
  809. for j in regs[i].UsedRegs do
  810. Result:=Result+std_regname(newreg(i,j,R_SUBWHOLE))+' ';
  811. end;
  812. Function TAOptObj.FindLabel(L: TasmLabel; Var hp: Tai): Boolean;
  813. Var TempP: Tai;
  814. Begin
  815. TempP := hp;
  816. While Assigned(TempP) and
  817. (TempP.typ In SkipInstr + [ait_label,ait_align]) Do
  818. If (TempP.typ <> ait_Label) Or
  819. (Tai_label(TempP).labsym <> L)
  820. Then GetNextInstruction(TempP, TempP)
  821. Else
  822. Begin
  823. hp := TempP;
  824. FindLabel := True;
  825. exit
  826. End;
  827. FindLabel := False;
  828. End;
  829. Procedure TAOptObj.InsertLLItem(prev, foll, new_one : TLinkedListItem);
  830. Begin
  831. If Assigned(prev) Then
  832. If Assigned(foll) Then
  833. Begin
  834. If Assigned(new_one) Then
  835. Begin
  836. new_one.previous := prev;
  837. new_one.next := foll;
  838. prev.next := new_one;
  839. foll.previous := new_one;
  840. { should we update line information? }
  841. if (not (tai(new_one).typ in SkipLineInfo)) and
  842. (not (tai(foll).typ in SkipLineInfo)) then
  843. Tailineinfo(new_one).fileinfo := Tailineinfo(foll).fileinfo
  844. End
  845. End
  846. Else AsmL.Concat(new_one)
  847. Else If Assigned(Foll) Then AsmL.Insert(new_one)
  848. End;
  849. Function TAOptObj.SkipHead(P: Tai): Tai;
  850. Var OldP: Tai;
  851. Begin
  852. Repeat
  853. OldP := P;
  854. If (P.typ in SkipInstr) Or
  855. ((P.typ = ait_marker) And
  856. (Tai_Marker(P).Kind = mark_AsmBlockEnd)) Then
  857. GetNextInstruction(P, P)
  858. Else If ((P.Typ = Ait_Marker) And
  859. (Tai_Marker(P).Kind = mark_NoPropInfoStart)) Then
  860. { a marker of the type mark_NoPropInfoStart can't be the first instruction of a }
  861. { paasmoutput list }
  862. GetNextInstruction(Tai(P.Previous),P);
  863. If (P.Typ = Ait_Marker) And
  864. (Tai_Marker(P).Kind = mark_AsmBlockStart) Then
  865. Begin
  866. P := Tai(P.Next);
  867. While (P.typ <> Ait_Marker) Or
  868. (Tai_Marker(P).Kind <> mark_AsmBlockEnd) Do
  869. P := Tai(P.Next)
  870. End;
  871. Until P = OldP;
  872. SkipHead := P;
  873. End;
  874. Function TAOptObj.OpsEqual(const o1,o2:toper): Boolean;
  875. Begin
  876. if o1.typ=o2.typ then
  877. Case o1.typ Of
  878. Top_Reg :
  879. OpsEqual:=o1.reg=o2.reg;
  880. Top_Ref :
  881. OpsEqual := references_equal(o1.ref^, o2.ref^);
  882. Top_Const :
  883. OpsEqual:=o1.val=o2.val;
  884. Top_None :
  885. OpsEqual := True
  886. else OpsEqual := False
  887. End
  888. else
  889. OpsEqual := False;
  890. End;
  891. Function TAOptObj.FindRegAlloc(Reg: TRegister; StartPai: Tai): tai_regalloc;
  892. Begin
  893. Result:=nil;
  894. Repeat
  895. While Assigned(StartPai) And
  896. ((StartPai.typ in (SkipInstr - [ait_regAlloc])) Or
  897. {$if defined(MIPS) or defined(SPARC)}
  898. ((startpai.typ=ait_instruction) and (taicpu(startpai).opcode=A_NOP)) or
  899. {$endif MIPS or SPARC}
  900. ((StartPai.typ = ait_label) and
  901. Not(Tai_Label(StartPai).labsym.Is_Used))) Do
  902. StartPai := Tai(StartPai.Next);
  903. If Assigned(StartPai) And
  904. (StartPai.typ = ait_regAlloc) Then
  905. Begin
  906. if (tai_regalloc(StartPai).ratype=ra_alloc) and
  907. (getregtype(tai_regalloc(StartPai).Reg) = getregtype(Reg)) and
  908. (getsupreg(tai_regalloc(StartPai).Reg) = getsupreg(Reg)) then
  909. begin
  910. Result:=tai_regalloc(StartPai);
  911. exit;
  912. end;
  913. StartPai := Tai(StartPai.Next);
  914. End
  915. else
  916. exit;
  917. Until false;
  918. End;
  919. Function TAOptObj.FindRegAllocBackward(Reg: TRegister; StartPai: Tai): tai_regalloc;
  920. Begin
  921. Result:=nil;
  922. Repeat
  923. While Assigned(StartPai) And
  924. ((StartPai.typ in (SkipInstr - [ait_regAlloc])) Or
  925. ((StartPai.typ = ait_label) and
  926. Not(Tai_Label(StartPai).labsym.Is_Used))) Do
  927. StartPai := Tai(StartPai.Previous);
  928. If Assigned(StartPai) And
  929. (StartPai.typ = ait_regAlloc) Then
  930. Begin
  931. if (tai_regalloc(StartPai).ratype=ra_alloc) and
  932. (getregtype(tai_regalloc(StartPai).Reg) = getregtype(Reg)) and
  933. (getsupreg(tai_regalloc(StartPai).Reg) = getsupreg(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. begin
  1169. end;
  1170. procedure TAOptObj.PeepHoleOptPass1;
  1171. var
  1172. p,hp1,hp2 : tai;
  1173. stoploop:boolean;
  1174. begin
  1175. repeat
  1176. stoploop:=true;
  1177. p := BlockStart;
  1178. ClearUsedRegs;
  1179. while (p <> BlockEnd) Do
  1180. begin
  1181. { I'am not sure why this is done, UsedRegs should reflect the register usage before the instruction
  1182. If an instruction needs the information of this, it can easily create a TempUsedRegs (FK)
  1183. UpdateUsedRegs(tai(p.next));
  1184. }
  1185. {$ifdef DEBUG_OPTALLOC}
  1186. if p.Typ=ait_instruction then
  1187. InsertLLItem(tai(p.Previous),p,tai_comment.create(strpnew(GetAllocationString(UsedRegs))));
  1188. {$endif DEBUG_OPTALLOC}
  1189. if PeepHoleOptPass1Cpu(p) then
  1190. begin
  1191. stoploop:=false;
  1192. UpdateUsedRegs(p);
  1193. continue;
  1194. end;
  1195. case p.Typ Of
  1196. ait_instruction:
  1197. begin
  1198. { Handle Jmp Optimizations }
  1199. if taicpu(p).is_jmp then
  1200. begin
  1201. { the following if-block removes all code between a jmp and the next label,
  1202. because it can never be executed
  1203. }
  1204. if IsJumpToLabelUncond(taicpu(p)) then
  1205. begin
  1206. hp2:=p;
  1207. while GetNextInstruction(hp2, hp1) and
  1208. (hp1.typ <> ait_label)
  1209. {$ifdef JVM}
  1210. and (hp1.typ <> ait_jcatch)
  1211. {$endif}
  1212. do
  1213. if not(hp1.typ in ([ait_label,ait_align]+skipinstr)) then
  1214. begin
  1215. if (hp1.typ = ait_instruction) and
  1216. taicpu(hp1).is_jmp and
  1217. (JumpTargetOp(taicpu(hp1))^.typ = top_ref) and
  1218. (JumpTargetOp(taicpu(hp1))^.ref^.symbol is TAsmLabel) then
  1219. TAsmLabel(JumpTargetOp(taicpu(hp1))^.ref^.symbol).decrefs;
  1220. { don't kill start/end of assembler block,
  1221. no-line-info-start/end etc }
  1222. if hp1.typ<>ait_marker then
  1223. begin
  1224. {$if defined(SPARC) or defined(MIPS) }
  1225. if (hp1.typ=ait_instruction) and (taicpu(hp1).is_jmp) then
  1226. RemoveDelaySlot(hp1);
  1227. {$endif SPARC or MIPS }
  1228. asml.remove(hp1);
  1229. hp1.free;
  1230. stoploop:=false;
  1231. end
  1232. else
  1233. hp2:=hp1;
  1234. end
  1235. else break;
  1236. end;
  1237. if GetNextInstruction(p, hp1) then
  1238. begin
  1239. SkipEntryExitMarker(hp1,hp1);
  1240. { remove unconditional jumps to a label coming right after them }
  1241. if IsJumpToLabelUncond(taicpu(p)) and
  1242. FindLabel(tasmlabel(JumpTargetOp(taicpu(p))^.ref^.symbol), hp1) and
  1243. { TODO: FIXME removing the first instruction fails}
  1244. (p<>blockstart) then
  1245. begin
  1246. tasmlabel(JumpTargetOp(taicpu(p))^.ref^.symbol).decrefs;
  1247. {$if defined(SPARC) or defined(MIPS)}
  1248. RemoveDelaySlot(p);
  1249. {$endif SPARC or MIPS}
  1250. hp2:=tai(hp1.next);
  1251. asml.remove(p);
  1252. p.free;
  1253. p:=hp2;
  1254. stoploop:=false;
  1255. continue;
  1256. end
  1257. else if assigned(hp1) then
  1258. begin
  1259. { change the following jumps:
  1260. jmp<cond> lab_1 jmp<cond_inverted> lab_2
  1261. jmp lab_2 >>> <code>
  1262. lab_1: lab_2:
  1263. <code>
  1264. lab_2:
  1265. }
  1266. if hp1.typ = ait_label then
  1267. SkipLabels(hp1,hp1);
  1268. if (tai(hp1).typ=ait_instruction) and
  1269. IsJumpToLabelUncond(taicpu(hp1)) and
  1270. GetNextInstruction(hp1, hp2) and
  1271. IsJumpToLabel(taicpu(p)) and
  1272. FindLabel(tasmlabel(JumpTargetOp(taicpu(p))^.ref^.symbol), hp2) then
  1273. begin
  1274. if (taicpu(p).opcode=aopt_condjmp)
  1275. {$if defined(arm) or defined(aarch64)}
  1276. and (taicpu(p).condition<>C_None)
  1277. {$endif arm or aarch64}
  1278. {$if defined(aarch64)}
  1279. { can't have conditional branches to
  1280. global labels on AArch64, because the
  1281. offset may become too big }
  1282. and (tasmlabel(JumpTargetOp(taicpu(hp1))^.ref^.symbol).bind=AB_LOCAL)
  1283. {$endif aarch64}
  1284. then
  1285. begin
  1286. taicpu(p).condition:=inverse_cond(taicpu(p).condition);
  1287. tai_label(hp2).labsym.decrefs;
  1288. JumpTargetOp(taicpu(p))^.ref^.symbol:=JumpTargetOp(taicpu(hp1))^.ref^.symbol;
  1289. { when freeing hp1, the reference count
  1290. isn't decreased, so don't increase
  1291. taicpu(p).oper[0]^.ref^.symbol.increfs;
  1292. }
  1293. {$if defined(SPARC) or defined(MIPS)}
  1294. RemoveDelaySlot(hp1);
  1295. {$endif SPARC or MIPS}
  1296. asml.remove(hp1);
  1297. hp1.free;
  1298. stoploop:=false;
  1299. GetFinalDestination(taicpu(p),0);
  1300. end
  1301. else
  1302. begin
  1303. GetFinalDestination(taicpu(p),0);
  1304. p:=tai(p.next);
  1305. continue;
  1306. end;
  1307. end
  1308. else if IsJumpToLabel(taicpu(p)) then
  1309. GetFinalDestination(taicpu(p),0);
  1310. end;
  1311. end;
  1312. end
  1313. else
  1314. { All other optimizes }
  1315. begin
  1316. end; { if is_jmp }
  1317. end;
  1318. end;
  1319. UpdateUsedRegs(p);
  1320. p:=tai(p.next);
  1321. end;
  1322. until stoploop or not(cs_opt_level3 in current_settings.optimizerswitches);
  1323. end;
  1324. procedure TAOptObj.PeepHoleOptPass2;
  1325. begin
  1326. end;
  1327. procedure TAOptObj.PostPeepHoleOpts;
  1328. var
  1329. p: tai;
  1330. begin
  1331. p := BlockStart;
  1332. ClearUsedRegs;
  1333. while (p <> BlockEnd) Do
  1334. begin
  1335. UpdateUsedRegs(tai(p.next));
  1336. if PostPeepHoleOptsCpu(p) then
  1337. continue;
  1338. UpdateUsedRegs(p);
  1339. p:=tai(p.next);
  1340. end;
  1341. end;
  1342. function TAOptObj.PeepHoleOptPass1Cpu(var p: tai): boolean;
  1343. begin
  1344. result := false;
  1345. end;
  1346. function TAOptObj.PostPeepHoleOptsCpu(var p: tai): boolean;
  1347. begin
  1348. result := false;
  1349. end;
  1350. End.