aoptobj.pas 44 KB

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