aoptobj.pas 59 KB

123456789101112131415161718192021222324252627282930313233343536373839404142434445464748495051525354555657585960616263646566676869707172737475767778798081828384858687888990919293949596979899100101102103104105106107108109110111112113114115116117118119120121122123124125126127128129130131132133134135136137138139140141142143144145146147148149150151152153154155156157158159160161162163164165166167168169170171172173174175176177178179180181182183184185186187188189190191192193194195196197198199200201202203204205206207208209210211212213214215216217218219220221222223224225226227228229230231232233234235236237238239240241242243244245246247248249250251252253254255256257258259260261262263264265266267268269270271272273274275276277278279280281282283284285286287288289290291292293294295296297298299300301302303304305306307308309310311312313314315316317318319320321322323324325326327328329330331332333334335336337338339340341342343344345346347348349350351352353354355356357358359360361362363364365366367368369370371372373374375376377378379380381382383384385386387388389390391392393394395396397398399400401402403404405406407408409410411412413414415416417418419420421422423424425426427428429430431432433434435436437438439440441442443444445446447448449450451452453454455456457458459460461462463464465466467468469470471472473474475476477478479480481482483484485486487488489490491492493494495496497498499500501502503504505506507508509510511512513514515516517518519520521522523524525526527528529530531532533534535536537538539540541542543544545546547548549550551552553554555556557558559560561562563564565566567568569570571572573574575576577578579580581582583584585586587588589590591592593594595596597598599600601602603604605606607608609610611612613614615616617618619620621622623624625626627628629630631632633634635636637638639640641642643644645646647648649650651652653654655656657658659660661662663664665666667668669670671672673674675676677678679680681682683684685686687688689690691692693694695696697698699700701702703704705706707708709710711712713714715716717718719720721722723724725726727728729730731732733734735736737738739740741742743744745746747748749750751752753754755756757758759760761762763764765766767768769770771772773774775776777778779780781782783784785786787788789790791792793794795796797798799800801802803804805806807808809810811812813814815816817818819820821822823824825826827828829830831832833834835836837838839840841842843844845846847848849850851852853854855856857858859860861862863864865866867868869870871872873874875876877878879880881882883884885886887888889890891892893894895896897898899900901902903904905906907908909910911912913914915916917918919920921922923924925926927928929930931932933934935936937938939940941942943944945946947948949950951952953954955956957958959960961962963964965966967968969970971972973974975976977978979980981982983984985986987988989990991992993994995996997998999100010011002100310041005100610071008100910101011101210131014101510161017101810191020102110221023102410251026102710281029103010311032103310341035103610371038103910401041104210431044104510461047104810491050105110521053105410551056105710581059106010611062106310641065106610671068106910701071107210731074107510761077107810791080108110821083108410851086108710881089109010911092109310941095109610971098109911001101110211031104110511061107110811091110111111121113111411151116111711181119112011211122112311241125112611271128112911301131113211331134113511361137113811391140114111421143114411451146114711481149115011511152115311541155115611571158115911601161116211631164116511661167116811691170117111721173117411751176117711781179118011811182118311841185118611871188118911901191119211931194119511961197119811991200120112021203120412051206120712081209121012111212121312141215121612171218121912201221122212231224122512261227122812291230123112321233123412351236123712381239124012411242124312441245124612471248124912501251125212531254125512561257125812591260126112621263126412651266126712681269127012711272127312741275127612771278127912801281128212831284128512861287128812891290129112921293129412951296129712981299130013011302130313041305130613071308130913101311131213131314131513161317131813191320132113221323132413251326132713281329133013311332133313341335133613371338133913401341134213431344134513461347134813491350135113521353135413551356135713581359136013611362136313641365136613671368136913701371137213731374137513761377137813791380138113821383138413851386138713881389139013911392139313941395139613971398139914001401140214031404140514061407140814091410141114121413141414151416141714181419142014211422142314241425142614271428142914301431143214331434143514361437143814391440144114421443144414451446144714481449145014511452145314541455145614571458145914601461146214631464146514661467146814691470147114721473147414751476147714781479148014811482148314841485148614871488148914901491149214931494149514961497149814991500150115021503150415051506150715081509151015111512151315141515151615171518151915201521152215231524152515261527152815291530153115321533153415351536153715381539154015411542154315441545154615471548154915501551155215531554155515561557155815591560156115621563156415651566156715681569157015711572157315741575157615771578157915801581158215831584158515861587158815891590159115921593159415951596159715981599160016011602160316041605160616071608160916101611161216131614161516161617161816191620162116221623162416251626
  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. { insert debug comments about which registers are read and written by
  282. each instruction. Useful for debugging the InstructionLoadsFromReg and
  283. other similar functions. }
  284. procedure Debug_InsertInstrRegisterDependencyInfo; virtual;
  285. End;
  286. Function ArrayRefsEq(const r1, r2: TReference): Boolean;
  287. { ***************************** Implementation **************************** }
  288. Implementation
  289. uses
  290. cutils,
  291. globals,
  292. verbose,
  293. procinfo;
  294. function JumpTargetOp(ai: taicpu): poper; inline;
  295. begin
  296. {$if defined(MIPS)}
  297. { MIPS branches can have 1,2 or 3 operands, target label is the last one. }
  298. result:=ai.oper[ai.ops-1];
  299. {$else MIPS}
  300. result:=ai.oper[0];
  301. {$endif MIPS}
  302. end;
  303. { ************************************************************************* }
  304. { ******************************** TUsedRegs ****************************** }
  305. { ************************************************************************* }
  306. Constructor TUsedRegs.create(aTyp : TRegisterType);
  307. Begin
  308. Typ:=aTyp;
  309. UsedRegs := [];
  310. End;
  311. Constructor TUsedRegs.create_regset(aTyp : TRegisterType;Const _RegSet: TRegSet);
  312. Begin
  313. Typ:=aTyp;
  314. UsedRegs := _RegSet;
  315. End;
  316. {
  317. updates UsedRegs with the RegAlloc Information coming after P
  318. }
  319. Procedure TUsedRegs.Update(p: Tai;IgnoreNewAllocs : Boolean = false);
  320. Begin
  321. { this code is normally not used because updating the register allocation information is done in
  322. TAOptObj.UpdateUsedRegs for speed reasons }
  323. repeat
  324. while assigned(p) and
  325. ((p.typ in (SkipInstr - [ait_RegAlloc])) or
  326. (p.typ = ait_label) or
  327. ((p.typ = ait_marker) and
  328. (tai_Marker(p).Kind in [mark_AsmBlockEnd,mark_NoLineInfoStart,mark_NoLineInfoEnd]))) do
  329. p := tai(p.next);
  330. while assigned(p) and
  331. (p.typ=ait_RegAlloc) Do
  332. begin
  333. if (getregtype(tai_regalloc(p).reg) = typ) then
  334. begin
  335. case tai_regalloc(p).ratype of
  336. ra_alloc :
  337. if not(IgnoreNewAllocs) then
  338. Include(UsedRegs, getsupreg(tai_regalloc(p).reg));
  339. ra_dealloc :
  340. Exclude(UsedRegs, getsupreg(tai_regalloc(p).reg));
  341. end;
  342. end;
  343. p := tai(p.next);
  344. end;
  345. until not(assigned(p)) or
  346. (not(p.typ in SkipInstr) and
  347. not((p.typ = ait_label) and
  348. labelCanBeSkipped(tai_label(p))));
  349. End;
  350. Function TUsedRegs.IsUsed(Reg: TRegister): Boolean;
  351. Begin
  352. IsUsed := (getregtype(Reg)=Typ) and (getsupreg(Reg) in UsedRegs);
  353. End;
  354. Function TUsedRegs.GetUsedRegs: TRegSet;
  355. Begin
  356. GetUsedRegs := UsedRegs;
  357. End;
  358. Destructor TUsedRegs.Destroy;
  359. Begin
  360. inherited destroy;
  361. end;
  362. procedure TUsedRegs.Clear;
  363. begin
  364. UsedRegs := [];
  365. end;
  366. { ************************************************************************* }
  367. { **************************** TPaiProp *********************************** }
  368. { ************************************************************************* }
  369. Constructor TPaiProp.Create;
  370. Begin
  371. {!!!!!!
  372. UsedRegs.Init;
  373. CondRegs.init;
  374. }
  375. { DirFlag: TFlagContents; I386 specific}
  376. End;
  377. Function TPaiProp.RegInSequence(Reg, which: TRegister): Boolean;
  378. {
  379. Var p: Tai;
  380. RegsChecked: TRegSet;
  381. content: TContent;
  382. Counter: Byte;
  383. TmpResult: Boolean;
  384. }
  385. begin
  386. Result:=False; { unimplemented }
  387. (*!!!!!!!!!!1
  388. RegsChecked := [];
  389. content := regs[which];
  390. p := content.StartMod;
  391. TmpResult := False;
  392. Counter := 1;
  393. While Not(TmpResult) And
  394. (Counter <= Content.NrOfMods) Do
  395. Begin
  396. If IsLoadMemReg(p) Then
  397. With PInstr(p)^.oper[LoadSrc]^.ref^ Do
  398. If (Base = ProcInfo.FramePointer)
  399. {$ifdef cpurefshaveindexreg}
  400. And (Index = R_NO)
  401. {$endif cpurefshaveindexreg} Then
  402. Begin
  403. RegsChecked := RegsChecked +
  404. [RegMaxSize(PInstr(p)^.oper[LoadDst]^.reg)];
  405. If Reg = RegMaxSize(PInstr(p)^.oper[LoadDst]^.reg) Then
  406. Break;
  407. End
  408. Else
  409. Begin
  410. If (Base = Reg) And
  411. Not(Base In RegsChecked)
  412. Then TmpResult := True;
  413. {$ifdef cpurefshaveindexreg}
  414. If Not(TmpResult) And
  415. (Index = Reg) And
  416. Not(Index In RegsChecked)
  417. Then TmpResult := True;
  418. {$Endif cpurefshaveindexreg}
  419. End
  420. Else TmpResult := RegInInstruction(Reg, p);
  421. Inc(Counter);
  422. GetNextInstruction(p,p)
  423. End;
  424. RegInSequence := TmpResult
  425. *)
  426. End;
  427. Procedure TPaiProp.DestroyReg(Reg: TRegister; var InstrSinceLastMod:
  428. TInstrSinceLastMod);
  429. { Destroys the contents of the register Reg in the PPaiProp p1, as well as }
  430. { the contents of registers are loaded with a memory location based on Reg }
  431. {
  432. Var TmpWState, TmpRState: Byte;
  433. Counter: TRegister;
  434. }
  435. Begin
  436. {!!!!!!!
  437. Reg := RegMaxSize(Reg);
  438. If (Reg in [LoGPReg..HiGPReg]) Then
  439. For Counter := LoGPReg to HiGPReg Do
  440. With Regs[Counter] Do
  441. If (Counter = reg) Or
  442. ((Typ = Con_Ref) And
  443. RegInSequence(Reg, Counter)) Then
  444. Begin
  445. InstrSinceLastMod[Counter] := 0;
  446. IncWState(Counter);
  447. TmpWState := GetWState(Counter);
  448. TmpRState := GetRState(Counter);
  449. FillChar(Regs[Counter], SizeOf(TContent), 0);
  450. WState := TmpWState;
  451. RState := TmpRState
  452. End
  453. }
  454. End;
  455. Function ArrayRefsEq(const r1, r2: TReference): Boolean;
  456. Begin
  457. Result:=False; { unimplemented }
  458. (*!!!!!!!!!!
  459. ArrayRefsEq := (R1.Offset+R1.OffsetFixup = R2.Offset+R2.OffsetFixup) And
  460. {$ifdef refsHaveSegmentReg}
  461. (R1.Segment = R2.Segment) And
  462. {$endif}
  463. (R1.Base = R2.Base) And
  464. (R1.Symbol=R2.Symbol);
  465. *)
  466. End;
  467. Procedure TPaiProp.DestroyRefs(Const Ref: TReference; WhichReg: TRegister;
  468. var InstrSinceLastMod: TInstrSinceLastMod);
  469. { destroys all registers which possibly contain a reference to Ref, WhichReg }
  470. { is the register whose contents are being written to memory (if this proc }
  471. { is called because of a "mov?? %reg, (mem)" instruction) }
  472. {
  473. Var RefsEq: TRefCompare;
  474. Counter: TRegister;
  475. }
  476. Begin
  477. (*!!!!!!!!!!!
  478. WhichReg := RegMaxSize(WhichReg);
  479. If (Ref.base = procinfo.FramePointer) or
  480. Assigned(Ref.Symbol) Then
  481. Begin
  482. If
  483. {$ifdef cpurefshaveindexreg}
  484. (Ref.Index = R_NO) And
  485. {$endif cpurefshaveindexreg}
  486. (Not(Assigned(Ref.Symbol)) or
  487. (Ref.base = R_NO)) Then
  488. { local variable which is not an array }
  489. RefsEq := @RefsEqual
  490. Else
  491. { local variable which is an array }
  492. RefsEq := @ArrayRefsEq;
  493. {write something to a parameter, a local or global variable, so
  494. * with uncertain optimizations on:
  495. - destroy the contents of registers whose contents have somewhere a
  496. "mov?? (Ref), %reg". WhichReg (this is the register whose contents
  497. are being written to memory) is not destroyed if it's StartMod is
  498. of that form and NrOfMods = 1 (so if it holds ref, but is not a
  499. pointer or value based on Ref)
  500. * with uncertain optimizations off:
  501. - also destroy registers that contain any pointer}
  502. For Counter := LoGPReg to HiGPReg Do
  503. With Regs[Counter] Do
  504. Begin
  505. If (typ = Con_Ref) And
  506. ((Not(cs_opt_size in current_settings.optimizerswitches) And
  507. (NrOfMods <> 1)
  508. ) Or
  509. (RefInSequence(Ref,Regs[Counter], RefsEq) And
  510. ((Counter <> WhichReg) Or
  511. ((NrOfMods <> 1) And
  512. {StarMod is always of the type ait_instruction}
  513. (PInstr(StartMod)^.oper[0].typ = top_ref) And
  514. RefsEq(PInstr(StartMod)^.oper[0].ref^, Ref)
  515. )
  516. )
  517. )
  518. )
  519. Then
  520. DestroyReg(Counter, InstrSinceLastMod)
  521. End
  522. End
  523. Else
  524. {write something to a pointer location, so
  525. * with uncertain optimzations on:
  526. - do not destroy registers which contain a local/global variable or a
  527. parameter, except if DestroyRefs is called because of a "movsl"
  528. * with uncertain optimzations off:
  529. - destroy every register which contains a memory location
  530. }
  531. For Counter := LoGPReg to HiGPReg Do
  532. With Regs[Counter] Do
  533. If (typ = Con_Ref) And
  534. (Not(cs_opt_size in current_settings.optimizerswitches) Or
  535. {$ifdef x86}
  536. {for movsl}
  537. (Ref.Base = R_EDI) Or
  538. {$endif}
  539. {don't destroy if reg contains a parameter, local or global variable}
  540. Not((NrOfMods = 1) And
  541. (PInstr(StartMod)^.oper[0].typ = top_ref) And
  542. ((PInstr(StartMod)^.oper[0].ref^.base = ProcInfo.FramePointer) Or
  543. Assigned(PInstr(StartMod)^.oper[0].ref^.Symbol)
  544. )
  545. )
  546. )
  547. Then DestroyReg(Counter, InstrSinceLastMod)
  548. *)
  549. End;
  550. Procedure TPaiProp.DestroyAllRegs(var InstrSinceLastMod: TInstrSinceLastMod);
  551. {Var Counter: TRegister;}
  552. Begin {initializes/desrtoys all registers}
  553. (*!!!!!!!!!
  554. For Counter := LoGPReg To HiGPReg Do
  555. Begin
  556. ReadReg(Counter);
  557. DestroyReg(Counter, InstrSinceLastMod);
  558. End;
  559. CondRegs.Init;
  560. { FPURegs.Init; }
  561. *)
  562. End;
  563. Procedure TPaiProp.DestroyOp(const o:Toper; var InstrSinceLastMod:
  564. TInstrSinceLastMod);
  565. Begin
  566. {!!!!!!!
  567. Case o.typ Of
  568. top_reg: DestroyReg(o.reg, InstrSinceLastMod);
  569. top_ref:
  570. Begin
  571. ReadRef(o.ref);
  572. DestroyRefs(o.ref^, R_NO, InstrSinceLastMod);
  573. End;
  574. top_symbol:;
  575. End;
  576. }
  577. End;
  578. Procedure TPaiProp.ReadReg(Reg: TRegister);
  579. Begin
  580. {!!!!!!!
  581. Reg := RegMaxSize(Reg);
  582. If Reg in General_Registers Then
  583. IncRState(RegMaxSize(Reg))
  584. }
  585. End;
  586. Procedure TPaiProp.ReadRef(Ref: PReference);
  587. Begin
  588. (*!!!!!!
  589. If Ref^.Base <> R_NO Then
  590. ReadReg(Ref^.Base);
  591. {$ifdef cpurefshaveindexreg}
  592. If Ref^.Index <> R_NO Then
  593. ReadReg(Ref^.Index);
  594. {$endif cpurefshaveindexreg}
  595. *)
  596. End;
  597. Procedure TPaiProp.ReadOp(const o:toper);
  598. Begin
  599. Case o.typ Of
  600. top_reg: ReadReg(o.reg);
  601. top_ref: ReadRef(o.ref);
  602. else
  603. internalerror(200410241);
  604. End;
  605. End;
  606. Procedure TPaiProp.ModifyReg(reg: TRegister; Var InstrSinceLastMod:
  607. TInstrSinceLastMod);
  608. Begin
  609. (*!!!!!!!
  610. With Regs[reg] Do
  611. If (Typ = Con_Ref)
  612. Then
  613. Begin
  614. IncState(WState);
  615. {also store how many instructions are part of the sequence in the first
  616. instructions PPaiProp, so it can be easily accessed from within
  617. CheckSequence}
  618. Inc(NrOfMods, InstrSinceLastMod[Reg]);
  619. PPaiProp(StartMod.OptInfo)^.Regs[Reg].NrOfMods := NrOfMods;
  620. InstrSinceLastMod[Reg] := 0;
  621. End
  622. Else
  623. DestroyReg(Reg, InstrSinceLastMod);
  624. *)
  625. End;
  626. Procedure TPaiProp.ModifyOp(const oper: TOper; var InstrSinceLastMod:
  627. TInstrSinceLastMod);
  628. Begin
  629. If oper.typ = top_reg Then
  630. ModifyReg(RegMaxSize(oper.reg),InstrSinceLastMod)
  631. Else
  632. Begin
  633. ReadOp(oper);
  634. DestroyOp(oper, InstrSinceLastMod);
  635. End
  636. End;
  637. Procedure TPaiProp.IncWState(Reg: TRegister);{$ifdef inl} inline;{$endif inl}
  638. Begin
  639. //!!!! IncState(Regs[Reg].WState);
  640. End;
  641. Procedure TPaiProp.IncRState(Reg: TRegister);{$ifdef inl} inline;{$endif inl}
  642. Begin
  643. //!!!! IncState(Regs[Reg].RState);
  644. End;
  645. Function TPaiProp.GetWState(Reg: TRegister): TStateInt; {$ifdef inl} inline;{$endif inl}
  646. Begin
  647. Result:=0; { unimplemented }
  648. //!!!! GetWState := Regs[Reg].WState
  649. End;
  650. Function TPaiProp.GetRState(Reg: TRegister): TStateInt; {$ifdef inl} inline;{$endif inl}
  651. Begin
  652. Result:=0; { unimplemented }
  653. //!!!! GetRState := Regs[Reg].RState
  654. End;
  655. Function TPaiProp.GetRegContentType(Reg: TRegister): Byte; {$ifdef inl} inline;{$endif inl}
  656. Begin
  657. Result:=0; { unimplemented }
  658. //!!!! GetRegContentType := Regs[Reg].typ
  659. End;
  660. Destructor TPaiProp.Done;
  661. Begin
  662. //!!!! UsedRegs.Done;
  663. //!!!! CondRegs.Done;
  664. { DirFlag: TFlagContents; I386 specific}
  665. End;
  666. { ************************ private TPaiProp stuff ************************* }
  667. Procedure TPaiProp.IncState(Var s: TStateInt); {$ifdef inl} inline;{$endif inl}
  668. Begin
  669. If s <> High(TStateInt) Then Inc(s)
  670. Else s := 0
  671. End;
  672. Function TPaiProp.RefInInstruction(Const Ref: TReference; p: Tai;
  673. RefsEq: TRefCompare): Boolean;
  674. Var Count: AWord;
  675. TmpResult: Boolean;
  676. Begin
  677. TmpResult := False;
  678. If (p.typ = ait_instruction) Then
  679. Begin
  680. Count := 0;
  681. Repeat
  682. If (TInstr(p).oper[Count]^.typ = Top_Ref) Then
  683. TmpResult := RefsEq(Ref, PInstr(p)^.oper[Count]^.ref^);
  684. Inc(Count);
  685. Until (Count = MaxOps) or TmpResult;
  686. End;
  687. RefInInstruction := TmpResult;
  688. End;
  689. Function TPaiProp.RefInSequence(Const Ref: TReference; Content: TContent;
  690. RefsEq: TRefCompare): Boolean;
  691. Var p: Tai;
  692. Counter: Byte;
  693. TmpResult: Boolean;
  694. Begin
  695. p := Content.StartMod;
  696. TmpResult := False;
  697. Counter := 1;
  698. While Not(TmpResult) And
  699. (Counter <= Content.NrOfMods) Do
  700. Begin
  701. If (p.typ = ait_instruction) And
  702. RefInInstruction(Ref, p, @references_equal)
  703. Then TmpResult := True;
  704. Inc(Counter);
  705. GetNextInstruction(p,p)
  706. End;
  707. RefInSequence := TmpResult
  708. End;
  709. { ************************************************************************* }
  710. { ***************************** TAoptObj ********************************** }
  711. { ************************************************************************* }
  712. Constructor TAoptObj.create(_AsmL: TAsmList; _BlockStart, _BlockEnd: Tai;
  713. _LabelInfo: PLabelInfo);
  714. Begin
  715. AsmL := _AsmL;
  716. BlockStart := _BlockStart;
  717. BlockEnd := _BlockEnd;
  718. LabelInfo := _LabelInfo;
  719. CreateUsedRegs(UsedRegs);
  720. End;
  721. destructor TAOptObj.Destroy;
  722. var
  723. i : TRegisterType;
  724. begin
  725. for i:=low(TRegisterType) to high(TRegisterType) do
  726. UsedRegs[i].Destroy;
  727. inherited Destroy;
  728. end;
  729. procedure TAOptObj.CreateUsedRegs(var regs: TAllUsedRegs);
  730. var
  731. i : TRegisterType;
  732. begin
  733. for i:=low(TRegisterType) to high(TRegisterType) do
  734. Regs[i]:=TUsedRegs.Create(i);
  735. end;
  736. procedure TAOptObj.ClearUsedRegs;
  737. var
  738. i : TRegisterType;
  739. begin
  740. for i:=low(TRegisterType) to high(TRegisterType) do
  741. UsedRegs[i].Clear;
  742. end;
  743. procedure TAOptObj.UpdateUsedRegs(p : Tai);
  744. begin
  745. { this code is based on TUsedRegs.Update to avoid multiple passes through the asmlist,
  746. the code is duplicated here }
  747. repeat
  748. while assigned(p) and
  749. ((p.typ in (SkipInstr - [ait_RegAlloc])) or
  750. ((p.typ = ait_label) and
  751. labelCanBeSkipped(tai_label(p))) or
  752. ((p.typ = ait_marker) and
  753. (tai_Marker(p).Kind in [mark_AsmBlockEnd,mark_NoLineInfoStart,mark_NoLineInfoEnd]))) do
  754. p := tai(p.next);
  755. while assigned(p) and
  756. (p.typ=ait_RegAlloc) Do
  757. begin
  758. case tai_regalloc(p).ratype of
  759. ra_alloc :
  760. Include(UsedRegs[getregtype(tai_regalloc(p).reg)].UsedRegs, getsupreg(tai_regalloc(p).reg));
  761. ra_dealloc :
  762. Exclude(UsedRegs[getregtype(tai_regalloc(p).reg)].UsedRegs, getsupreg(tai_regalloc(p).reg));
  763. end;
  764. p := tai(p.next);
  765. end;
  766. until not(assigned(p)) or
  767. (not(p.typ in SkipInstr) and
  768. not((p.typ = ait_label) and
  769. labelCanBeSkipped(tai_label(p))));
  770. end;
  771. class procedure TAOptObj.UpdateUsedRegs(var Regs : TAllUsedRegs;p : Tai);
  772. var
  773. i : TRegisterType;
  774. begin
  775. for i:=low(TRegisterType) to high(TRegisterType) do
  776. Regs[i].Update(p);
  777. end;
  778. function TAOptObj.CopyUsedRegs(var dest: TAllUsedRegs): boolean;
  779. var
  780. i : TRegisterType;
  781. begin
  782. Result:=true;
  783. for i:=low(TRegisterType) to high(TRegisterType) do
  784. dest[i]:=TUsedRegs.Create_Regset(i,UsedRegs[i].GetUsedRegs);
  785. end;
  786. class procedure TAOptObj.ReleaseUsedRegs(const regs: TAllUsedRegs);
  787. var
  788. i : TRegisterType;
  789. begin
  790. for i:=low(TRegisterType) to high(TRegisterType) do
  791. regs[i].Free;
  792. end;
  793. class Function TAOptObj.RegInUsedRegs(reg : TRegister;regs : TAllUsedRegs) : boolean;
  794. begin
  795. result:=regs[getregtype(reg)].IsUsed(reg);
  796. end;
  797. class procedure TAOptObj.IncludeRegInUsedRegs(reg: TRegister;
  798. var regs: TAllUsedRegs);
  799. begin
  800. include(regs[getregtype(reg)].UsedRegs,getsupreg(Reg));
  801. end;
  802. class procedure TAOptObj.ExcludeRegFromUsedRegs(reg: TRegister;
  803. var regs: TAllUsedRegs);
  804. begin
  805. exclude(regs[getregtype(reg)].UsedRegs,getsupreg(Reg));
  806. end;
  807. function TAOptObj.GetAllocationString(const regs: TAllUsedRegs): string;
  808. var
  809. i : TRegisterType;
  810. j : TSuperRegister;
  811. begin
  812. Result:='';
  813. for i:=low(TRegisterType) to high(TRegisterType) do
  814. for j in regs[i].UsedRegs do
  815. Result:=Result+std_regname(newreg(i,j,R_SUBWHOLE))+' ';
  816. end;
  817. Function TAOptObj.FindLabel(L: TasmLabel; Var hp: Tai): Boolean;
  818. Var TempP: Tai;
  819. Begin
  820. TempP := hp;
  821. While Assigned(TempP) and
  822. (TempP.typ In SkipInstr + [ait_label,ait_align]) Do
  823. If (TempP.typ <> ait_Label) Or
  824. (Tai_label(TempP).labsym <> L)
  825. Then GetNextInstruction(TempP, TempP)
  826. Else
  827. Begin
  828. hp := TempP;
  829. FindLabel := True;
  830. exit
  831. End;
  832. FindLabel := False;
  833. End;
  834. Procedure TAOptObj.InsertLLItem(prev, foll, new_one : TLinkedListItem);
  835. Begin
  836. If Assigned(prev) Then
  837. If Assigned(foll) Then
  838. Begin
  839. If Assigned(new_one) Then
  840. Begin
  841. new_one.previous := prev;
  842. new_one.next := foll;
  843. prev.next := new_one;
  844. foll.previous := new_one;
  845. { should we update line information? }
  846. if (not (tai(new_one).typ in SkipLineInfo)) and
  847. (not (tai(foll).typ in SkipLineInfo)) then
  848. Tailineinfo(new_one).fileinfo := Tailineinfo(foll).fileinfo
  849. End
  850. End
  851. Else AsmL.Concat(new_one)
  852. Else If Assigned(Foll) Then AsmL.Insert(new_one)
  853. End;
  854. Function TAOptObj.SkipHead(P: Tai): Tai;
  855. Var OldP: Tai;
  856. Begin
  857. Repeat
  858. OldP := P;
  859. If (P.typ in SkipInstr) Or
  860. ((P.typ = ait_marker) And
  861. (Tai_Marker(P).Kind = mark_AsmBlockEnd)) Then
  862. GetNextInstruction(P, P)
  863. Else If ((P.Typ = Ait_Marker) And
  864. (Tai_Marker(P).Kind = mark_NoPropInfoStart)) Then
  865. { a marker of the type mark_NoPropInfoStart can't be the first instruction of a }
  866. { paasmoutput list }
  867. GetNextInstruction(Tai(P.Previous),P);
  868. If (P.Typ = Ait_Marker) And
  869. (Tai_Marker(P).Kind = mark_AsmBlockStart) Then
  870. Begin
  871. P := Tai(P.Next);
  872. While (P.typ <> Ait_Marker) Or
  873. (Tai_Marker(P).Kind <> mark_AsmBlockEnd) Do
  874. P := Tai(P.Next)
  875. End;
  876. Until P = OldP;
  877. SkipHead := P;
  878. End;
  879. Function TAOptObj.OpsEqual(const o1,o2:toper): Boolean;
  880. Begin
  881. if o1.typ=o2.typ then
  882. Case o1.typ Of
  883. Top_Reg :
  884. OpsEqual:=o1.reg=o2.reg;
  885. Top_Ref :
  886. OpsEqual := references_equal(o1.ref^, o2.ref^);
  887. Top_Const :
  888. OpsEqual:=o1.val=o2.val;
  889. Top_None :
  890. OpsEqual := True
  891. else OpsEqual := False
  892. End
  893. else
  894. OpsEqual := False;
  895. End;
  896. Function TAOptObj.FindRegAlloc(Reg: TRegister; StartPai: Tai): tai_regalloc;
  897. Begin
  898. Result:=nil;
  899. Repeat
  900. While Assigned(StartPai) And
  901. ((StartPai.typ in (SkipInstr - [ait_regAlloc])) Or
  902. {$if defined(MIPS) or defined(SPARC)}
  903. ((startpai.typ=ait_instruction) and (taicpu(startpai).opcode=A_NOP)) or
  904. {$endif MIPS or SPARC}
  905. ((StartPai.typ = ait_label) and
  906. Not(Tai_Label(StartPai).labsym.Is_Used))) Do
  907. StartPai := Tai(StartPai.Next);
  908. If Assigned(StartPai) And
  909. (StartPai.typ = ait_regAlloc) Then
  910. Begin
  911. if (tai_regalloc(StartPai).ratype=ra_alloc) and
  912. (getregtype(tai_regalloc(StartPai).Reg) = getregtype(Reg)) and
  913. (getsupreg(tai_regalloc(StartPai).Reg) = getsupreg(Reg)) then
  914. begin
  915. Result:=tai_regalloc(StartPai);
  916. exit;
  917. end;
  918. StartPai := Tai(StartPai.Next);
  919. End
  920. else
  921. exit;
  922. Until false;
  923. End;
  924. Function TAOptObj.FindRegAllocBackward(Reg: TRegister; StartPai: Tai): tai_regalloc;
  925. Begin
  926. Result:=nil;
  927. Repeat
  928. While Assigned(StartPai) And
  929. ((StartPai.typ in (SkipInstr - [ait_regAlloc])) Or
  930. ((StartPai.typ = ait_label) and
  931. Not(Tai_Label(StartPai).labsym.Is_Used))) Do
  932. StartPai := Tai(StartPai.Previous);
  933. If Assigned(StartPai) And
  934. (StartPai.typ = ait_regAlloc) Then
  935. Begin
  936. if (tai_regalloc(StartPai).ratype=ra_alloc) and
  937. SuperRegistersEqual(tai_regalloc(StartPai).Reg,Reg) then
  938. begin
  939. Result:=tai_regalloc(StartPai);
  940. exit;
  941. end;
  942. StartPai := Tai(StartPai.Previous);
  943. End
  944. else
  945. exit;
  946. Until false;
  947. End;
  948. function TAOptObj.FindRegDeAlloc(Reg: TRegister; StartPai: Tai): tai_regalloc;
  949. Begin
  950. Result:=nil;
  951. Repeat
  952. While Assigned(StartPai) And
  953. ((StartPai.typ in (SkipInstr - [ait_regAlloc])) Or
  954. ((StartPai.typ = ait_label) and
  955. Not(Tai_Label(StartPai).labsym.Is_Used))) Do
  956. StartPai := Tai(StartPai.Next);
  957. If Assigned(StartPai) And
  958. (StartPai.typ = ait_regAlloc) Then
  959. Begin
  960. if (tai_regalloc(StartPai).ratype=ra_dealloc) and
  961. (getregtype(tai_regalloc(StartPai).Reg) = getregtype(Reg)) and
  962. (getsupreg(tai_regalloc(StartPai).Reg) = getsupreg(Reg)) then
  963. begin
  964. Result:=tai_regalloc(StartPai);
  965. exit;
  966. end;
  967. StartPai := Tai(StartPai.Next);
  968. End
  969. else
  970. exit;
  971. Until false;
  972. End;
  973. function TAOptObj.RegUsedAfterInstruction(reg: Tregister; p: tai;var AllUsedRegs: TAllUsedRegs): Boolean;
  974. begin
  975. AllUsedRegs[getregtype(reg)].Update(tai(p.Next),true);
  976. RegUsedAfterInstruction :=
  977. AllUsedRegs[getregtype(reg)].IsUsed(reg) and
  978. not(regLoadedWithNewValue(reg,p)) and
  979. (
  980. not(GetNextInstruction(p,p)) or
  981. InstructionLoadsFromReg(reg,p) or
  982. not(regLoadedWithNewValue(reg,p))
  983. );
  984. end;
  985. function TAOptObj.RegEndOfLife(reg : TRegister;p : taicpu) : boolean;
  986. begin
  987. Result:=assigned(FindRegDealloc(reg,tai(p.Next))) or
  988. RegLoadedWithNewValue(reg,p);
  989. end;
  990. function SkipLabels(hp: tai; var hp2: tai): boolean;
  991. {skips all labels and returns the next "real" instruction}
  992. begin
  993. while assigned(hp.next) and
  994. (tai(hp.next).typ in SkipInstr + [ait_label,ait_align]) Do
  995. hp := tai(hp.next);
  996. if assigned(hp.next) then
  997. begin
  998. SkipLabels := True;
  999. hp2 := tai(hp.next)
  1000. end
  1001. else
  1002. begin
  1003. hp2 := hp;
  1004. SkipLabels := False
  1005. end;
  1006. end;
  1007. function FindAnyLabel(hp: tai; var l: tasmlabel): Boolean;
  1008. begin
  1009. FindAnyLabel := false;
  1010. while assigned(hp.next) and
  1011. (tai(hp.next).typ in (SkipInstr+[ait_align])) Do
  1012. hp := tai(hp.next);
  1013. if assigned(hp.next) and
  1014. (tai(hp.next).typ = ait_label) then
  1015. begin
  1016. FindAnyLabel := true;
  1017. l := tai_label(hp.next).labsym;
  1018. end
  1019. end;
  1020. {$push}
  1021. {$r-}
  1022. function TAOptObj.getlabelwithsym(sym: tasmlabel): tai;
  1023. begin
  1024. if (int64(sym.labelnr) >= int64(labelinfo^.lowlabel)) and
  1025. (int64(sym.labelnr) <= int64(labelinfo^.highlabel)) then { range check, a jump can go past an assembler block! }
  1026. getlabelwithsym := labelinfo^.labeltable^[sym.labelnr-labelinfo^.lowlabel].paiobj
  1027. else
  1028. getlabelwithsym := nil;
  1029. end;
  1030. {$pop}
  1031. { Returns True if hp is an unconditional jump to a label }
  1032. function IsJumpToLabelUncond(hp: taicpu): boolean;
  1033. begin
  1034. {$if defined(avr)}
  1035. result:=(hp.opcode in aopt_uncondjmp) and
  1036. {$else avr}
  1037. result:=(hp.opcode=aopt_uncondjmp) and
  1038. {$endif avr}
  1039. {$if defined(arm) or defined(aarch64)}
  1040. (hp.condition=c_None) and
  1041. {$endif arm or aarch64}
  1042. (hp.ops>0) and
  1043. (JumpTargetOp(hp)^.typ = top_ref) and
  1044. (JumpTargetOp(hp)^.ref^.symbol is TAsmLabel);
  1045. end;
  1046. { Returns True if hp is any jump to a label }
  1047. function IsJumpToLabel(hp: taicpu): boolean;
  1048. begin
  1049. result:=hp.is_jmp and
  1050. (hp.ops>0) and
  1051. (JumpTargetOp(hp)^.typ = top_ref) and
  1052. (JumpTargetOp(hp)^.ref^.symbol is TAsmLabel);
  1053. end;
  1054. procedure TAOptObj.RemoveDelaySlot(hp1:tai);
  1055. var
  1056. hp2: tai;
  1057. begin
  1058. hp2:=tai(hp1.next);
  1059. while assigned(hp2) and (hp2.typ in SkipInstr) do
  1060. hp2:=tai(hp2.next);
  1061. if assigned(hp2) and (hp2.typ=ait_instruction) and
  1062. (taicpu(hp2).opcode=A_NOP) then
  1063. begin
  1064. asml.remove(hp2);
  1065. hp2.free;
  1066. end;
  1067. { Anything except A_NOP must be left in place: these instructions
  1068. execute before branch, so code stays correct if branch is removed. }
  1069. end;
  1070. function TAOptObj.GetFinalDestination(hp: taicpu; level: longint): boolean;
  1071. {traces sucessive jumps to their final destination and sets it, e.g.
  1072. je l1 je l3
  1073. <code> <code>
  1074. l1: becomes l1:
  1075. je l2 je l3
  1076. <code> <code>
  1077. l2: l2:
  1078. jmp l3 jmp l3
  1079. the level parameter denotes how deeep we have already followed the jump,
  1080. to avoid endless loops with constructs such as "l5: ; jmp l5" }
  1081. var p1: tai;
  1082. {$if not defined(MIPS) and not defined(JVM)}
  1083. p2: tai;
  1084. l: tasmlabel;
  1085. {$endif}
  1086. begin
  1087. GetfinalDestination := false;
  1088. if level > 20 then
  1089. exit;
  1090. p1 := getlabelwithsym(tasmlabel(JumpTargetOp(hp)^.ref^.symbol));
  1091. if assigned(p1) then
  1092. begin
  1093. SkipLabels(p1,p1);
  1094. if (tai(p1).typ = ait_instruction) and
  1095. (taicpu(p1).is_jmp) then
  1096. if { the next instruction after the label where the jump hp arrives}
  1097. { is unconditional or of the same type as hp, so continue }
  1098. IsJumpToLabelUncond(taicpu(p1))
  1099. {$if not defined(MIPS) and not defined(JVM)}
  1100. { for MIPS, it isn't enough to check the condition; first operands must be same, too. }
  1101. or
  1102. conditions_equal(taicpu(p1).condition,hp.condition) or
  1103. { the next instruction after the label where the jump hp arrives
  1104. is the opposite of hp (so this one is never taken), but after
  1105. that one there is a branch that will be taken, so perform a
  1106. little hack: set p1 equal to this instruction (that's what the
  1107. last SkipLabels is for, only works with short bool evaluation)}
  1108. (conditions_equal(taicpu(p1).condition,inverse_cond(hp.condition)) and
  1109. SkipLabels(p1,p2) and
  1110. (p2.typ = ait_instruction) and
  1111. (taicpu(p2).is_jmp) and
  1112. (IsJumpToLabelUncond(taicpu(p2)) or
  1113. (conditions_equal(taicpu(p2).condition,hp.condition))) and
  1114. SkipLabels(p1,p1))
  1115. {$endif not MIPS and not JVM}
  1116. then
  1117. begin
  1118. { quick check for loops of the form "l5: ; jmp l5 }
  1119. if (tasmlabel(JumpTargetOp(taicpu(p1))^.ref^.symbol).labelnr =
  1120. tasmlabel(JumpTargetOp(hp)^.ref^.symbol).labelnr) then
  1121. exit;
  1122. if not GetFinalDestination(taicpu(p1),succ(level)) then
  1123. exit;
  1124. {$if defined(aarch64)}
  1125. { can't have conditional branches to
  1126. global labels on AArch64, because the
  1127. offset may become too big }
  1128. if not(taicpu(hp).condition in [C_None,C_AL,C_NV]) and
  1129. (tasmlabel(JumpTargetOp(taicpu(p1))^.ref^.symbol).bind<>AB_LOCAL) then
  1130. exit;
  1131. {$endif aarch64}
  1132. tasmlabel(JumpTargetOp(hp)^.ref^.symbol).decrefs;
  1133. JumpTargetOp(hp)^.ref^.symbol:=JumpTargetOp(taicpu(p1))^.ref^.symbol;
  1134. tasmlabel(JumpTargetOp(hp)^.ref^.symbol).increfs;
  1135. end
  1136. {$if not defined(MIPS) and not defined(JVM)}
  1137. else
  1138. if conditions_equal(taicpu(p1).condition,inverse_cond(hp.condition)) then
  1139. if not FindAnyLabel(p1,l) then
  1140. begin
  1141. {$ifdef finaldestdebug}
  1142. insertllitem(asml,p1,p1.next,tai_comment.Create(
  1143. strpnew('previous label inserted'))));
  1144. {$endif finaldestdebug}
  1145. current_asmdata.getjumplabel(l);
  1146. insertllitem(p1,p1.next,tai_label.Create(l));
  1147. tasmlabel(JumpTargetOp(hp)^.ref^.symbol).decrefs;
  1148. JumpTargetOp(hp)^.ref^.symbol := l;
  1149. l.increfs;
  1150. { this won't work, since the new label isn't in the labeltable }
  1151. { so it will fail the rangecheck. Labeltable should become a }
  1152. { hashtable to support this: }
  1153. { GetFinalDestination(asml, hp); }
  1154. end
  1155. else
  1156. begin
  1157. {$ifdef finaldestdebug}
  1158. insertllitem(asml,p1,p1.next,tai_comment.Create(
  1159. strpnew('next label reused'))));
  1160. {$endif finaldestdebug}
  1161. l.increfs;
  1162. tasmlabel(JumpTargetOp(hp)^.ref^.symbol).decrefs;
  1163. JumpTargetOp(hp)^.ref^.symbol := l;
  1164. if not GetFinalDestination(hp,succ(level)) then
  1165. exit;
  1166. end;
  1167. {$endif not MIPS and not JVM}
  1168. end;
  1169. GetFinalDestination := true;
  1170. end;
  1171. procedure TAOptObj.PrePeepHoleOpts;
  1172. var
  1173. p: tai;
  1174. begin
  1175. p := BlockStart;
  1176. ClearUsedRegs;
  1177. while (p <> BlockEnd) Do
  1178. begin
  1179. UpdateUsedRegs(tai(p.next));
  1180. if PrePeepHoleOptsCpu(p) then
  1181. continue;
  1182. UpdateUsedRegs(p);
  1183. p:=tai(p.next);
  1184. end;
  1185. end;
  1186. procedure TAOptObj.PeepHoleOptPass1;
  1187. var
  1188. p,hp1,hp2 : tai;
  1189. stoploop:boolean;
  1190. begin
  1191. repeat
  1192. stoploop:=true;
  1193. p := BlockStart;
  1194. ClearUsedRegs;
  1195. while (p <> BlockEnd) Do
  1196. begin
  1197. { I'am not sure why this is done, UsedRegs should reflect the register usage before the instruction
  1198. If an instruction needs the information of this, it can easily create a TempUsedRegs (FK)
  1199. UpdateUsedRegs(tai(p.next));
  1200. }
  1201. {$ifdef DEBUG_OPTALLOC}
  1202. if p.Typ=ait_instruction then
  1203. InsertLLItem(tai(p.Previous),p,tai_comment.create(strpnew(GetAllocationString(UsedRegs))));
  1204. {$endif DEBUG_OPTALLOC}
  1205. if PeepHoleOptPass1Cpu(p) then
  1206. begin
  1207. stoploop:=false;
  1208. UpdateUsedRegs(p);
  1209. continue;
  1210. end;
  1211. case p.Typ Of
  1212. ait_instruction:
  1213. begin
  1214. { Handle Jmp Optimizations }
  1215. if taicpu(p).is_jmp then
  1216. begin
  1217. { the following if-block removes all code between a jmp and the next label,
  1218. because it can never be executed
  1219. }
  1220. if IsJumpToLabelUncond(taicpu(p)) then
  1221. begin
  1222. hp2:=p;
  1223. while GetNextInstruction(hp2, hp1) and
  1224. (hp1.typ <> ait_label)
  1225. {$ifdef JVM}
  1226. and (hp1.typ <> ait_jcatch)
  1227. {$endif}
  1228. do
  1229. if not(hp1.typ in ([ait_label,ait_align]+skipinstr)) then
  1230. begin
  1231. if (hp1.typ = ait_instruction) and
  1232. taicpu(hp1).is_jmp and
  1233. (JumpTargetOp(taicpu(hp1))^.typ = top_ref) and
  1234. (JumpTargetOp(taicpu(hp1))^.ref^.symbol is TAsmLabel) then
  1235. TAsmLabel(JumpTargetOp(taicpu(hp1))^.ref^.symbol).decrefs;
  1236. { don't kill start/end of assembler block,
  1237. no-line-info-start/end etc }
  1238. if hp1.typ<>ait_marker then
  1239. begin
  1240. {$if defined(SPARC) or defined(MIPS) }
  1241. if (hp1.typ=ait_instruction) and (taicpu(hp1).is_jmp) then
  1242. RemoveDelaySlot(hp1);
  1243. {$endif SPARC or MIPS }
  1244. asml.remove(hp1);
  1245. hp1.free;
  1246. stoploop:=false;
  1247. end
  1248. else
  1249. hp2:=hp1;
  1250. end
  1251. else break;
  1252. end;
  1253. if GetNextInstruction(p, hp1) then
  1254. begin
  1255. SkipEntryExitMarker(hp1,hp1);
  1256. { remove unconditional jumps to a label coming right after them }
  1257. if IsJumpToLabelUncond(taicpu(p)) and
  1258. FindLabel(tasmlabel(JumpTargetOp(taicpu(p))^.ref^.symbol), hp1) and
  1259. { TODO: FIXME removing the first instruction fails}
  1260. (p<>blockstart) then
  1261. begin
  1262. tasmlabel(JumpTargetOp(taicpu(p))^.ref^.symbol).decrefs;
  1263. {$if defined(SPARC) or defined(MIPS)}
  1264. RemoveDelaySlot(p);
  1265. {$endif SPARC or MIPS}
  1266. hp2:=tai(hp1.next);
  1267. asml.remove(p);
  1268. p.free;
  1269. p:=hp2;
  1270. stoploop:=false;
  1271. continue;
  1272. end
  1273. else if assigned(hp1) then
  1274. begin
  1275. { change the following jumps:
  1276. jmp<cond> lab_1 jmp<cond_inverted> lab_2
  1277. jmp lab_2 >>> <code>
  1278. lab_1: lab_2:
  1279. <code>
  1280. lab_2:
  1281. }
  1282. if hp1.typ = ait_label then
  1283. SkipLabels(hp1,hp1);
  1284. if (tai(hp1).typ=ait_instruction) and
  1285. IsJumpToLabelUncond(taicpu(hp1)) and
  1286. GetNextInstruction(hp1, hp2) and
  1287. IsJumpToLabel(taicpu(p)) and
  1288. FindLabel(tasmlabel(JumpTargetOp(taicpu(p))^.ref^.symbol), hp2) then
  1289. begin
  1290. if (taicpu(p).opcode=aopt_condjmp)
  1291. {$if defined(arm) or defined(aarch64)}
  1292. and (taicpu(p).condition<>C_None)
  1293. {$endif arm or aarch64}
  1294. {$if defined(aarch64)}
  1295. { can't have conditional branches to
  1296. global labels on AArch64, because the
  1297. offset may become too big }
  1298. and (tasmlabel(JumpTargetOp(taicpu(hp1))^.ref^.symbol).bind=AB_LOCAL)
  1299. {$endif aarch64}
  1300. then
  1301. begin
  1302. taicpu(p).condition:=inverse_cond(taicpu(p).condition);
  1303. tai_label(hp2).labsym.decrefs;
  1304. JumpTargetOp(taicpu(p))^.ref^.symbol:=JumpTargetOp(taicpu(hp1))^.ref^.symbol;
  1305. { when freeing hp1, the reference count
  1306. isn't decreased, so don't increase
  1307. taicpu(p).oper[0]^.ref^.symbol.increfs;
  1308. }
  1309. {$if defined(SPARC) or defined(MIPS)}
  1310. RemoveDelaySlot(hp1);
  1311. {$endif SPARC or MIPS}
  1312. asml.remove(hp1);
  1313. hp1.free;
  1314. stoploop:=false;
  1315. GetFinalDestination(taicpu(p),0);
  1316. end
  1317. else
  1318. begin
  1319. GetFinalDestination(taicpu(p),0);
  1320. p:=tai(p.next);
  1321. continue;
  1322. end;
  1323. end
  1324. else if IsJumpToLabel(taicpu(p)) then
  1325. GetFinalDestination(taicpu(p),0);
  1326. end;
  1327. end;
  1328. end
  1329. else
  1330. { All other optimizes }
  1331. begin
  1332. end; { if is_jmp }
  1333. end;
  1334. end;
  1335. UpdateUsedRegs(p);
  1336. p:=tai(p.next);
  1337. end;
  1338. until stoploop or not(cs_opt_level3 in current_settings.optimizerswitches);
  1339. end;
  1340. procedure TAOptObj.PeepHoleOptPass2;
  1341. var
  1342. p: tai;
  1343. begin
  1344. p := BlockStart;
  1345. ClearUsedRegs;
  1346. while (p <> BlockEnd) Do
  1347. begin
  1348. UpdateUsedRegs(tai(p.next));
  1349. if PeepHoleOptPass2Cpu(p) then
  1350. continue;
  1351. UpdateUsedRegs(p);
  1352. p:=tai(p.next);
  1353. end;
  1354. end;
  1355. procedure TAOptObj.PostPeepHoleOpts;
  1356. var
  1357. p: tai;
  1358. begin
  1359. p := BlockStart;
  1360. ClearUsedRegs;
  1361. while (p <> BlockEnd) Do
  1362. begin
  1363. UpdateUsedRegs(tai(p.next));
  1364. if PostPeepHoleOptsCpu(p) then
  1365. continue;
  1366. UpdateUsedRegs(p);
  1367. p:=tai(p.next);
  1368. end;
  1369. end;
  1370. function TAOptObj.PrePeepHoleOptsCpu(var p : tai) : boolean;
  1371. begin
  1372. result := false;
  1373. end;
  1374. function TAOptObj.PeepHoleOptPass1Cpu(var p: tai): boolean;
  1375. begin
  1376. result := false;
  1377. end;
  1378. function TAOptObj.PeepHoleOptPass2Cpu(var p : tai) : boolean;
  1379. begin
  1380. result := false;
  1381. end;
  1382. function TAOptObj.PostPeepHoleOptsCpu(var p: tai): boolean;
  1383. begin
  1384. result := false;
  1385. end;
  1386. procedure TAOptObj.Debug_InsertInstrRegisterDependencyInfo;
  1387. var
  1388. p: tai;
  1389. ri: tregisterindex;
  1390. reg: TRegister;
  1391. commentstr: AnsiString;
  1392. registers_found: Boolean;
  1393. begin
  1394. p:=tai(AsmL.First);
  1395. while (p<>AsmL.Last) Do
  1396. begin
  1397. if p.typ=ait_instruction then
  1398. begin
  1399. commentstr:='Instruction reads';
  1400. registers_found:=false;
  1401. for ri in tregisterindex do
  1402. begin
  1403. reg:=regnumber_table[ri];
  1404. if (reg<>NR_NO) and InstructionLoadsFromReg(reg,p) then
  1405. begin
  1406. commentstr:=commentstr+' '+std_regname(reg);
  1407. registers_found:=true;
  1408. end;
  1409. end;
  1410. if not registers_found then
  1411. commentstr:=commentstr+' no registers';
  1412. commentstr:=commentstr+' and writes new values in';
  1413. registers_found:=false;
  1414. for ri in tregisterindex do
  1415. begin
  1416. reg:=regnumber_table[ri];
  1417. if (reg<>NR_NO) and RegLoadedWithNewValue(reg,p) then
  1418. begin
  1419. commentstr:=commentstr+' '+std_regname(reg);
  1420. registers_found:=true;
  1421. end;
  1422. end;
  1423. if not registers_found then
  1424. commentstr:=commentstr+' no registers';
  1425. AsmL.InsertAfter(tai_comment.Create(strpnew(commentstr)),p);
  1426. end;
  1427. p:=tai(p.next);
  1428. end;
  1429. end;
  1430. End.