aoptobj.pas 43 KB

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