aoptobj.pas 54 KB

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