aoptobj.pas 45 KB

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