aoptobj.pas 42 KB

1234567891011121314151617181920212223242526272829303132333435363738394041424344454647484950515253545556575859606162636465666768697071727374757677787980818283848586878889909192939495969798991001011021031041051061071081091101111121131141151161171181191201211221231241251261271281291301311321331341351361371381391401411421431441451461471481491501511521531541551561571581591601611621631641651661671681691701711721731741751761771781791801811821831841851861871881891901911921931941951961971981992002012022032042052062072082092102112122132142152162172182192202212222232242252262272282292302312322332342352362372382392402412422432442452462472482492502512522532542552562572582592602612622632642652662672682692702712722732742752762772782792802812822832842852862872882892902912922932942952962972982993003013023033043053063073083093103113123133143153163173183193203213223233243253263273283293303313323333343353363373383393403413423433443453463473483493503513523533543553563573583593603613623633643653663673683693703713723733743753763773783793803813823833843853863873883893903913923933943953963973983994004014024034044054064074084094104114124134144154164174184194204214224234244254264274284294304314324334344354364374384394404414424434444454464474484494504514524534544554564574584594604614624634644654664674684694704714724734744754764774784794804814824834844854864874884894904914924934944954964974984995005015025035045055065075085095105115125135145155165175185195205215225235245255265275285295305315325335345355365375385395405415425435445455465475485495505515525535545555565575585595605615625635645655665675685695705715725735745755765775785795805815825835845855865875885895905915925935945955965975985996006016026036046056066076086096106116126136146156166176186196206216226236246256266276286296306316326336346356366376386396406416426436446456466476486496506516526536546556566576586596606616626636646656666676686696706716726736746756766776786796806816826836846856866876886896906916926936946956966976986997007017027037047057067077087097107117127137147157167177187197207217227237247257267277287297307317327337347357367377387397407417427437447457467477487497507517527537547557567577587597607617627637647657667677687697707717727737747757767777787797807817827837847857867877887897907917927937947957967977987998008018028038048058068078088098108118128138148158168178188198208218228238248258268278288298308318328338348358368378388398408418428438448458468478488498508518528538548558568578588598608618628638648658668678688698708718728738748758768778788798808818828838848858868878888898908918928938948958968978988999009019029039049059069079089099109119129139149159169179189199209219229239249259269279289299309319329339349359369379389399409419429439449459469479489499509519529539549559569579589599609619629639649659669679689699709719729739749759769779789799809819829839849859869879889899909919929939949959969979989991000100110021003100410051006100710081009101010111012101310141015101610171018101910201021102210231024102510261027102810291030103110321033103410351036103710381039104010411042104310441045104610471048104910501051105210531054105510561057105810591060106110621063106410651066106710681069107010711072107310741075107610771078107910801081108210831084108510861087108810891090109110921093109410951096109710981099110011011102110311041105110611071108110911101111111211131114111511161117111811191120112111221123112411251126112711281129
  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,
  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(r1, r2: TReference): Boolean;
  45. //!!! FIXME
  46. TRegArray = Array[byte] of tsuperregister;
  47. TRegSet = Set of byte;
  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 = class
  54. Constructor create;
  55. Constructor create_regset(Const _RegSet: TRegSet);
  56. Destructor Destroy;override;
  57. { update the info with the pairegalloc objects coming after }
  58. { p }
  59. Procedure Update(p: Tai);
  60. { is Reg currently in use }
  61. Function IsUsed(Reg: TRegister): Boolean;
  62. { get all the currently used registers }
  63. Function GetUsedRegs: TRegSet;
  64. Private
  65. UsedRegs: TRegSet;
  66. End;
  67. { ************************************************************************* }
  68. { ******************* Contents of the integer registers ******************* }
  69. { ************************************************************************* }
  70. { size of the integer that holds the state number of a register. Can be any }
  71. { integer type, so it can be changed to reduce the size of the TContent }
  72. { structure or to improve alignment }
  73. TStateInt = Byte;
  74. TContent = Record
  75. { start and end of block instructions that defines the }
  76. { content of this register. If Typ = con_const, then }
  77. { Longint(StartMod) = value of the constant) }
  78. StartMod: Tai;
  79. { starts at 0, gets increased everytime the register is }
  80. { written to }
  81. WState: TStateInt;
  82. { starts at 0, gets increased everytime the register is read }
  83. { from }
  84. RState: TStateInt;
  85. { how many instructions starting with StarMod does the block }
  86. { consist of }
  87. NrOfMods: Byte;
  88. { the type of the content of the register: unknown, memory }
  89. { (variable) or constant }
  90. Typ: Byte;
  91. End;
  92. //!!! FIXME
  93. TRegContent = Array[byte] Of TContent;
  94. { ************************************************************************** }
  95. { information object with the contents of every register. Every Tai object }
  96. { gets one of these assigned: a pointer to it is stored in the OptInfo field }
  97. { ************************************************************************** }
  98. TPaiProp = class(TAoptBaseCpu)
  99. Regs: TRegContent;
  100. { info about allocation of general purpose integer registers }
  101. UsedRegs: TUsedRegs;
  102. { can this instruction be removed? }
  103. CanBeRemoved: Boolean;
  104. Constructor create;
  105. { checks the whole sequence of which (so regs[which].StartMod and and }
  106. { the next NrOfMods Tai objects) to see whether Reg is used somewhere, }
  107. { without it being loaded with something else first }
  108. Function RegInSequence(Reg, which: TRegister): Boolean;
  109. { destroy the contents of a register, as well as those whose contents }
  110. { are based on those of that register }
  111. Procedure DestroyReg(Reg: TRegister; var InstrSinceLastMod:
  112. TInstrSinceLastMod);
  113. { if the contents of WhichReg (can be R_NO in case of a constant) are }
  114. { written to memory at the location Ref, the contents of the registers }
  115. { that depend on Ref have to be destroyed }
  116. Procedure DestroyRefs(Const Ref: TReference; WhichReg: TRegister; var
  117. InstrSinceLastMod: TInstrSinceLastMod);
  118. { an instruction reads from operand o }
  119. Procedure ReadOp(const o:toper);
  120. { an instruction reads from reference Ref }
  121. Procedure ReadRef(Ref: PReference);
  122. { an instruction reads from register Reg }
  123. Procedure ReadReg(Reg: TRegister);
  124. { an instruction writes/modifies operand o and this has special }
  125. { side-effects or modifies the contents in such a way that we can't }
  126. { simply add this instruction to the sequence of instructions that }
  127. { describe the contents of the operand, so destroy it }
  128. Procedure DestroyOp(const o:Toper; var InstrSinceLastMod:
  129. TInstrSinceLastMod);
  130. { destroy the contents of all registers }
  131. Procedure DestroyAllRegs(var InstrSinceLastMod: TInstrSinceLastMod);
  132. { a register's contents are modified, but not destroyed (the new value }
  133. { depends on the old one) }
  134. Procedure ModifyReg(reg: TRegister; var InstrSinceLastMod:
  135. TInstrSinceLastMod);
  136. { an operand's contents are modified, but not destroyed (the new value }
  137. { depends on the old one) }
  138. Procedure ModifyOp(const oper: TOper; var InstrSinceLastMod:
  139. TInstrSinceLastMod);
  140. { increase the write state of a register (call every time a register is }
  141. { written to) }
  142. Procedure IncWState(Reg: TRegister);
  143. { increase the read state of a register (call every time a register is }
  144. { read from) }
  145. Procedure IncRState(Reg: TRegister);
  146. { get the write state of a register }
  147. Function GetWState(Reg: TRegister): TStateInt;
  148. { get the read state of a register }
  149. Function GetRState(Reg: TRegister): TStateInt;
  150. { get the type of contents of a register }
  151. Function GetRegContentType(Reg: TRegister): Byte;
  152. Destructor Done;
  153. Private
  154. Procedure IncState(var s: TStateInt);
  155. { returns whether the reference Ref is used somewhere in the loading }
  156. { sequence Content }
  157. Function RefInSequence(Const Ref: TReference; Content: TContent;
  158. RefsEq: TRefCompare): Boolean;
  159. { returns whether the instruction P reads from and/or writes }
  160. { to Reg }
  161. Function RefInInstruction(Const Ref: TReference; p: Tai;
  162. RefsEq: TRefCompare): Boolean;
  163. { returns whether two references with at least one pointing to an array }
  164. { may point to the same memory location }
  165. End;
  166. { ************************************************************************* }
  167. { ************************ Label information ****************************** }
  168. { ************************************************************************* }
  169. TLabelTableItem = Record
  170. PaiObj: Tai;
  171. End;
  172. {$ifndef TP}
  173. TLabelTable = Array[0..2500000] Of TLabelTableItem;
  174. {$else TP}
  175. TLabelTable = Array[0..(65520 div sizeof(TLabelTableItem))] Of TLabelTableItem;
  176. {$endif TP}
  177. PLabelTable = ^TLabelTable;
  178. PLabelInfo = ^TLabelInfo;
  179. TLabelInfo = Record
  180. { the highest and lowest label number occurring in the current code }
  181. { fragment }
  182. LowLabel, HighLabel: AWord;
  183. LabelDif: AWord;
  184. { table that contains the addresses of the Pai_Label objects associated
  185. with each label number }
  186. LabelTable: PLabelTable;
  187. End;
  188. { ************************************************************************* }
  189. { ********** General optimizer object, used to derive others from ********* }
  190. { ************************************************************************* }
  191. TAOptObj = class(TAoptBaseCpu)
  192. { the PAasmOutput list this optimizer instance works on }
  193. AsmL: TAasmOutput;
  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. { _AsmL is the PAasmOutpout list that has to be optimized, }
  202. { _BlockStart and _BlockEnd the start and the end of the block }
  203. { that has to be optimized and _LabelInfo a pointer to a }
  204. { TLabelInfo record }
  205. Constructor create(_AsmL: TAasmOutput; _BlockStart, _BlockEnd: Tai;
  206. _LabelInfo: PLabelInfo); virtual;
  207. { processor independent methods }
  208. { returns true if the label L is found between hp and the next }
  209. { instruction }
  210. Function FindLabel(L: TasmLabel; Var hp: Tai): Boolean;
  211. { inserts new_one between prev and foll in AsmL }
  212. Procedure InsertLLItem(prev, foll, new_one: TLinkedListItem);
  213. { If P is a Tai object releveant to the optimizer, P is returned
  214. If it is not relevant tot he optimizer, the first object after P
  215. that is relevant is returned }
  216. Function SkipHead(P: Tai): Tai;
  217. { returns true if the operands o1 and o2 are completely equal }
  218. Function OpsEqual(const o1,o2:toper): Boolean;
  219. { Returns true if a ait_alloc object for Reg is found in the block
  220. of Tai's starting with StartPai and ending with the next "real"
  221. instruction }
  222. Function FindRegAlloc(Reg: TRegister; StartPai: Tai): Boolean;
  223. { traces sucessive jumps to their final destination and sets it, e.g.
  224. je l1 je l3
  225. <code> <code>
  226. l1: becomes l1:
  227. je l2 je l3
  228. <code> <code>
  229. l2: l2:
  230. jmp l3 jmp l3
  231. the level parameter denotes how deeep we have already followed the jump,
  232. to avoid endless loops with constructs such as "l5: ; jmp l5" }
  233. function GetFinalDestination(hp: taicpu; level: longint): boolean;
  234. function getlabelwithsym(sym: tasmlabel): tai;
  235. { peephole optimizer }
  236. procedure PrePeepHoleOpts;
  237. procedure PeepHoleOptPass1;
  238. procedure PeepHoleOptPass2;
  239. procedure PostPeepHoleOpts;
  240. { processor dependent methods }
  241. // if it returns true, perform a "continue"
  242. function PeepHoleOptPass1Cpu(var p: tai): boolean; virtual;
  243. function PostPeepHoleOptsCpu(var p: tai): boolean; virtual;
  244. End;
  245. Function ArrayRefsEq(const r1, r2: TReference): Boolean;
  246. { ***************************** Implementation **************************** }
  247. Implementation
  248. uses
  249. globals,
  250. verbose,
  251. procinfo;
  252. { ************************************************************************* }
  253. { ******************************** TUsedRegs ****************************** }
  254. { ************************************************************************* }
  255. Constructor TUsedRegs.create;
  256. Begin
  257. UsedRegs := [];
  258. End;
  259. Constructor TUsedRegs.create_regset(Const _RegSet: TRegSet);
  260. Begin
  261. UsedRegs := _RegSet;
  262. End;
  263. Procedure TUsedRegs.Update(p: Tai);
  264. {updates UsedRegs with the RegAlloc Information coming after P}
  265. Begin
  266. Repeat
  267. While Assigned(p) And
  268. ((p.typ in (SkipInstr - [ait_RegAlloc])) or
  269. ((p.typ = ait_label) And
  270. Not(Tai_Label(p).l.is_used))) Do
  271. p := Tai(p.next);
  272. While Assigned(p) And
  273. (p.typ=ait_RegAlloc) Do
  274. Begin
  275. {!!!!!!!! FIXME
  276. if tai_regalloc(p).ratype=ra_alloc then
  277. UsedRegs := UsedRegs + [tai_regalloc(p).Reg]
  278. else
  279. UsedRegs := UsedRegs - [tai_regalloc(p).Reg];
  280. p := Tai(p.next);
  281. }
  282. End;
  283. Until Not(Assigned(p)) Or
  284. (Not(p.typ in SkipInstr) And
  285. Not((p.typ = ait_label) And
  286. Not(Tai_Label(p).l.is_used)));
  287. End;
  288. Function TUsedRegs.IsUsed(Reg: TRegister): Boolean;
  289. Begin
  290. //!!!!!!!!!!! IsUsed := Reg in UsedRegs
  291. End;
  292. Function TUsedRegs.GetUsedRegs: TRegSet;
  293. Begin
  294. GetUsedRegs := UsedRegs;
  295. End;
  296. Destructor TUsedRegs.Destroy;
  297. Begin
  298. inherited destroy;
  299. end;
  300. { ************************************************************************* }
  301. { **************************** TPaiProp *********************************** }
  302. { ************************************************************************* }
  303. Constructor TPaiProp.Create;
  304. Begin
  305. {!!!!!!
  306. UsedRegs.Init;
  307. CondRegs.init;
  308. }
  309. { DirFlag: TFlagContents; I386 specific}
  310. End;
  311. Function TPaiProp.RegInSequence(Reg, which: TRegister): Boolean;
  312. Var p: Tai;
  313. RegsChecked: TRegSet;
  314. content: TContent;
  315. Counter: Byte;
  316. TmpResult: Boolean;
  317. Begin
  318. {!!!!!!!!!!1
  319. RegsChecked := [];
  320. content := regs[which];
  321. p := content.StartMod;
  322. TmpResult := False;
  323. Counter := 1;
  324. While Not(TmpResult) And
  325. (Counter <= Content.NrOfMods) Do
  326. Begin
  327. If IsLoadMemReg(p) Then
  328. With PInstr(p)^.oper[LoadSrc]^.ref^ Do
  329. If (Base = ProcInfo.FramePointer)
  330. {$ifdef RefsHaveIndexReg}
  331. And (Index = R_NO)
  332. {$endif RefsHaveIndexReg} Then
  333. Begin
  334. RegsChecked := RegsChecked +
  335. [RegMaxSize(PInstr(p)^.oper[LoadDst]^.reg)];
  336. If Reg = RegMaxSize(PInstr(p)^.oper[LoadDst]^.reg) Then
  337. Break;
  338. End
  339. Else
  340. Begin
  341. If (Base = Reg) And
  342. Not(Base In RegsChecked)
  343. Then TmpResult := True;
  344. {$ifdef RefsHaveIndexReg}
  345. If Not(TmpResult) And
  346. (Index = Reg) And
  347. Not(Index In RegsChecked)
  348. Then TmpResult := True;
  349. {$Endif RefsHaveIndexReg}
  350. End
  351. Else TmpResult := RegInInstruction(Reg, p);
  352. Inc(Counter);
  353. GetNextInstruction(p,p)
  354. End;
  355. RegInSequence := TmpResult
  356. }
  357. End;
  358. Procedure TPaiProp.DestroyReg(Reg: TRegister; var InstrSinceLastMod:
  359. TInstrSinceLastMod);
  360. { Destroys the contents of the register Reg in the PPaiProp p1, as well as }
  361. { the contents of registers are loaded with a memory location based on Reg }
  362. Var TmpWState, TmpRState: Byte;
  363. Counter: TRegister;
  364. Begin
  365. {!!!!!!!
  366. Reg := RegMaxSize(Reg);
  367. If (Reg in [LoGPReg..HiGPReg]) Then
  368. For Counter := LoGPReg to HiGPReg Do
  369. With Regs[Counter] Do
  370. If (Counter = reg) Or
  371. ((Typ = Con_Ref) And
  372. RegInSequence(Reg, Counter)) Then
  373. Begin
  374. InstrSinceLastMod[Counter] := 0;
  375. IncWState(Counter);
  376. TmpWState := GetWState(Counter);
  377. TmpRState := GetRState(Counter);
  378. FillChar(Regs[Counter], SizeOf(TContent), 0);
  379. WState := TmpWState;
  380. RState := TmpRState
  381. End
  382. }
  383. End;
  384. Function ArrayRefsEq(const r1, r2: TReference): Boolean;
  385. Begin
  386. {!!!!!!!!!!
  387. ArrayRefsEq := (R1.Offset+R1.OffsetFixup = R2.Offset+R2.OffsetFixup) And
  388. {$ifdef refsHaveSegmentReg}
  389. (R1.Segment = R2.Segment) And
  390. {$endif}
  391. (R1.Base = R2.Base) And
  392. (R1.Symbol=R2.Symbol);
  393. }
  394. End;
  395. Procedure TPaiProp.DestroyRefs(Const Ref: TReference; WhichReg: TRegister;
  396. var InstrSinceLastMod: TInstrSinceLastMod);
  397. { destroys all registers which possibly contain a reference to Ref, WhichReg }
  398. { is the register whose contents are being written to memory (if this proc }
  399. { is called because of a "mov?? %reg, (mem)" instruction) }
  400. Var RefsEq: TRefCompare;
  401. Counter: TRegister;
  402. Begin
  403. {!!!!!!!!!!!
  404. WhichReg := RegMaxSize(WhichReg);
  405. If (Ref.base = procinfo.FramePointer) or
  406. Assigned(Ref.Symbol) Then
  407. Begin
  408. If
  409. {$ifdef refsHaveIndexReg}
  410. (Ref.Index = R_NO) And
  411. {$endif refsHaveIndexReg}
  412. (Not(Assigned(Ref.Symbol)) or
  413. (Ref.base = R_NO)) Then
  414. { local variable which is not an array }
  415. RefsEq := {$ifdef fpc}@{$endif}RefsEqual
  416. Else
  417. { local variable which is an array }
  418. RefsEq := {$ifdef fpc}@{$endif}ArrayRefsEq;
  419. {write something to a parameter, a local or global variable, so
  420. * with uncertain optimizations on:
  421. - destroy the contents of registers whose contents have somewhere a
  422. "mov?? (Ref), %reg". WhichReg (this is the register whose contents
  423. are being written to memory) is not destroyed if it's StartMod is
  424. of that form and NrOfMods = 1 (so if it holds ref, but is not a
  425. pointer or value based on Ref)
  426. * with uncertain optimizations off:
  427. - also destroy registers that contain any pointer}
  428. For Counter := LoGPReg to HiGPReg Do
  429. With Regs[Counter] Do
  430. Begin
  431. If (typ = Con_Ref) And
  432. ((Not(cs_UncertainOpts in aktglobalswitches) And
  433. (NrOfMods <> 1)
  434. ) Or
  435. (RefInSequence(Ref,Regs[Counter], RefsEq) And
  436. ((Counter <> WhichReg) Or
  437. ((NrOfMods <> 1) And
  438. {StarMod is always of the type ait_instruction}
  439. (PInstr(StartMod)^.oper[0].typ = top_ref) And
  440. RefsEq(PInstr(StartMod)^.oper[0].ref^, Ref)
  441. )
  442. )
  443. )
  444. )
  445. Then
  446. DestroyReg(Counter, InstrSinceLastMod)
  447. End
  448. End
  449. Else
  450. {write something to a pointer location, so
  451. * with uncertain optimzations on:
  452. - do not destroy registers which contain a local/global variable or a
  453. parameter, except if DestroyRefs is called because of a "movsl"
  454. * with uncertain optimzations off:
  455. - destroy every register which contains a memory location
  456. }
  457. For Counter := LoGPReg to HiGPReg Do
  458. With Regs[Counter] Do
  459. If (typ = Con_Ref) And
  460. (Not(cs_UncertainOpts in aktglobalswitches) Or
  461. {$ifdef x86}
  462. {for movsl}
  463. (Ref.Base = R_EDI) Or
  464. {$endif}
  465. {don't destroy if reg contains a parameter, local or global variable}
  466. Not((NrOfMods = 1) And
  467. (PInstr(StartMod)^.oper[0].typ = top_ref) And
  468. ((PInstr(StartMod)^.oper[0].ref^.base = ProcInfo.FramePointer) Or
  469. Assigned(PInstr(StartMod)^.oper[0].ref^.Symbol)
  470. )
  471. )
  472. )
  473. Then DestroyReg(Counter, InstrSinceLastMod)
  474. }
  475. End;
  476. Procedure TPaiProp.DestroyAllRegs(var InstrSinceLastMod: TInstrSinceLastMod);
  477. Var Counter: TRegister;
  478. Begin {initializes/desrtoys all registers}
  479. {!!!!!!!!!
  480. For Counter := LoGPReg To HiGPReg Do
  481. Begin
  482. ReadReg(Counter);
  483. DestroyReg(Counter, InstrSinceLastMod);
  484. End;
  485. CondRegs.Init;
  486. { FPURegs.Init; }
  487. }
  488. End;
  489. Procedure TPaiProp.DestroyOp(const o:Toper; var InstrSinceLastMod:
  490. TInstrSinceLastMod);
  491. Begin
  492. {!!!!!!!
  493. Case o.typ Of
  494. top_reg: DestroyReg(o.reg, InstrSinceLastMod);
  495. top_ref:
  496. Begin
  497. ReadRef(o.ref);
  498. DestroyRefs(o.ref^, R_NO, InstrSinceLastMod);
  499. End;
  500. top_symbol:;
  501. End;
  502. }
  503. End;
  504. Procedure TPaiProp.ReadReg(Reg: TRegister);
  505. Begin
  506. {!!!!!!!
  507. Reg := RegMaxSize(Reg);
  508. If Reg in General_Registers Then
  509. IncRState(RegMaxSize(Reg))
  510. }
  511. End;
  512. Procedure TPaiProp.ReadRef(Ref: PReference);
  513. Begin
  514. {!!!!!!!
  515. If Ref^.Base <> R_NO Then
  516. ReadReg(Ref^.Base);
  517. {$ifdef refsHaveIndexReg}
  518. If Ref^.Index <> R_NO Then
  519. ReadReg(Ref^.Index);
  520. {$endif}
  521. }
  522. End;
  523. Procedure TPaiProp.ReadOp(const o:toper);
  524. Begin
  525. Case o.typ Of
  526. top_reg: ReadReg(o.reg);
  527. top_ref: ReadRef(o.ref);
  528. else
  529. internalerror(200410241);
  530. End;
  531. End;
  532. Procedure TPaiProp.ModifyReg(reg: TRegister; Var InstrSinceLastMod:
  533. TInstrSinceLastMod);
  534. Begin
  535. {!!!!!!!
  536. With Regs[reg] Do
  537. If (Typ = Con_Ref)
  538. Then
  539. Begin
  540. IncState(WState);
  541. {also store how many instructions are part of the sequence in the first
  542. instructions PPaiProp, so it can be easily accessed from within
  543. CheckSequence}
  544. Inc(NrOfMods, InstrSinceLastMod[Reg]);
  545. PPaiProp(StartMod.OptInfo)^.Regs[Reg].NrOfMods := NrOfMods;
  546. InstrSinceLastMod[Reg] := 0;
  547. End
  548. Else
  549. DestroyReg(Reg, InstrSinceLastMod);
  550. }
  551. End;
  552. Procedure TPaiProp.ModifyOp(const oper: TOper; var InstrSinceLastMod:
  553. TInstrSinceLastMod);
  554. Begin
  555. If oper.typ = top_reg Then
  556. ModifyReg(RegMaxSize(oper.reg),InstrSinceLastMod)
  557. Else
  558. Begin
  559. ReadOp(oper);
  560. DestroyOp(oper, InstrSinceLastMod);
  561. End
  562. End;
  563. Procedure TPaiProp.IncWState(Reg: TRegister);{$ifdef inl} inline;{$endif inl}
  564. Begin
  565. //!!!! IncState(Regs[Reg].WState);
  566. End;
  567. Procedure TPaiProp.IncRState(Reg: TRegister);{$ifdef inl} inline;{$endif inl}
  568. Begin
  569. //!!!! IncState(Regs[Reg].RState);
  570. End;
  571. Function TPaiProp.GetWState(Reg: TRegister): TStateInt; {$ifdef inl} inline;{$endif inl}
  572. Begin
  573. //!!!! GetWState := Regs[Reg].WState
  574. End;
  575. Function TPaiProp.GetRState(Reg: TRegister): TStateInt; {$ifdef inl} inline;{$endif inl}
  576. Begin
  577. //!!!! GetRState := Regs[Reg].RState
  578. End;
  579. Function TPaiProp.GetRegContentType(Reg: TRegister): Byte; {$ifdef inl} inline;{$endif inl}
  580. Begin
  581. //!!!! GetRegContentType := Regs[Reg].typ
  582. End;
  583. Destructor TPaiProp.Done;
  584. Begin
  585. //!!!! UsedRegs.Done;
  586. //!!!! CondRegs.Done;
  587. { DirFlag: TFlagContents; I386 specific}
  588. End;
  589. { ************************ private TPaiProp stuff ************************* }
  590. Procedure TPaiProp.IncState(Var s: TStateInt); {$ifdef inl} inline;{$endif inl}
  591. Begin
  592. If s <> High(TStateInt) Then Inc(s)
  593. Else s := 0
  594. End;
  595. Function TPaiProp.RefInInstruction(Const Ref: TReference; p: Tai;
  596. RefsEq: TRefCompare): Boolean;
  597. Var Count: AWord;
  598. TmpResult: Boolean;
  599. Begin
  600. TmpResult := False;
  601. If (p.typ = ait_instruction) Then
  602. Begin
  603. Count := 0;
  604. Repeat
  605. If (TInstr(p).oper[Count]^.typ = Top_Ref) Then
  606. TmpResult := RefsEq(Ref, PInstr(p)^.oper[Count]^.ref^);
  607. Inc(Count);
  608. Until (Count = MaxOps) or TmpResult;
  609. End;
  610. RefInInstruction := TmpResult;
  611. End;
  612. Function TPaiProp.RefInSequence(Const Ref: TReference; Content: TContent;
  613. RefsEq: TRefCompare): Boolean;
  614. Var p: Tai;
  615. Counter: Byte;
  616. TmpResult: Boolean;
  617. Begin
  618. p := Content.StartMod;
  619. TmpResult := False;
  620. Counter := 1;
  621. While Not(TmpResult) And
  622. (Counter <= Content.NrOfMods) Do
  623. Begin
  624. If (p.typ = ait_instruction) And
  625. RefInInstruction(Ref, p, {$ifdef fpc}@{$endif}references_equal)
  626. Then TmpResult := True;
  627. Inc(Counter);
  628. GetNextInstruction(p,p)
  629. End;
  630. RefInSequence := TmpResult
  631. End;
  632. { ************************************************************************* }
  633. { ***************************** TAoptObj ********************************** }
  634. { ************************************************************************* }
  635. Constructor TAoptObj.create(_AsmL: TAasmOutput; _BlockStart, _BlockEnd: Tai;
  636. _LabelInfo: PLabelInfo);
  637. Begin
  638. AsmL := _AsmL;
  639. BlockStart := _BlockStart;
  640. BlockEnd := _BlockEnd;
  641. LabelInfo := _LabelInfo
  642. End;
  643. Function TAOptObj.FindLabel(L: TasmLabel; Var hp: Tai): Boolean;
  644. Var TempP: Tai;
  645. Begin
  646. TempP := hp;
  647. While Assigned(TempP) and
  648. (TempP.typ In SkipInstr + [ait_label]) Do
  649. If (TempP.typ <> ait_Label) Or
  650. (Tai_label(TempP).l <> L)
  651. Then GetNextInstruction(TempP, TempP)
  652. Else
  653. Begin
  654. hp := TempP;
  655. FindLabel := True;
  656. exit
  657. End;
  658. FindLabel := False;
  659. End;
  660. Procedure TAOptObj.InsertLLItem(prev, foll, new_one : TLinkedListItem);
  661. Begin
  662. If Assigned(prev) Then
  663. If Assigned(foll) Then
  664. Begin
  665. If Assigned(new_one) Then
  666. Begin
  667. new_one.previous := prev;
  668. new_one.next := foll;
  669. prev.next := new_one;
  670. foll.previous := new_one;
  671. { should we update line information? }
  672. if (not (tai(new_one).typ in SkipLineInfo)) and
  673. (not (tai(foll).typ in SkipLineInfo)) then
  674. Tailineinfo(new_one).fileinfo := Tailineinfo(foll).fileinfo
  675. End
  676. End
  677. Else AsmL.Concat(new_one)
  678. Else If Assigned(Foll) Then AsmL.Insert(new_one)
  679. End;
  680. Function TAOptObj.SkipHead(P: Tai): Tai;
  681. Var OldP: Tai;
  682. Begin
  683. Repeat
  684. OldP := P;
  685. If (P.typ in SkipInstr) Or
  686. ((P.typ = ait_marker) And
  687. (Tai_Marker(P).Kind = AsmBlockEnd)) Then
  688. GetNextInstruction(P, P)
  689. Else If ((P.Typ = Ait_Marker) And
  690. (Tai_Marker(P).Kind = NoPropInfoStart)) Then
  691. { a marker of the type NoPropInfoStart can't be the first instruction of a }
  692. { paasmoutput list }
  693. GetNextInstruction(Tai(P.Previous),P);
  694. If (P.Typ = Ait_Marker) And
  695. (Tai_Marker(P).Kind = AsmBlockStart) Then
  696. Begin
  697. P := Tai(P.Next);
  698. While (P.typ <> Ait_Marker) Or
  699. (Tai_Marker(P).Kind <> AsmBlockEnd) Do
  700. P := Tai(P.Next)
  701. End;
  702. Until P = OldP;
  703. SkipHead := P;
  704. End;
  705. Function TAOptObj.OpsEqual(const o1,o2:toper): Boolean;
  706. Begin
  707. if o1.typ=o2.typ then
  708. Case o1.typ Of
  709. Top_Reg :
  710. OpsEqual:=o1.reg=o2.reg;
  711. Top_Ref :
  712. OpsEqual := references_equal(o1.ref^, o2.ref^);
  713. Top_Const :
  714. OpsEqual:=o1.val=o2.val;
  715. Top_None :
  716. OpsEqual := True
  717. else OpsEqual := False
  718. End;
  719. End;
  720. Function TAOptObj.FindRegAlloc(Reg: TRegister; StartPai: Tai): Boolean;
  721. Begin
  722. FindRegAlloc:=False;
  723. Repeat
  724. While Assigned(StartPai) And
  725. ((StartPai.typ in (SkipInstr - [ait_regAlloc])) Or
  726. ((StartPai.typ = ait_label) and
  727. Not(Tai_Label(StartPai).l.Is_Used))) Do
  728. StartPai := Tai(StartPai.Next);
  729. If Assigned(StartPai) And
  730. (StartPai.typ = ait_regAlloc) and (tai_regalloc(StartPai).ratype=ra_alloc) Then
  731. Begin
  732. if tai_regalloc(StartPai).Reg = Reg then
  733. begin
  734. FindRegAlloc:=true;
  735. exit;
  736. end;
  737. StartPai := Tai(StartPai.Next);
  738. End
  739. else
  740. exit;
  741. Until false;
  742. End;
  743. function SkipLabels(hp: tai; var hp2: tai): boolean;
  744. {skips all labels and returns the next "real" instruction}
  745. begin
  746. while assigned(hp.next) and
  747. (tai(hp.next).typ in SkipInstr + [ait_label,ait_align]) Do
  748. hp := tai(hp.next);
  749. if assigned(hp.next) then
  750. begin
  751. SkipLabels := True;
  752. hp2 := tai(hp.next)
  753. end
  754. else
  755. begin
  756. hp2 := hp;
  757. SkipLabels := False
  758. end;
  759. end;
  760. function FindAnyLabel(hp: tai; var l: tasmlabel): Boolean;
  761. begin
  762. FindAnyLabel := false;
  763. while assigned(hp.next) and
  764. (tai(hp.next).typ in (SkipInstr+[ait_align])) Do
  765. hp := tai(hp.next);
  766. if assigned(hp.next) and
  767. (tai(hp.next).typ = ait_label) then
  768. begin
  769. FindAnyLabel := true;
  770. l := tai_label(hp.next).l;
  771. end
  772. end;
  773. {$ifopt r+}
  774. {$define rangewason}
  775. {$r-}
  776. {$endif}
  777. function tAOptObj.getlabelwithsym(sym: tasmlabel): tai;
  778. begin
  779. if (sym.labelnr >= labelinfo^.lowlabel) and
  780. (sym.labelnr <= labelinfo^.highlabel) then { range check, a jump can go past an assembler block! }
  781. getlabelwithsym := labelinfo^.labeltable^[sym.labelnr-labelinfo^.lowlabel].paiobj
  782. else
  783. getlabelwithsym := nil;
  784. end;
  785. {$ifdef rangewason}
  786. {$r+}
  787. {$undef rangewason}
  788. {$endif}
  789. function TAOptObj.GetFinalDestination(hp: taicpu; level: longint): boolean;
  790. {traces sucessive jumps to their final destination and sets it, e.g.
  791. je l1 je l3
  792. <code> <code>
  793. l1: becomes l1:
  794. je l2 je l3
  795. <code> <code>
  796. l2: l2:
  797. jmp l3 jmp l3
  798. the level parameter denotes how deeep we have already followed the jump,
  799. to avoid endless loops with constructs such as "l5: ; jmp l5" }
  800. var p1, p2: tai;
  801. l: tasmlabel;
  802. begin
  803. GetfinalDestination := false;
  804. if level > 20 then
  805. exit;
  806. p1 := getlabelwithsym(tasmlabel(hp.oper[0]^.ref^.symbol));
  807. if assigned(p1) then
  808. begin
  809. SkipLabels(p1,p1);
  810. if (tai(p1).typ = ait_instruction) and
  811. (taicpu(p1).is_jmp) then
  812. if { the next instruction after the label where the jump hp arrives}
  813. { is unconditional or of the same type as hp, so continue }
  814. (((taicpu(p1).opcode = aopt_uncondjmp) and
  815. (taicpu(p1).oper[0]^.typ = top_ref) and
  816. (assigned(taicpu(p1).oper[0]^.ref^.symbol)) and
  817. (taicpu(p1).oper[0]^.ref^.symbol is TAsmLabel)) or
  818. conditions_equal(taicpu(p1).condition,hp.condition)) or
  819. { the next instruction after the label where the jump hp arrives}
  820. { is the opposite of hp (so this one is never taken), but after }
  821. { that one there is a branch that will be taken, so perform a }
  822. { little hack: set p1 equal to this instruction (that's what the}
  823. { last SkipLabels is for, only works with short bool evaluation)}
  824. (conditions_equal(taicpu(p1).condition,inverse_cond(hp.condition)) and
  825. SkipLabels(p1,p2) and
  826. (p2.typ = ait_instruction) and
  827. (taicpu(p2).is_jmp) and
  828. (((taicpu(p2).opcode = aopt_uncondjmp) and
  829. (taicpu(p2).oper[0]^.typ = top_ref) and
  830. (assigned(taicpu(p2).oper[0]^.ref^.symbol)) and
  831. (taicpu(p2).oper[0]^.ref^.symbol is TAsmLabel)) or
  832. (conditions_equal(taicpu(p2).condition,hp.condition))) and
  833. SkipLabels(p1,p1)) then
  834. begin
  835. { quick check for loops of the form "l5: ; jmp l5 }
  836. if (tasmlabel(taicpu(p1).oper[0]^.ref^.symbol).labelnr =
  837. tasmlabel(hp.oper[0]^.ref^.symbol).labelnr) then
  838. exit;
  839. if not GetFinalDestination(taicpu(p1),succ(level)) then
  840. exit;
  841. tasmlabel(hp.oper[0]^.ref^.symbol).decrefs;
  842. hp.oper[0]^.ref^.symbol:=taicpu(p1).oper[0]^.ref^.symbol;
  843. tasmlabel(hp.oper[0]^.ref^.symbol).increfs;
  844. end
  845. else
  846. if conditions_equal(taicpu(p1).condition,inverse_cond(hp.condition)) then
  847. if not FindAnyLabel(p1,l) then
  848. begin
  849. {$ifdef finaldestdebug}
  850. insertllitem(asml,p1,p1.next,tai_comment.Create(
  851. strpnew('previous label inserted'))));
  852. {$endif finaldestdebug}
  853. objectlibrary.getjumplabel(l);
  854. insertllitem(p1,p1.next,tai_label.Create(l));
  855. tasmlabel(taicpu(hp).oper[0]^.ref^.symbol).decrefs;
  856. hp.oper[0]^.ref^.symbol := l;
  857. l.increfs;
  858. { this won't work, since the new label isn't in the labeltable }
  859. { so it will fail the rangecheck. Labeltable should become a }
  860. { hashtable to support this: }
  861. { GetFinalDestination(asml, hp); }
  862. end
  863. else
  864. begin
  865. {$ifdef finaldestdebug}
  866. insertllitem(asml,p1,p1.next,tai_comment.Create(
  867. strpnew('next label reused'))));
  868. {$endif finaldestdebug}
  869. l.increfs;
  870. hp.oper[0]^.ref^.symbol := l;
  871. if not GetFinalDestination(hp,succ(level)) then
  872. exit;
  873. end;
  874. end;
  875. GetFinalDestination := true;
  876. end;
  877. procedure TAOptObj.PrePeepHoleOpts;
  878. begin
  879. end;
  880. procedure TAOptObj.PeepHoleOptPass1;
  881. var
  882. p,hp1,hp2 : tai;
  883. begin
  884. p := BlockStart;
  885. //!!!! UsedRegs := [];
  886. while (p <> BlockEnd) Do
  887. begin
  888. //!!!! UpDateUsedRegs(UsedRegs, tai(p.next));
  889. if PeepHoleOptPass1Cpu(p) then
  890. continue;
  891. case p.Typ Of
  892. ait_instruction:
  893. begin
  894. { Handle Jmp Optimizations }
  895. if taicpu(p).is_jmp then
  896. begin
  897. { the following if-block removes all code between a jmp and the next label,
  898. because it can never be executed
  899. }
  900. if (taicpu(p).opcode = aopt_uncondjmp) and
  901. (taicpu(p).oper[0]^.typ = top_ref) and
  902. (assigned(taicpu(p).oper[0]^.ref^.symbol)) and
  903. (taicpu(p).oper[0]^.ref^.symbol is TAsmLabel) then
  904. begin
  905. while GetNextInstruction(p, hp1) and
  906. (hp1.typ <> ait_label) do
  907. if not(hp1.typ in ([ait_label,ait_align]+skipinstr)) then
  908. begin
  909. asml.remove(hp1);
  910. hp1.free;
  911. end
  912. else break;
  913. end;
  914. { remove jumps to a label coming right after them }
  915. if GetNextInstruction(p, hp1) then
  916. begin
  917. if FindLabel(tasmlabel(taicpu(p).oper[0]^.ref^.symbol), hp1) and
  918. {$warning FIXME removing the first instruction fails}
  919. (p<>blockstart) then
  920. begin
  921. hp2:=tai(hp1.next);
  922. asml.remove(p);
  923. p.free;
  924. p:=hp2;
  925. continue;
  926. end
  927. else
  928. begin
  929. if hp1.typ = ait_label then
  930. SkipLabels(hp1,hp1);
  931. if (tai(hp1).typ=ait_instruction) and
  932. (taicpu(hp1).opcode=aopt_uncondjmp) and
  933. (taicpu(hp1).oper[0]^.typ = top_ref) and
  934. (assigned(taicpu(hp1).oper[0]^.ref^.symbol)) and
  935. (taicpu(hp1).oper[0]^.ref^.symbol is TAsmLabel) and
  936. GetNextInstruction(hp1, hp2) and
  937. FindLabel(tasmlabel(taicpu(p).oper[0]^.ref^.symbol), hp2) then
  938. begin
  939. if taicpu(p).opcode=aopt_condjmp then
  940. begin
  941. taicpu(p).condition:=inverse_cond(taicpu(p).condition);
  942. tai_label(hp2).l.decrefs;
  943. taicpu(p).oper[0]^.ref^.symbol:=taicpu(hp1).oper[0]^.ref^.symbol;
  944. { when freeing hp1, the reference count
  945. isn't decreased, so don't increase
  946. taicpu(p).oper[0]^.ref^.symbol.increfs;
  947. }
  948. {$ifdef SPARC}
  949. hp2:=tai(hp1.next);
  950. asml.remove(hp2);
  951. hp2.free;
  952. {$endif SPARC}
  953. asml.remove(hp1);
  954. hp1.free;
  955. GetFinalDestination(taicpu(p),0);
  956. end
  957. else
  958. begin
  959. GetFinalDestination(taicpu(p),0);
  960. p:=tai(p.next);
  961. continue;
  962. end;
  963. end
  964. else
  965. GetFinalDestination(taicpu(p),0);
  966. end;
  967. end;
  968. end
  969. else
  970. { All other optimizes }
  971. begin
  972. end; { if is_jmp }
  973. end;
  974. end;
  975. //!!!!!!!! updateUsedRegs(UsedRegs,p);
  976. p:=tai(p.next);
  977. end;
  978. end;
  979. procedure TAOptObj.PeepHoleOptPass2;
  980. begin
  981. end;
  982. procedure TAOptObj.PostPeepHoleOpts;
  983. var
  984. p: tai;
  985. begin
  986. p := BlockStart;
  987. //!!!! UsedRegs := [];
  988. while (p <> BlockEnd) Do
  989. begin
  990. //!!!! UpDateUsedRegs(UsedRegs, tai(p.next));
  991. if PostPeepHoleOptsCpu(p) then
  992. continue;
  993. //!!!!!!!! updateUsedRegs(UsedRegs,p);
  994. p:=tai(p.next);
  995. end;
  996. end;
  997. function TAOptObj.PeepHoleOptPass1Cpu(var p: tai): boolean;
  998. begin
  999. result := false;
  1000. end;
  1001. function TAOptObj.PostPeepHoleOptsCpu(var p: tai): boolean;
  1002. begin
  1003. result := false;
  1004. end;
  1005. End.