aoptobj.pas 64 KB

123456789101112131415161718192021222324252627282930313233343536373839404142434445464748495051525354555657585960616263646566676869707172737475767778798081828384858687888990919293949596979899100101102103104105106107108109110111112113114115116117118119120121122123124125126127128129130131132133134135136137138139140141142143144145146147148149150151152153154155156157158159160161162163164165166167168169170171172173174175176177178179180181182183184185186187188189190191192193194195196197198199200201202203204205206207208209210211212213214215216217218219220221222223224225226227228229230231232233234235236237238239240241242243244245246247248249250251252253254255256257258259260261262263264265266267268269270271272273274275276277278279280281282283284285286287288289290291292293294295296297298299300301302303304305306307308309310311312313314315316317318319320321322323324325326327328329330331332333334335336337338339340341342343344345346347348349350351352353354355356357358359360361362363364365366367368369370371372373374375376377378379380381382383384385386387388389390391392393394395396397398399400401402403404405406407408409410411412413414415416417418419420421422423424425426427428429430431432433434435436437438439440441442443444445446447448449450451452453454455456457458459460461462463464465466467468469470471472473474475476477478479480481482483484485486487488489490491492493494495496497498499500501502503504505506507508509510511512513514515516517518519520521522523524525526527528529530531532533534535536537538539540541542543544545546547548549550551552553554555556557558559560561562563564565566567568569570571572573574575576577578579580581582583584585586587588589590591592593594595596597598599600601602603604605606607608609610611612613614615616617618619620621622623624625626627628629630631632633634635636637638639640641642643644645646647648649650651652653654655656657658659660661662663664665666667668669670671672673674675676677678679680681682683684685686687688689690691692693694695696697698699700701702703704705706707708709710711712713714715716717718719720721722723724725726727728729730731732733734735736737738739740741742743744745746747748749750751752753754755756757758759760761762763764765766767768769770771772773774775776777778779780781782783784785786787788789790791792793794795796797798799800801802803804805806807808809810811812813814815816817818819820821822823824825826827828829830831832833834835836837838839840841842843844845846847848849850851852853854855856857858859860861862863864865866867868869870871872873874875876877878879880881882883884885886887888889890891892893894895896897898899900901902903904905906907908909910911912913914915916917918919920921922923924925926927928929930931932933934935936937938939940941942943944945946947948949950951952953954955956957958959960961962963964965966967968969970971972973974975976977978979980981982983984985986987988989990991992993994995996997998999100010011002100310041005100610071008100910101011101210131014101510161017101810191020102110221023102410251026102710281029103010311032103310341035103610371038103910401041104210431044104510461047104810491050105110521053105410551056105710581059106010611062106310641065106610671068106910701071107210731074107510761077107810791080108110821083108410851086108710881089109010911092109310941095109610971098109911001101110211031104110511061107110811091110111111121113111411151116111711181119112011211122112311241125112611271128112911301131113211331134113511361137113811391140114111421143114411451146114711481149115011511152115311541155115611571158115911601161116211631164116511661167116811691170117111721173117411751176117711781179118011811182118311841185118611871188118911901191119211931194119511961197119811991200120112021203120412051206120712081209121012111212121312141215121612171218121912201221122212231224122512261227122812291230123112321233123412351236123712381239124012411242124312441245124612471248124912501251125212531254125512561257125812591260126112621263126412651266126712681269127012711272127312741275127612771278127912801281128212831284128512861287128812891290129112921293129412951296129712981299130013011302130313041305130613071308130913101311131213131314131513161317131813191320132113221323132413251326132713281329133013311332133313341335133613371338133913401341134213431344134513461347134813491350135113521353135413551356135713581359136013611362136313641365136613671368136913701371137213731374137513761377137813791380138113821383138413851386138713881389139013911392139313941395139613971398139914001401140214031404140514061407140814091410141114121413141414151416141714181419142014211422142314241425142614271428142914301431143214331434143514361437143814391440144114421443144414451446144714481449145014511452145314541455145614571458145914601461146214631464146514661467146814691470147114721473147414751476147714781479148014811482148314841485148614871488148914901491149214931494149514961497149814991500150115021503150415051506150715081509151015111512151315141515151615171518151915201521152215231524152515261527152815291530153115321533153415351536153715381539154015411542154315441545154615471548154915501551155215531554155515561557155815591560156115621563156415651566156715681569157015711572157315741575157615771578157915801581158215831584158515861587158815891590159115921593159415951596159715981599160016011602160316041605160616071608160916101611161216131614161516161617161816191620162116221623162416251626162716281629163016311632163316341635163616371638163916401641164216431644164516461647164816491650165116521653165416551656165716581659166016611662166316641665166616671668166916701671167216731674167516761677167816791680168116821683168416851686168716881689169016911692169316941695169616971698169917001701170217031704170517061707170817091710171117121713171417151716171717181719172017211722172317241725172617271728172917301731173217331734173517361737173817391740174117421743174417451746174717481749
  1. {
  2. Copyright (c) 1998-2004 by Jonas Maebe, member of the Free Pascal
  3. Development Team
  4. This unit contains the processor independent assembler optimizer
  5. object, base for the dataflow analyzer, peepholeoptimizer and
  6. common subexpression elimination objects.
  7. This program is free software; you can redistribute it and/or modify
  8. it under the terms of the GNU General Public License as published by
  9. the Free Software Foundation; either version 2 of the License, or
  10. (at your option) any later version.
  11. This program is distributed in the hope that it will be useful,
  12. but WITHOUT ANY WARRANTY; without even the implied warranty of
  13. MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
  14. GNU General Public License for more details.
  15. You should have received a copy of the GNU General Public License
  16. along with this program; if not, write to the Free Software
  17. Foundation, Inc., 675 Mass Ave, Cambridge, MA 02139, USA.
  18. ****************************************************************************
  19. }
  20. Unit AoptObj;
  21. {$i fpcdefs.inc}
  22. { general, processor independent objects for use by the assembler optimizer }
  23. Interface
  24. uses
  25. globtype,
  26. aasmbase,aasmcpu,aasmtai,aasmdata,
  27. cclasses,
  28. cgbase,cgutils,
  29. cpubase,
  30. aoptbase,aoptcpub,aoptda;
  31. { ************************************************************************* }
  32. { ********************************* Constants ***************************** }
  33. { ************************************************************************* }
  34. Const
  35. {Possible register content types}
  36. con_Unknown = 0;
  37. con_ref = 1;
  38. con_const = 2;
  39. {***************** Types ****************}
  40. Type
  41. { ************************************************************************* }
  42. { ************************* Some general type definitions ***************** }
  43. { ************************************************************************* }
  44. TRefCompare = Function(const r1, r2: TReference): Boolean;
  45. //!!! FIXME
  46. TRegArray = Array[byte] of tsuperregister;
  47. TRegSet = tcpuregisterset;
  48. { possible actions on an operand: read, write or modify (= read & write) }
  49. TOpAction = (OpAct_Read, OpAct_Write, OpAct_Modify, OpAct_Unknown);
  50. { ************************************************************************* }
  51. { * Object to hold information on which regiters are in use and which not * }
  52. { ************************************************************************* }
  53. { TUsedRegs }
  54. TUsedRegs = class
  55. Constructor create(aTyp : TRegisterType);
  56. Constructor create_regset(aTyp : TRegisterType;Const _RegSet: TRegSet);
  57. Destructor Destroy;override;
  58. Procedure Clear;
  59. { update the info with the pairegalloc objects coming after
  60. p }
  61. procedure Update(p: Tai; IgnoreNewAllocs: Boolean=false);
  62. { is Reg currently in use }
  63. Function IsUsed(Reg: TRegister): Boolean;
  64. { get all the currently used registers }
  65. Function GetUsedRegs: TRegSet;
  66. { outputs the current set }
  67. Procedure Dump(var t : text);
  68. Private
  69. Typ : TRegisterType;
  70. UsedRegs: TRegSet;
  71. End;
  72. { ************************************************************************* }
  73. { ******************* Contents of the integer registers ******************* }
  74. { ************************************************************************* }
  75. { size of the integer that holds the state number of a register. Can be any }
  76. { integer type, so it can be changed to reduce the size of the TContent }
  77. { structure or to improve alignment }
  78. TStateInt = Byte;
  79. TContent = Record
  80. { start and end of block instructions that defines the }
  81. { content of this register. If Typ = con_const, then }
  82. { Longint(StartMod) = value of the constant) }
  83. StartMod: Tai;
  84. { starts at 0, gets increased everytime the register is }
  85. { written to }
  86. WState: TStateInt;
  87. { starts at 0, gets increased everytime the register is read }
  88. { from }
  89. RState: TStateInt;
  90. { how many instructions starting with StarMod does the block }
  91. { consist of }
  92. NrOfMods: Byte;
  93. { the type of the content of the register: unknown, memory }
  94. { (variable) or constant }
  95. Typ: Byte;
  96. End;
  97. //!!! FIXME
  98. TRegContent = Array[byte] Of TContent;
  99. { ************************************************************************** }
  100. { information object with the contents of every register. Every Tai object }
  101. { gets one of these assigned: a pointer to it is stored in the OptInfo field }
  102. { ************************************************************************** }
  103. { TPaiProp }
  104. TPaiProp = class(TAoptBaseCpu)
  105. Regs: TRegContent;
  106. { can this instruction be removed? }
  107. CanBeRemoved: Boolean;
  108. Constructor create; reintroduce;
  109. { checks the whole sequence of which (so regs[which].StartMod and and }
  110. { the next NrOfMods Tai objects) to see whether Reg is used somewhere, }
  111. { without it being loaded with something else first }
  112. Function RegInSequence(Reg, which: TRegister): Boolean;
  113. { destroy the contents of a register, as well as those whose contents }
  114. { are based on those of that register }
  115. Procedure DestroyReg(Reg: TRegister; var InstrSinceLastMod:
  116. TInstrSinceLastMod);
  117. { if the contents of WhichReg (can be R_NO in case of a constant) are }
  118. { written to memory at the location Ref, the contents of the registers }
  119. { that depend on Ref have to be destroyed }
  120. Procedure DestroyRefs(Const Ref: TReference; WhichReg: TRegister; var
  121. InstrSinceLastMod: TInstrSinceLastMod);
  122. { an instruction reads from operand o }
  123. Procedure ReadOp(const o:toper);
  124. { an instruction reads from reference Ref }
  125. Procedure ReadRef(Ref: PReference);
  126. { an instruction reads from register Reg }
  127. Procedure ReadReg(Reg: TRegister);
  128. { an instruction writes/modifies operand o and this has special }
  129. { side-effects or modifies the contents in such a way that we can't }
  130. { simply add this instruction to the sequence of instructions that }
  131. { describe the contents of the operand, so destroy it }
  132. Procedure DestroyOp(const o:Toper; var InstrSinceLastMod:
  133. TInstrSinceLastMod);
  134. { destroy the contents of all registers }
  135. Procedure DestroyAllRegs(var InstrSinceLastMod: TInstrSinceLastMod);
  136. { a register's contents are modified, but not destroyed (the new value
  137. depends on the old one) }
  138. Procedure ModifyReg(reg: TRegister; var InstrSinceLastMod:
  139. TInstrSinceLastMod);
  140. { an operand's contents are modified, but not destroyed (the new value
  141. depends on the old one) }
  142. Procedure ModifyOp(const oper: TOper; var InstrSinceLastMod:
  143. TInstrSinceLastMod);
  144. { increase the write state of a register (call every time a register is
  145. written to) }
  146. Procedure IncWState(Reg: TRegister);
  147. { increase the read state of a register (call every time a register is }
  148. { read from) }
  149. Procedure IncRState(Reg: TRegister);
  150. { get the write state of a register }
  151. Function GetWState(Reg: TRegister): TStateInt;
  152. { get the read state of a register }
  153. Function GetRState(Reg: TRegister): TStateInt;
  154. { get the type of contents of a register }
  155. Function GetRegContentType(Reg: TRegister): Byte;
  156. Destructor Done;
  157. Private
  158. Procedure IncState(var s: TStateInt);
  159. { returns whether the reference Ref is used somewhere in the loading }
  160. { sequence Content }
  161. Function RefInSequence(Const Ref: TReference; Content: TContent;
  162. RefsEq: TRefCompare): Boolean;
  163. { returns whether the instruction P reads from and/or writes }
  164. { to Reg }
  165. Function RefInInstruction(Const Ref: TReference; p: Tai;
  166. RefsEq: TRefCompare): Boolean;
  167. { returns whether two references with at least one pointing to an array }
  168. { may point to the same memory location }
  169. End;
  170. { ************************************************************************* }
  171. { ************************ Label information ****************************** }
  172. { ************************************************************************* }
  173. TLabelTableItem = Record
  174. PaiObj: Tai;
  175. End;
  176. TLabelTable = Array[0..2500000] Of TLabelTableItem;
  177. PLabelTable = ^TLabelTable;
  178. PLabelInfo = ^TLabelInfo;
  179. TLabelInfo = Record
  180. { the highest and lowest label number occurring in the current code }
  181. { fragment }
  182. LowLabel, HighLabel: longint;
  183. LabelDif: cardinal;
  184. { table that contains the addresses of the Pai_Label objects associated
  185. with each label number }
  186. LabelTable: PLabelTable;
  187. End;
  188. { ************************************************************************* }
  189. { ********** General optimizer object, used to derive others from ********* }
  190. { ************************************************************************* }
  191. TAllUsedRegs = array[TRegisterType] of TUsedRegs;
  192. { TAOptObj }
  193. TAOptObj = class(TAoptBaseCpu)
  194. { the PAasmOutput list this optimizer instance works on }
  195. AsmL: TAsmList;
  196. { The labelinfo record contains the addresses of the Tai objects }
  197. { that are labels, how many labels there are and the min and max }
  198. { label numbers }
  199. LabelInfo: PLabelInfo;
  200. { Start and end of the block that is currently being optimized }
  201. BlockStart, BlockEnd: Tai;
  202. DFA: TAOptDFA;
  203. UsedRegs: TAllUsedRegs;
  204. { _AsmL is the PAasmOutpout list that has to be optimized, }
  205. { _BlockStart and _BlockEnd the start and the end of the block }
  206. { that has to be optimized and _LabelInfo a pointer to a }
  207. { TLabelInfo record }
  208. Constructor create(_AsmL: TAsmList; _BlockStart, _BlockEnd: Tai;
  209. _LabelInfo: PLabelInfo); virtual; reintroduce;
  210. Destructor Destroy;override;
  211. { processor independent methods }
  212. Procedure CreateUsedRegs(var regs: TAllUsedRegs);
  213. Procedure ClearUsedRegs;
  214. Procedure UpdateUsedRegs(p : Tai);
  215. class procedure UpdateUsedRegs(var Regs: TAllUsedRegs; p: Tai);
  216. Function CopyUsedRegs(var dest : TAllUsedRegs) : boolean;
  217. class Procedure ReleaseUsedRegs(const regs : TAllUsedRegs);
  218. class Function RegInUsedRegs(reg : TRegister;regs : TAllUsedRegs) : boolean;
  219. class Procedure IncludeRegInUsedRegs(reg : TRegister;var regs : TAllUsedRegs);
  220. class Procedure ExcludeRegFromUsedRegs(reg: TRegister;var regs : TAllUsedRegs);
  221. Function GetAllocationString(const regs : TAllUsedRegs) : string;
  222. { returns true if the label L is found between hp and the next }
  223. { instruction }
  224. Function FindLabel(L: TasmLabel; Var hp: Tai): Boolean;
  225. { inserts new_one between prev and foll in AsmL }
  226. Procedure InsertLLItem(prev, foll, new_one: TLinkedListItem);
  227. { If P is a Tai object releveant to the optimizer, P is returned
  228. If it is not relevant tot he optimizer, the first object after P
  229. that is relevant is returned }
  230. Function SkipHead(P: Tai): Tai;
  231. { returns true if the operands o1 and o2 are completely equal }
  232. Function OpsEqual(const o1,o2:toper): Boolean;
  233. { Returns the next ait_alloc object with ratype ra_alloc for
  234. Reg is found in the block
  235. of Tai's starting with StartPai and ending with the next "real"
  236. instruction. If none is found, it returns
  237. nil
  238. }
  239. Function FindRegAlloc(Reg: TRegister; StartPai: Tai): tai_regalloc;
  240. { Returns the last ait_alloc object with ratype ra_alloc for
  241. Reg is found in the block
  242. of Tai's starting with StartPai and ending with the next "real"
  243. instruction. If none is found, it returns
  244. nil
  245. }
  246. Function FindRegAllocBackward(Reg : TRegister; StartPai : Tai) : tai_regalloc;
  247. { Returns the next ait_alloc object with ratype ra_dealloc
  248. for Reg which is found in the block of Tai's starting with StartPai
  249. and ending with the next "real" instruction. If none is found, it returns
  250. nil }
  251. Function FindRegDeAlloc(Reg: TRegister; StartPai: Tai): tai_regalloc;
  252. { allocates register reg between (and including) instructions p1 and p2
  253. the type of p1 and p2 must not be in SkipInstr }
  254. procedure AllocRegBetween(reg : tregister; p1,p2 : tai; var initialusedregs : TAllUsedRegs);
  255. { reg used after p? }
  256. function RegUsedAfterInstruction(reg: Tregister; p: tai; var AllUsedRegs: TAllUsedRegs): Boolean;
  257. { returns true if reg reaches it's end of life at p, this means it is either
  258. reloaded with a new value or it is deallocated afterwards }
  259. function RegEndOfLife(reg: TRegister;p: taicpu): boolean;
  260. { traces sucessive jumps to their final destination and sets it, e.g.
  261. je l1 je l3
  262. <code> <code>
  263. l1: becomes l1:
  264. je l2 je l3
  265. <code> <code>
  266. l2: l2:
  267. jmp l3 jmp l3
  268. the level parameter denotes how deeep we have already followed the jump,
  269. to avoid endless loops with constructs such as "l5: ; jmp l5" }
  270. function GetFinalDestination(hp: taicpu; level: longint): boolean;
  271. function getlabelwithsym(sym: tasmlabel): tai;
  272. { Removes an instruction following hp1 (possibly with reg.deallocations in between),
  273. if its opcode is A_NOP. }
  274. procedure RemoveDelaySlot(hp1: tai);
  275. { peephole optimizer }
  276. procedure PrePeepHoleOpts; virtual;
  277. procedure PeepHoleOptPass1; virtual;
  278. procedure PeepHoleOptPass2; virtual;
  279. procedure PostPeepHoleOpts; virtual;
  280. { processor dependent methods }
  281. // if it returns true, perform a "continue"
  282. function PrePeepHoleOptsCpu(var p: tai): boolean; virtual;
  283. function PeepHoleOptPass1Cpu(var p: tai): boolean; virtual;
  284. function PeepHoleOptPass2Cpu(var p: tai): boolean; virtual;
  285. function PostPeepHoleOptsCpu(var p: tai): boolean; virtual;
  286. { insert debug comments about which registers are read and written by
  287. each instruction. Useful for debugging the InstructionLoadsFromReg and
  288. other similar functions. }
  289. procedure Debug_InsertInstrRegisterDependencyInfo; virtual;
  290. End;
  291. Function ArrayRefsEq(const r1, r2: TReference): Boolean;
  292. { ***************************** Implementation **************************** }
  293. Implementation
  294. uses
  295. cutils,
  296. globals,
  297. verbose,
  298. aoptutils,
  299. procinfo;
  300. function JumpTargetOp(ai: taicpu): poper; inline;
  301. begin
  302. {$if defined(MIPS)}
  303. { MIPS branches can have 1,2 or 3 operands, target label is the last one. }
  304. result:=ai.oper[ai.ops-1];
  305. {$elseif defined(SPARC64)}
  306. if ai.ops=2 then
  307. result:=ai.oper[1]
  308. else
  309. result:=ai.oper[0];
  310. {$else MIPS}
  311. result:=ai.oper[0];
  312. {$endif}
  313. end;
  314. { ************************************************************************* }
  315. { ******************************** TUsedRegs ****************************** }
  316. { ************************************************************************* }
  317. Constructor TUsedRegs.create(aTyp : TRegisterType);
  318. Begin
  319. Typ:=aTyp;
  320. UsedRegs := [];
  321. End;
  322. Constructor TUsedRegs.create_regset(aTyp : TRegisterType;Const _RegSet: TRegSet);
  323. Begin
  324. Typ:=aTyp;
  325. UsedRegs := _RegSet;
  326. End;
  327. {
  328. updates UsedRegs with the RegAlloc Information coming after P
  329. }
  330. Procedure TUsedRegs.Update(p: Tai;IgnoreNewAllocs : Boolean = false);
  331. Begin
  332. { this code is normally not used because updating the register allocation information is done in
  333. TAOptObj.UpdateUsedRegs for speed reasons }
  334. repeat
  335. while assigned(p) and
  336. ((p.typ in (SkipInstr - [ait_RegAlloc])) or
  337. (p.typ = ait_label) or
  338. ((p.typ = ait_marker) and
  339. (tai_Marker(p).Kind in [mark_AsmBlockEnd,mark_NoLineInfoStart,mark_NoLineInfoEnd]))) do
  340. p := tai(p.next);
  341. while assigned(p) and
  342. (p.typ=ait_RegAlloc) Do
  343. begin
  344. if (getregtype(tai_regalloc(p).reg) = typ) then
  345. begin
  346. case tai_regalloc(p).ratype of
  347. ra_alloc :
  348. if not(IgnoreNewAllocs) then
  349. Include(UsedRegs, getsupreg(tai_regalloc(p).reg));
  350. ra_dealloc :
  351. Exclude(UsedRegs, getsupreg(tai_regalloc(p).reg));
  352. end;
  353. end;
  354. p := tai(p.next);
  355. end;
  356. until not(assigned(p)) or
  357. (not(p.typ in SkipInstr) and
  358. not((p.typ = ait_label) and
  359. labelCanBeSkipped(tai_label(p))));
  360. End;
  361. Function TUsedRegs.IsUsed(Reg: TRegister): Boolean;
  362. Begin
  363. IsUsed := (getregtype(Reg)=Typ) and (getsupreg(Reg) in UsedRegs);
  364. End;
  365. Function TUsedRegs.GetUsedRegs: TRegSet;
  366. Begin
  367. GetUsedRegs := UsedRegs;
  368. End;
  369. procedure TUsedRegs.Dump(var t: text);
  370. var
  371. i: dword;
  372. begin
  373. write(t,Typ,' ');
  374. for i:=low(TRegSet) to high(TRegSet) do
  375. if i in UsedRegs then
  376. write(t,i,' ');
  377. writeln(t);
  378. end;
  379. Destructor TUsedRegs.Destroy;
  380. Begin
  381. inherited destroy;
  382. end;
  383. procedure TUsedRegs.Clear;
  384. begin
  385. UsedRegs := [];
  386. end;
  387. { ************************************************************************* }
  388. { **************************** TPaiProp *********************************** }
  389. { ************************************************************************* }
  390. Constructor TPaiProp.Create;
  391. Begin
  392. {!!!!!!
  393. UsedRegs.Init;
  394. CondRegs.init;
  395. }
  396. { DirFlag: TFlagContents; I386 specific}
  397. End;
  398. Function TPaiProp.RegInSequence(Reg, which: TRegister): Boolean;
  399. {
  400. Var p: Tai;
  401. RegsChecked: TRegSet;
  402. content: TContent;
  403. Counter: Byte;
  404. TmpResult: Boolean;
  405. }
  406. begin
  407. Result:=False; { unimplemented }
  408. (*!!!!!!!!!!1
  409. RegsChecked := [];
  410. content := regs[which];
  411. p := content.StartMod;
  412. TmpResult := False;
  413. Counter := 1;
  414. While Not(TmpResult) And
  415. (Counter <= Content.NrOfMods) Do
  416. Begin
  417. If IsLoadMemReg(p) Then
  418. With PInstr(p)^.oper[LoadSrc]^.ref^ Do
  419. If (Base = ProcInfo.FramePointer)
  420. {$ifdef cpurefshaveindexreg}
  421. And (Index = R_NO)
  422. {$endif cpurefshaveindexreg} Then
  423. Begin
  424. RegsChecked := RegsChecked +
  425. [RegMaxSize(PInstr(p)^.oper[LoadDst]^.reg)];
  426. If Reg = RegMaxSize(PInstr(p)^.oper[LoadDst]^.reg) Then
  427. Break;
  428. End
  429. Else
  430. Begin
  431. If (Base = Reg) And
  432. Not(Base In RegsChecked)
  433. Then TmpResult := True;
  434. {$ifdef cpurefshaveindexreg}
  435. If Not(TmpResult) And
  436. (Index = Reg) And
  437. Not(Index In RegsChecked)
  438. Then TmpResult := True;
  439. {$Endif cpurefshaveindexreg}
  440. End
  441. Else TmpResult := RegInInstruction(Reg, p);
  442. Inc(Counter);
  443. GetNextInstruction(p,p)
  444. End;
  445. RegInSequence := TmpResult
  446. *)
  447. End;
  448. Procedure TPaiProp.DestroyReg(Reg: TRegister; var InstrSinceLastMod:
  449. TInstrSinceLastMod);
  450. { Destroys the contents of the register Reg in the PPaiProp p1, as well as }
  451. { the contents of registers are loaded with a memory location based on Reg }
  452. {
  453. Var TmpWState, TmpRState: Byte;
  454. Counter: TRegister;
  455. }
  456. Begin
  457. {!!!!!!!
  458. Reg := RegMaxSize(Reg);
  459. If (Reg in [LoGPReg..HiGPReg]) Then
  460. For Counter := LoGPReg to HiGPReg Do
  461. With Regs[Counter] Do
  462. If (Counter = reg) Or
  463. ((Typ = Con_Ref) And
  464. RegInSequence(Reg, Counter)) Then
  465. Begin
  466. InstrSinceLastMod[Counter] := 0;
  467. IncWState(Counter);
  468. TmpWState := GetWState(Counter);
  469. TmpRState := GetRState(Counter);
  470. FillChar(Regs[Counter], SizeOf(TContent), 0);
  471. WState := TmpWState;
  472. RState := TmpRState
  473. End
  474. }
  475. End;
  476. Function ArrayRefsEq(const r1, r2: TReference): Boolean;
  477. Begin
  478. Result:=False; { unimplemented }
  479. (*!!!!!!!!!!
  480. ArrayRefsEq := (R1.Offset+R1.OffsetFixup = R2.Offset+R2.OffsetFixup) And
  481. {$ifdef refsHaveSegmentReg}
  482. (R1.Segment = R2.Segment) And
  483. {$endif}
  484. (R1.Base = R2.Base) And
  485. (R1.Symbol=R2.Symbol);
  486. *)
  487. End;
  488. Procedure TPaiProp.DestroyRefs(Const Ref: TReference; WhichReg: TRegister;
  489. var InstrSinceLastMod: TInstrSinceLastMod);
  490. { destroys all registers which possibly contain a reference to Ref, WhichReg }
  491. { is the register whose contents are being written to memory (if this proc }
  492. { is called because of a "mov?? %reg, (mem)" instruction) }
  493. {
  494. Var RefsEq: TRefCompare;
  495. Counter: TRegister;
  496. }
  497. Begin
  498. (*!!!!!!!!!!!
  499. WhichReg := RegMaxSize(WhichReg);
  500. If (Ref.base = procinfo.FramePointer) or
  501. Assigned(Ref.Symbol) Then
  502. Begin
  503. If
  504. {$ifdef cpurefshaveindexreg}
  505. (Ref.Index = R_NO) And
  506. {$endif cpurefshaveindexreg}
  507. (Not(Assigned(Ref.Symbol)) or
  508. (Ref.base = R_NO)) Then
  509. { local variable which is not an array }
  510. RefsEq := @RefsEqual
  511. Else
  512. { local variable which is an array }
  513. RefsEq := @ArrayRefsEq;
  514. {write something to a parameter, a local or global variable, so
  515. * with uncertain optimizations on:
  516. - destroy the contents of registers whose contents have somewhere a
  517. "mov?? (Ref), %reg". WhichReg (this is the register whose contents
  518. are being written to memory) is not destroyed if it's StartMod is
  519. of that form and NrOfMods = 1 (so if it holds ref, but is not a
  520. pointer or value based on Ref)
  521. * with uncertain optimizations off:
  522. - also destroy registers that contain any pointer}
  523. For Counter := LoGPReg to HiGPReg Do
  524. With Regs[Counter] Do
  525. Begin
  526. If (typ = Con_Ref) And
  527. ((Not(cs_opt_size in current_settings.optimizerswitches) And
  528. (NrOfMods <> 1)
  529. ) Or
  530. (RefInSequence(Ref,Regs[Counter], RefsEq) And
  531. ((Counter <> WhichReg) Or
  532. ((NrOfMods <> 1) And
  533. {StarMod is always of the type ait_instruction}
  534. (PInstr(StartMod)^.oper[0].typ = top_ref) And
  535. RefsEq(PInstr(StartMod)^.oper[0].ref^, Ref)
  536. )
  537. )
  538. )
  539. )
  540. Then
  541. DestroyReg(Counter, InstrSinceLastMod)
  542. End
  543. End
  544. Else
  545. {write something to a pointer location, so
  546. * with uncertain optimzations on:
  547. - do not destroy registers which contain a local/global variable or a
  548. parameter, except if DestroyRefs is called because of a "movsl"
  549. * with uncertain optimzations off:
  550. - destroy every register which contains a memory location
  551. }
  552. For Counter := LoGPReg to HiGPReg Do
  553. With Regs[Counter] Do
  554. If (typ = Con_Ref) And
  555. (Not(cs_opt_size in current_settings.optimizerswitches) Or
  556. {$ifdef x86}
  557. {for movsl}
  558. (Ref.Base = R_EDI) Or
  559. {$endif}
  560. {don't destroy if reg contains a parameter, local or global variable}
  561. Not((NrOfMods = 1) And
  562. (PInstr(StartMod)^.oper[0].typ = top_ref) And
  563. ((PInstr(StartMod)^.oper[0].ref^.base = ProcInfo.FramePointer) Or
  564. Assigned(PInstr(StartMod)^.oper[0].ref^.Symbol)
  565. )
  566. )
  567. )
  568. Then DestroyReg(Counter, InstrSinceLastMod)
  569. *)
  570. End;
  571. Procedure TPaiProp.DestroyAllRegs(var InstrSinceLastMod: TInstrSinceLastMod);
  572. {Var Counter: TRegister;}
  573. Begin {initializes/desrtoys all registers}
  574. (*!!!!!!!!!
  575. For Counter := LoGPReg To HiGPReg Do
  576. Begin
  577. ReadReg(Counter);
  578. DestroyReg(Counter, InstrSinceLastMod);
  579. End;
  580. CondRegs.Init;
  581. { FPURegs.Init; }
  582. *)
  583. End;
  584. Procedure TPaiProp.DestroyOp(const o:Toper; var InstrSinceLastMod:
  585. TInstrSinceLastMod);
  586. Begin
  587. {!!!!!!!
  588. Case o.typ Of
  589. top_reg: DestroyReg(o.reg, InstrSinceLastMod);
  590. top_ref:
  591. Begin
  592. ReadRef(o.ref);
  593. DestroyRefs(o.ref^, R_NO, InstrSinceLastMod);
  594. End;
  595. top_symbol:;
  596. End;
  597. }
  598. End;
  599. Procedure TPaiProp.ReadReg(Reg: TRegister);
  600. Begin
  601. {!!!!!!!
  602. Reg := RegMaxSize(Reg);
  603. If Reg in General_Registers Then
  604. IncRState(RegMaxSize(Reg))
  605. }
  606. End;
  607. Procedure TPaiProp.ReadRef(Ref: PReference);
  608. Begin
  609. (*!!!!!!
  610. If Ref^.Base <> R_NO Then
  611. ReadReg(Ref^.Base);
  612. {$ifdef cpurefshaveindexreg}
  613. If Ref^.Index <> R_NO Then
  614. ReadReg(Ref^.Index);
  615. {$endif cpurefshaveindexreg}
  616. *)
  617. End;
  618. Procedure TPaiProp.ReadOp(const o:toper);
  619. Begin
  620. Case o.typ Of
  621. top_reg: ReadReg(o.reg);
  622. top_ref: ReadRef(o.ref);
  623. else
  624. internalerror(200410241);
  625. End;
  626. End;
  627. Procedure TPaiProp.ModifyReg(reg: TRegister; Var InstrSinceLastMod:
  628. TInstrSinceLastMod);
  629. Begin
  630. (*!!!!!!!
  631. With Regs[reg] Do
  632. If (Typ = Con_Ref)
  633. Then
  634. Begin
  635. IncState(WState);
  636. {also store how many instructions are part of the sequence in the first
  637. instructions PPaiProp, so it can be easily accessed from within
  638. CheckSequence}
  639. Inc(NrOfMods, InstrSinceLastMod[Reg]);
  640. PPaiProp(StartMod.OptInfo)^.Regs[Reg].NrOfMods := NrOfMods;
  641. InstrSinceLastMod[Reg] := 0;
  642. End
  643. Else
  644. DestroyReg(Reg, InstrSinceLastMod);
  645. *)
  646. End;
  647. Procedure TPaiProp.ModifyOp(const oper: TOper; var InstrSinceLastMod:
  648. TInstrSinceLastMod);
  649. Begin
  650. If oper.typ = top_reg Then
  651. ModifyReg(RegMaxSize(oper.reg),InstrSinceLastMod)
  652. Else
  653. Begin
  654. ReadOp(oper);
  655. DestroyOp(oper, InstrSinceLastMod);
  656. End
  657. End;
  658. Procedure TPaiProp.IncWState(Reg: TRegister);{$ifdef inl} inline;{$endif inl}
  659. Begin
  660. //!!!! IncState(Regs[Reg].WState);
  661. End;
  662. Procedure TPaiProp.IncRState(Reg: TRegister);{$ifdef inl} inline;{$endif inl}
  663. Begin
  664. //!!!! IncState(Regs[Reg].RState);
  665. End;
  666. Function TPaiProp.GetWState(Reg: TRegister): TStateInt; {$ifdef inl} inline;{$endif inl}
  667. Begin
  668. Result:=0; { unimplemented }
  669. //!!!! GetWState := Regs[Reg].WState
  670. End;
  671. Function TPaiProp.GetRState(Reg: TRegister): TStateInt; {$ifdef inl} inline;{$endif inl}
  672. Begin
  673. Result:=0; { unimplemented }
  674. //!!!! GetRState := Regs[Reg].RState
  675. End;
  676. Function TPaiProp.GetRegContentType(Reg: TRegister): Byte; {$ifdef inl} inline;{$endif inl}
  677. Begin
  678. Result:=0; { unimplemented }
  679. //!!!! GetRegContentType := Regs[Reg].typ
  680. End;
  681. Destructor TPaiProp.Done;
  682. Begin
  683. //!!!! UsedRegs.Done;
  684. //!!!! CondRegs.Done;
  685. { DirFlag: TFlagContents; I386 specific}
  686. End;
  687. { ************************ private TPaiProp stuff ************************* }
  688. Procedure TPaiProp.IncState(Var s: TStateInt); {$ifdef inl} inline;{$endif inl}
  689. Begin
  690. If s <> High(TStateInt) Then Inc(s)
  691. Else s := 0
  692. End;
  693. Function TPaiProp.RefInInstruction(Const Ref: TReference; p: Tai;
  694. RefsEq: TRefCompare): Boolean;
  695. Var Count: AWord;
  696. TmpResult: Boolean;
  697. Begin
  698. TmpResult := False;
  699. If (p.typ = ait_instruction) Then
  700. Begin
  701. Count := 0;
  702. Repeat
  703. If (TInstr(p).oper[Count]^.typ = Top_Ref) Then
  704. TmpResult := RefsEq(Ref, PInstr(p)^.oper[Count]^.ref^);
  705. Inc(Count);
  706. Until (Count = MaxOps) or TmpResult;
  707. End;
  708. RefInInstruction := TmpResult;
  709. End;
  710. Function TPaiProp.RefInSequence(Const Ref: TReference; Content: TContent;
  711. RefsEq: TRefCompare): Boolean;
  712. Var p: Tai;
  713. Counter: Byte;
  714. TmpResult: Boolean;
  715. Begin
  716. p := Content.StartMod;
  717. TmpResult := False;
  718. Counter := 1;
  719. While Not(TmpResult) And
  720. (Counter <= Content.NrOfMods) Do
  721. Begin
  722. If (p.typ = ait_instruction) And
  723. RefInInstruction(Ref, p, @references_equal)
  724. Then TmpResult := True;
  725. Inc(Counter);
  726. GetNextInstruction(p,p)
  727. End;
  728. RefInSequence := TmpResult
  729. End;
  730. { ************************************************************************* }
  731. { ***************************** TAoptObj ********************************** }
  732. { ************************************************************************* }
  733. Constructor TAoptObj.create(_AsmL: TAsmList; _BlockStart, _BlockEnd: Tai;
  734. _LabelInfo: PLabelInfo);
  735. Begin
  736. AsmL := _AsmL;
  737. BlockStart := _BlockStart;
  738. BlockEnd := _BlockEnd;
  739. LabelInfo := _LabelInfo;
  740. CreateUsedRegs(UsedRegs);
  741. End;
  742. destructor TAOptObj.Destroy;
  743. var
  744. i : TRegisterType;
  745. begin
  746. for i:=low(TRegisterType) to high(TRegisterType) do
  747. UsedRegs[i].Destroy;
  748. inherited Destroy;
  749. end;
  750. procedure TAOptObj.CreateUsedRegs(var regs: TAllUsedRegs);
  751. var
  752. i : TRegisterType;
  753. begin
  754. for i:=low(TRegisterType) to high(TRegisterType) do
  755. Regs[i]:=TUsedRegs.Create(i);
  756. end;
  757. procedure TAOptObj.ClearUsedRegs;
  758. var
  759. i : TRegisterType;
  760. begin
  761. for i:=low(TRegisterType) to high(TRegisterType) do
  762. UsedRegs[i].Clear;
  763. end;
  764. procedure TAOptObj.UpdateUsedRegs(p : Tai);
  765. begin
  766. { this code is based on TUsedRegs.Update to avoid multiple passes through the asmlist,
  767. the code is duplicated here }
  768. repeat
  769. while assigned(p) and
  770. ((p.typ in (SkipInstr - [ait_RegAlloc])) or
  771. ((p.typ = ait_label) and
  772. labelCanBeSkipped(tai_label(p))) or
  773. ((p.typ = ait_marker) and
  774. (tai_Marker(p).Kind in [mark_AsmBlockEnd,mark_NoLineInfoStart,mark_NoLineInfoEnd]))) do
  775. p := tai(p.next);
  776. while assigned(p) and
  777. (p.typ=ait_RegAlloc) Do
  778. begin
  779. case tai_regalloc(p).ratype of
  780. ra_alloc :
  781. Include(UsedRegs[getregtype(tai_regalloc(p).reg)].UsedRegs, getsupreg(tai_regalloc(p).reg));
  782. ra_dealloc :
  783. Exclude(UsedRegs[getregtype(tai_regalloc(p).reg)].UsedRegs, getsupreg(tai_regalloc(p).reg));
  784. end;
  785. p := tai(p.next);
  786. end;
  787. until not(assigned(p)) or
  788. (not(p.typ in SkipInstr) and
  789. not((p.typ = ait_label) and
  790. labelCanBeSkipped(tai_label(p))));
  791. end;
  792. class procedure TAOptObj.UpdateUsedRegs(var Regs : TAllUsedRegs;p : Tai);
  793. var
  794. i : TRegisterType;
  795. begin
  796. for i:=low(TRegisterType) to high(TRegisterType) do
  797. Regs[i].Update(p);
  798. end;
  799. function TAOptObj.CopyUsedRegs(var dest: TAllUsedRegs): boolean;
  800. var
  801. i : TRegisterType;
  802. begin
  803. Result:=true;
  804. for i:=low(TRegisterType) to high(TRegisterType) do
  805. dest[i]:=TUsedRegs.Create_Regset(i,UsedRegs[i].GetUsedRegs);
  806. end;
  807. class procedure TAOptObj.ReleaseUsedRegs(const regs: TAllUsedRegs);
  808. var
  809. i : TRegisterType;
  810. begin
  811. for i:=low(TRegisterType) to high(TRegisterType) do
  812. regs[i].Free;
  813. end;
  814. class Function TAOptObj.RegInUsedRegs(reg : TRegister;regs : TAllUsedRegs) : boolean;
  815. begin
  816. result:=regs[getregtype(reg)].IsUsed(reg);
  817. end;
  818. class procedure TAOptObj.IncludeRegInUsedRegs(reg: TRegister;
  819. var regs: TAllUsedRegs);
  820. begin
  821. include(regs[getregtype(reg)].UsedRegs,getsupreg(Reg));
  822. end;
  823. class procedure TAOptObj.ExcludeRegFromUsedRegs(reg: TRegister;
  824. var regs: TAllUsedRegs);
  825. begin
  826. exclude(regs[getregtype(reg)].UsedRegs,getsupreg(Reg));
  827. end;
  828. function TAOptObj.GetAllocationString(const regs: TAllUsedRegs): string;
  829. var
  830. i : TRegisterType;
  831. j : TSuperRegister;
  832. begin
  833. Result:='';
  834. for i:=low(TRegisterType) to high(TRegisterType) do
  835. for j in regs[i].UsedRegs do
  836. Result:=Result+std_regname(newreg(i,j,R_SUBWHOLE))+' ';
  837. end;
  838. Function TAOptObj.FindLabel(L: TasmLabel; Var hp: Tai): Boolean;
  839. Var TempP: Tai;
  840. Begin
  841. TempP := hp;
  842. While Assigned(TempP) and
  843. (TempP.typ In SkipInstr + [ait_label,ait_align]) Do
  844. If (TempP.typ <> ait_Label) Or
  845. (Tai_label(TempP).labsym <> L)
  846. Then GetNextInstruction(TempP, TempP)
  847. Else
  848. Begin
  849. hp := TempP;
  850. FindLabel := True;
  851. exit
  852. End;
  853. FindLabel := False;
  854. End;
  855. Procedure TAOptObj.InsertLLItem(prev, foll, new_one : TLinkedListItem);
  856. Begin
  857. If Assigned(prev) Then
  858. If Assigned(foll) Then
  859. Begin
  860. If Assigned(new_one) Then
  861. Begin
  862. new_one.previous := prev;
  863. new_one.next := foll;
  864. prev.next := new_one;
  865. foll.previous := new_one;
  866. { should we update line information? }
  867. if (not (tai(new_one).typ in SkipLineInfo)) and
  868. (not (tai(foll).typ in SkipLineInfo)) then
  869. Tailineinfo(new_one).fileinfo := Tailineinfo(foll).fileinfo
  870. End
  871. End
  872. Else AsmL.Concat(new_one)
  873. Else If Assigned(Foll) Then AsmL.Insert(new_one)
  874. End;
  875. Function TAOptObj.SkipHead(P: Tai): Tai;
  876. Var OldP: Tai;
  877. Begin
  878. Repeat
  879. OldP := P;
  880. If (P.typ in SkipInstr) Or
  881. ((P.typ = ait_marker) And
  882. (Tai_Marker(P).Kind = mark_AsmBlockEnd)) Then
  883. GetNextInstruction(P, P)
  884. Else If ((P.Typ = Ait_Marker) And
  885. (Tai_Marker(P).Kind = mark_NoPropInfoStart)) Then
  886. { a marker of the type mark_NoPropInfoStart can't be the first instruction of a }
  887. { paasmoutput list }
  888. GetNextInstruction(Tai(P.Previous),P);
  889. If (P.Typ = Ait_Marker) And
  890. (Tai_Marker(P).Kind = mark_AsmBlockStart) Then
  891. Begin
  892. P := Tai(P.Next);
  893. While (P.typ <> Ait_Marker) Or
  894. (Tai_Marker(P).Kind <> mark_AsmBlockEnd) Do
  895. P := Tai(P.Next)
  896. End;
  897. Until P = OldP;
  898. SkipHead := P;
  899. End;
  900. Function TAOptObj.OpsEqual(const o1,o2:toper): Boolean;
  901. Begin
  902. if o1.typ=o2.typ then
  903. Case o1.typ Of
  904. Top_Reg :
  905. OpsEqual:=o1.reg=o2.reg;
  906. Top_Ref :
  907. OpsEqual := references_equal(o1.ref^, o2.ref^);
  908. Top_Const :
  909. OpsEqual:=o1.val=o2.val;
  910. Top_None :
  911. OpsEqual := True
  912. else OpsEqual := False
  913. End
  914. else
  915. OpsEqual := False;
  916. End;
  917. Function TAOptObj.FindRegAlloc(Reg: TRegister; StartPai: Tai): tai_regalloc;
  918. Begin
  919. Result:=nil;
  920. Repeat
  921. While Assigned(StartPai) And
  922. ((StartPai.typ in (SkipInstr - [ait_regAlloc])) Or
  923. {$ifdef cpudelayslot}
  924. ((startpai.typ=ait_instruction) and (taicpu(startpai).opcode=A_NOP)) or
  925. {$endif cpudelayslot}
  926. ((StartPai.typ = ait_label) and
  927. Not(Tai_Label(StartPai).labsym.Is_Used))) Do
  928. StartPai := Tai(StartPai.Next);
  929. If Assigned(StartPai) And
  930. (StartPai.typ = ait_regAlloc) Then
  931. Begin
  932. if (tai_regalloc(StartPai).ratype=ra_alloc) and
  933. (getregtype(tai_regalloc(StartPai).Reg) = getregtype(Reg)) and
  934. (getsupreg(tai_regalloc(StartPai).Reg) = getsupreg(Reg)) then
  935. begin
  936. Result:=tai_regalloc(StartPai);
  937. exit;
  938. end;
  939. StartPai := Tai(StartPai.Next);
  940. End
  941. else
  942. exit;
  943. Until false;
  944. End;
  945. Function TAOptObj.FindRegAllocBackward(Reg: TRegister; StartPai: Tai): tai_regalloc;
  946. Begin
  947. Result:=nil;
  948. Repeat
  949. While Assigned(StartPai) And
  950. ((StartPai.typ in (SkipInstr - [ait_regAlloc])) Or
  951. ((StartPai.typ = ait_label) and
  952. Not(Tai_Label(StartPai).labsym.Is_Used))) Do
  953. StartPai := Tai(StartPai.Previous);
  954. If Assigned(StartPai) And
  955. (StartPai.typ = ait_regAlloc) Then
  956. Begin
  957. if (tai_regalloc(StartPai).ratype=ra_alloc) and
  958. SuperRegistersEqual(tai_regalloc(StartPai).Reg,Reg) then
  959. begin
  960. Result:=tai_regalloc(StartPai);
  961. exit;
  962. end;
  963. StartPai := Tai(StartPai.Previous);
  964. End
  965. else
  966. exit;
  967. Until false;
  968. End;
  969. function TAOptObj.FindRegDeAlloc(Reg: TRegister; StartPai: Tai): tai_regalloc;
  970. Begin
  971. Result:=nil;
  972. Repeat
  973. While Assigned(StartPai) And
  974. ((StartPai.typ in (SkipInstr - [ait_regAlloc])) Or
  975. ((StartPai.typ = ait_label) and
  976. Not(Tai_Label(StartPai).labsym.Is_Used))) Do
  977. StartPai := Tai(StartPai.Next);
  978. If Assigned(StartPai) And
  979. (StartPai.typ = ait_regAlloc) Then
  980. Begin
  981. if (tai_regalloc(StartPai).ratype=ra_dealloc) and
  982. (getregtype(tai_regalloc(StartPai).Reg) = getregtype(Reg)) and
  983. (getsupreg(tai_regalloc(StartPai).Reg) = getsupreg(Reg)) then
  984. begin
  985. Result:=tai_regalloc(StartPai);
  986. exit;
  987. end;
  988. StartPai := Tai(StartPai.Next);
  989. End
  990. else
  991. exit;
  992. Until false;
  993. End;
  994. { allocates register reg between (and including) instructions p1 and p2
  995. the type of p1 and p2 must not be in SkipInstr }
  996. procedure TAOptObj.AllocRegBetween(reg: tregister; p1, p2: tai; var initialusedregs: TAllUsedRegs);
  997. var
  998. hp, start: tai;
  999. removedsomething,
  1000. firstRemovedWasAlloc,
  1001. lastRemovedWasDealloc: boolean;
  1002. begin
  1003. {$ifdef EXTDEBUG}
  1004. { if assigned(p1.optinfo) and
  1005. (ptaiprop(p1.optinfo)^.usedregs <> initialusedregs) then
  1006. internalerror(2004101010); }
  1007. {$endif EXTDEBUG}
  1008. start := p1;
  1009. if (reg = NR_STACK_POINTER_REG) or
  1010. (reg = current_procinfo.framepointer) or
  1011. not(assigned(p1)) then
  1012. { this happens with registers which are loaded implicitely, outside the }
  1013. { current block (e.g. esi with self) }
  1014. exit;
  1015. { make sure we allocate it for this instruction }
  1016. getnextinstruction(p2,p2);
  1017. lastRemovedWasDealloc := false;
  1018. removedSomething := false;
  1019. firstRemovedWasAlloc := false;
  1020. {$ifdef allocregdebug}
  1021. hp := tai_comment.Create(strpnew('allocating '+std_regname(newreg(R_INTREGISTER,supreg,R_SUBWHOLE))+
  1022. ' from here...'));
  1023. insertllitem(asml,p1.previous,p1,hp);
  1024. hp := tai_comment.Create(strpnew('allocated '+std_regname(newreg(R_INTREGISTER,supreg,R_SUBWHOLE))+
  1025. ' till here...'));
  1026. insertllitem(asml,p2,p2.next,hp);
  1027. {$endif allocregdebug}
  1028. { do it the safe way: always allocate the full super register,
  1029. as we do no register re-allocation in the peephole optimizer,
  1030. this does not hurt
  1031. }
  1032. case getregtype(reg) of
  1033. R_MMREGISTER:
  1034. reg:=newreg(R_MMREGISTER,getsupreg(reg),R_SUBMMWHOLE);
  1035. R_INTREGISTER:
  1036. reg:=newreg(R_INTREGISTER,getsupreg(reg),R_SUBWHOLE);
  1037. R_FPUREGISTER:
  1038. reg:=newreg(R_FPUREGISTER,getsupreg(reg),R_SUBWHOLE);
  1039. R_ADDRESSREGISTER:
  1040. reg:=newreg(R_ADDRESSREGISTER,getsupreg(reg),R_SUBWHOLE);
  1041. else
  1042. Internalerror(2018030701);
  1043. end;
  1044. if not(RegInUsedRegs(reg,initialusedregs)) then
  1045. begin
  1046. hp := tai_regalloc.alloc(reg,nil);
  1047. insertllItem(p1.previous,p1,hp);
  1048. IncludeRegInUsedRegs(reg,initialusedregs);
  1049. end;
  1050. while assigned(p1) and
  1051. (p1 <> p2) do
  1052. begin
  1053. if assigned(p1.optinfo) then
  1054. internalerror(2014022301); // IncludeRegInUsedRegs(reg,ptaiprop(p1.optinfo)^.usedregs);
  1055. p1 := tai(p1.next);
  1056. repeat
  1057. while assigned(p1) and
  1058. (p1.typ in (SkipInstr-[ait_regalloc])) Do
  1059. p1 := tai(p1.next);
  1060. { remove all allocation/deallocation info about the register in between }
  1061. if assigned(p1) and
  1062. (p1.typ = ait_regalloc) then
  1063. begin
  1064. { same super register, different sub register? }
  1065. if SuperRegistersEqual(reg,tai_regalloc(p1).reg) and (tai_regalloc(p1).reg<>reg) then
  1066. begin
  1067. if (getsubreg(tai_regalloc(p1).reg)>getsubreg(reg)) or (getsubreg(reg)=R_SUBH) then
  1068. internalerror(2016101501);
  1069. tai_regalloc(p1).reg:=reg;
  1070. end;
  1071. if tai_regalloc(p1).reg=reg then
  1072. begin
  1073. if not removedSomething then
  1074. begin
  1075. firstRemovedWasAlloc := tai_regalloc(p1).ratype=ra_alloc;
  1076. removedSomething := true;
  1077. end;
  1078. lastRemovedWasDealloc := (tai_regalloc(p1).ratype=ra_dealloc);
  1079. hp := tai(p1.Next);
  1080. asml.Remove(p1);
  1081. p1.free;
  1082. p1 := hp;
  1083. end
  1084. else
  1085. p1 := tai(p1.next);
  1086. end;
  1087. until not(assigned(p1)) or
  1088. not(p1.typ in SkipInstr);
  1089. end;
  1090. if assigned(p1) then
  1091. begin
  1092. if firstRemovedWasAlloc then
  1093. begin
  1094. hp := tai_regalloc.Alloc(reg,nil);
  1095. insertLLItem(start.previous,start,hp);
  1096. end;
  1097. if lastRemovedWasDealloc then
  1098. begin
  1099. hp := tai_regalloc.DeAlloc(reg,nil);
  1100. insertLLItem(p1.previous,p1,hp);
  1101. end;
  1102. end;
  1103. end;
  1104. function TAOptObj.RegUsedAfterInstruction(reg: Tregister; p: tai;var AllUsedRegs: TAllUsedRegs): Boolean;
  1105. begin
  1106. AllUsedRegs[getregtype(reg)].Update(tai(p.Next),true);
  1107. RegUsedAfterInstruction :=
  1108. AllUsedRegs[getregtype(reg)].IsUsed(reg) and
  1109. not(regLoadedWithNewValue(reg,p)) and
  1110. (
  1111. not(GetNextInstruction(p,p)) or
  1112. InstructionLoadsFromReg(reg,p) or
  1113. not(regLoadedWithNewValue(reg,p))
  1114. );
  1115. end;
  1116. function TAOptObj.RegEndOfLife(reg : TRegister;p : taicpu) : boolean;
  1117. begin
  1118. Result:=assigned(FindRegDealloc(reg,tai(p.Next))) or
  1119. RegLoadedWithNewValue(reg,p);
  1120. end;
  1121. function FindAnyLabel(hp: tai; var l: tasmlabel): Boolean;
  1122. begin
  1123. FindAnyLabel := false;
  1124. while assigned(hp.next) and
  1125. (tai(hp.next).typ in (SkipInstr+[ait_align])) Do
  1126. hp := tai(hp.next);
  1127. if assigned(hp.next) and
  1128. (tai(hp.next).typ = ait_label) then
  1129. begin
  1130. FindAnyLabel := true;
  1131. l := tai_label(hp.next).labsym;
  1132. end
  1133. end;
  1134. {$push}
  1135. {$r-}
  1136. function TAOptObj.getlabelwithsym(sym: tasmlabel): tai;
  1137. begin
  1138. if (int64(sym.labelnr) >= int64(labelinfo^.lowlabel)) and
  1139. (int64(sym.labelnr) <= int64(labelinfo^.highlabel)) then { range check, a jump can go past an assembler block! }
  1140. getlabelwithsym := labelinfo^.labeltable^[sym.labelnr-labelinfo^.lowlabel].paiobj
  1141. else
  1142. getlabelwithsym := nil;
  1143. end;
  1144. {$pop}
  1145. { Returns True if hp is an unconditional jump to a label }
  1146. function IsJumpToLabelUncond(hp: taicpu): boolean;
  1147. begin
  1148. {$if defined(avr)}
  1149. result:=(hp.opcode in aopt_uncondjmp) and
  1150. {$else avr}
  1151. result:=(hp.opcode=aopt_uncondjmp) and
  1152. {$endif avr}
  1153. {$if defined(arm) or defined(aarch64)}
  1154. (hp.condition=c_None) and
  1155. {$endif arm or aarch64}
  1156. (hp.ops>0) and
  1157. (JumpTargetOp(hp)^.typ = top_ref) and
  1158. (JumpTargetOp(hp)^.ref^.symbol is TAsmLabel);
  1159. end;
  1160. { Returns True if hp is any jump to a label }
  1161. function IsJumpToLabel(hp: taicpu): boolean;
  1162. begin
  1163. result:=hp.is_jmp and
  1164. (hp.ops>0) and
  1165. (JumpTargetOp(hp)^.typ = top_ref) and
  1166. (JumpTargetOp(hp)^.ref^.symbol is TAsmLabel);
  1167. end;
  1168. procedure TAOptObj.RemoveDelaySlot(hp1:tai);
  1169. var
  1170. hp2: tai;
  1171. begin
  1172. hp2:=tai(hp1.next);
  1173. while assigned(hp2) and (hp2.typ in SkipInstr) do
  1174. hp2:=tai(hp2.next);
  1175. if assigned(hp2) and (hp2.typ=ait_instruction) and
  1176. (taicpu(hp2).opcode=A_NOP) then
  1177. begin
  1178. asml.remove(hp2);
  1179. hp2.free;
  1180. end;
  1181. { Anything except A_NOP must be left in place: these instructions
  1182. execute before branch, so code stays correct if branch is removed. }
  1183. end;
  1184. function TAOptObj.GetFinalDestination(hp: taicpu; level: longint): boolean;
  1185. {traces sucessive jumps to their final destination and sets it, e.g.
  1186. je l1 je l3
  1187. <code> <code>
  1188. l1: becomes l1:
  1189. je l2 je l3
  1190. <code> <code>
  1191. l2: l2:
  1192. jmp l3 jmp l3
  1193. the level parameter denotes how deeep we have already followed the jump,
  1194. to avoid endless loops with constructs such as "l5: ; jmp l5" }
  1195. var p1: tai;
  1196. {$if not defined(MIPS) and not defined(JVM)}
  1197. p2: tai;
  1198. l: tasmlabel;
  1199. {$endif}
  1200. begin
  1201. GetfinalDestination := false;
  1202. if level > 20 then
  1203. exit;
  1204. p1 := getlabelwithsym(tasmlabel(JumpTargetOp(hp)^.ref^.symbol));
  1205. if assigned(p1) then
  1206. begin
  1207. SkipLabels(p1,p1);
  1208. if (tai(p1).typ = ait_instruction) and
  1209. (taicpu(p1).is_jmp) then
  1210. if { the next instruction after the label where the jump hp arrives}
  1211. { is unconditional or of the same type as hp, so continue }
  1212. IsJumpToLabelUncond(taicpu(p1))
  1213. {$if not defined(MIPS) and not defined(JVM)}
  1214. { for MIPS, it isn't enough to check the condition; first operands must be same, too. }
  1215. or
  1216. conditions_equal(taicpu(p1).condition,hp.condition) or
  1217. { the next instruction after the label where the jump hp arrives
  1218. is the opposite of hp (so this one is never taken), but after
  1219. that one there is a branch that will be taken, so perform a
  1220. little hack: set p1 equal to this instruction (that's what the
  1221. last SkipLabels is for, only works with short bool evaluation)}
  1222. (conditions_equal(taicpu(p1).condition,inverse_cond(hp.condition)) and
  1223. SkipLabels(p1,p2) and
  1224. (p2.typ = ait_instruction) and
  1225. (taicpu(p2).is_jmp) and
  1226. (IsJumpToLabelUncond(taicpu(p2)) or
  1227. (conditions_equal(taicpu(p2).condition,hp.condition))) and
  1228. SkipLabels(p1,p1))
  1229. {$endif not MIPS and not JVM}
  1230. then
  1231. begin
  1232. { quick check for loops of the form "l5: ; jmp l5 }
  1233. if (tasmlabel(JumpTargetOp(taicpu(p1))^.ref^.symbol).labelnr =
  1234. tasmlabel(JumpTargetOp(hp)^.ref^.symbol).labelnr) then
  1235. exit;
  1236. if not GetFinalDestination(taicpu(p1),succ(level)) then
  1237. exit;
  1238. {$if defined(aarch64)}
  1239. { can't have conditional branches to
  1240. global labels on AArch64, because the
  1241. offset may become too big }
  1242. if not(taicpu(hp).condition in [C_None,C_AL,C_NV]) and
  1243. (tasmlabel(JumpTargetOp(taicpu(p1))^.ref^.symbol).bind<>AB_LOCAL) then
  1244. exit;
  1245. {$endif aarch64}
  1246. tasmlabel(JumpTargetOp(hp)^.ref^.symbol).decrefs;
  1247. JumpTargetOp(hp)^.ref^.symbol:=JumpTargetOp(taicpu(p1))^.ref^.symbol;
  1248. tasmlabel(JumpTargetOp(hp)^.ref^.symbol).increfs;
  1249. end
  1250. {$if not defined(MIPS) and not defined(JVM)}
  1251. else
  1252. if conditions_equal(taicpu(p1).condition,inverse_cond(hp.condition)) then
  1253. if not FindAnyLabel(p1,l) then
  1254. begin
  1255. {$ifdef finaldestdebug}
  1256. insertllitem(asml,p1,p1.next,tai_comment.Create(
  1257. strpnew('previous label inserted'))));
  1258. {$endif finaldestdebug}
  1259. current_asmdata.getjumplabel(l);
  1260. insertllitem(p1,p1.next,tai_label.Create(l));
  1261. tasmlabel(JumpTargetOp(hp)^.ref^.symbol).decrefs;
  1262. JumpTargetOp(hp)^.ref^.symbol := l;
  1263. l.increfs;
  1264. { this won't work, since the new label isn't in the labeltable }
  1265. { so it will fail the rangecheck. Labeltable should become a }
  1266. { hashtable to support this: }
  1267. { GetFinalDestination(asml, hp); }
  1268. end
  1269. else
  1270. begin
  1271. {$ifdef finaldestdebug}
  1272. insertllitem(asml,p1,p1.next,tai_comment.Create(
  1273. strpnew('next label reused'))));
  1274. {$endif finaldestdebug}
  1275. l.increfs;
  1276. tasmlabel(JumpTargetOp(hp)^.ref^.symbol).decrefs;
  1277. JumpTargetOp(hp)^.ref^.symbol := l;
  1278. if not GetFinalDestination(hp,succ(level)) then
  1279. exit;
  1280. end;
  1281. {$endif not MIPS and not JVM}
  1282. end;
  1283. GetFinalDestination := true;
  1284. end;
  1285. procedure TAOptObj.PrePeepHoleOpts;
  1286. var
  1287. p: tai;
  1288. begin
  1289. p := BlockStart;
  1290. ClearUsedRegs;
  1291. while (p <> BlockEnd) Do
  1292. begin
  1293. UpdateUsedRegs(tai(p.next));
  1294. if PrePeepHoleOptsCpu(p) then
  1295. continue;
  1296. UpdateUsedRegs(p);
  1297. p:=tai(p.next);
  1298. end;
  1299. end;
  1300. procedure TAOptObj.PeepHoleOptPass1;
  1301. var
  1302. p,hp1,hp2 : tai;
  1303. stoploop:boolean;
  1304. begin
  1305. repeat
  1306. stoploop:=true;
  1307. p := BlockStart;
  1308. ClearUsedRegs;
  1309. while (p <> BlockEnd) Do
  1310. begin
  1311. { I'am not sure why this is done, UsedRegs should reflect the register usage before the instruction
  1312. If an instruction needs the information of this, it can easily create a TempUsedRegs (FK)
  1313. UpdateUsedRegs(tai(p.next));
  1314. }
  1315. {$ifdef DEBUG_OPTALLOC}
  1316. if p.Typ=ait_instruction then
  1317. InsertLLItem(tai(p.Previous),p,tai_comment.create(strpnew(GetAllocationString(UsedRegs))));
  1318. {$endif DEBUG_OPTALLOC}
  1319. if PeepHoleOptPass1Cpu(p) then
  1320. begin
  1321. stoploop:=false;
  1322. UpdateUsedRegs(p);
  1323. continue;
  1324. end;
  1325. case p.Typ Of
  1326. ait_instruction:
  1327. begin
  1328. { Handle Jmp Optimizations }
  1329. if taicpu(p).is_jmp then
  1330. begin
  1331. { the following if-block removes all code between a jmp and the next label,
  1332. because it can never be executed
  1333. }
  1334. if IsJumpToLabelUncond(taicpu(p)) then
  1335. begin
  1336. hp2:=p;
  1337. while GetNextInstruction(hp2, hp1) and
  1338. (hp1.typ <> ait_label)
  1339. {$ifdef JVM}
  1340. and (hp1.typ <> ait_jcatch)
  1341. {$endif}
  1342. do
  1343. if not(hp1.typ in ([ait_label,ait_align]+skipinstr)) then
  1344. begin
  1345. if (hp1.typ = ait_instruction) and
  1346. taicpu(hp1).is_jmp and
  1347. (JumpTargetOp(taicpu(hp1))^.typ = top_ref) and
  1348. (JumpTargetOp(taicpu(hp1))^.ref^.symbol is TAsmLabel) then
  1349. TAsmLabel(JumpTargetOp(taicpu(hp1))^.ref^.symbol).decrefs;
  1350. { don't kill start/end of assembler block,
  1351. no-line-info-start/end etc }
  1352. if hp1.typ<>ait_marker then
  1353. begin
  1354. {$ifdef cpudelayslot}
  1355. if (hp1.typ=ait_instruction) and (taicpu(hp1).is_jmp) then
  1356. RemoveDelaySlot(hp1);
  1357. {$endif cpudelayslot}
  1358. asml.remove(hp1);
  1359. hp1.free;
  1360. stoploop:=false;
  1361. end
  1362. else
  1363. hp2:=hp1;
  1364. end
  1365. else break;
  1366. end;
  1367. if GetNextInstruction(p, hp1) then
  1368. begin
  1369. SkipEntryExitMarker(hp1,hp1);
  1370. { remove unconditional jumps to a label coming right after them }
  1371. if IsJumpToLabelUncond(taicpu(p)) and
  1372. FindLabel(tasmlabel(JumpTargetOp(taicpu(p))^.ref^.symbol), hp1) and
  1373. { TODO: FIXME removing the first instruction fails}
  1374. (p<>blockstart) then
  1375. begin
  1376. tasmlabel(JumpTargetOp(taicpu(p))^.ref^.symbol).decrefs;
  1377. {$ifdef cpudelayslot}
  1378. RemoveDelaySlot(p);
  1379. {$endif cpudelayslot}
  1380. hp2:=tai(hp1.next);
  1381. asml.remove(p);
  1382. p.free;
  1383. p:=hp2;
  1384. stoploop:=false;
  1385. continue;
  1386. end
  1387. else if assigned(hp1) then
  1388. begin
  1389. { change the following jumps:
  1390. jmp<cond> lab_1 jmp<cond_inverted> lab_2
  1391. jmp lab_2 >>> <code>
  1392. lab_1: lab_2:
  1393. <code>
  1394. lab_2:
  1395. }
  1396. if hp1.typ = ait_label then
  1397. SkipLabels(hp1,hp1);
  1398. if (tai(hp1).typ=ait_instruction) and
  1399. IsJumpToLabelUncond(taicpu(hp1)) and
  1400. GetNextInstruction(hp1, hp2) and
  1401. IsJumpToLabel(taicpu(p)) and
  1402. FindLabel(tasmlabel(JumpTargetOp(taicpu(p))^.ref^.symbol), hp2) then
  1403. begin
  1404. if (taicpu(p).opcode=aopt_condjmp)
  1405. {$if defined(arm) or defined(aarch64)}
  1406. and (taicpu(p).condition<>C_None)
  1407. {$endif arm or aarch64}
  1408. {$if defined(aarch64)}
  1409. { can't have conditional branches to
  1410. global labels on AArch64, because the
  1411. offset may become too big }
  1412. and (tasmlabel(JumpTargetOp(taicpu(hp1))^.ref^.symbol).bind=AB_LOCAL)
  1413. {$endif aarch64}
  1414. then
  1415. begin
  1416. taicpu(p).condition:=inverse_cond(taicpu(p).condition);
  1417. tai_label(hp2).labsym.decrefs;
  1418. JumpTargetOp(taicpu(p))^.ref^.symbol:=JumpTargetOp(taicpu(hp1))^.ref^.symbol;
  1419. { when freeing hp1, the reference count
  1420. isn't decreased, so don't increase
  1421. taicpu(p).oper[0]^.ref^.symbol.increfs;
  1422. }
  1423. {$ifdef cpudelayslot}
  1424. RemoveDelaySlot(hp1);
  1425. {$endif cpudelayslot}
  1426. asml.remove(hp1);
  1427. hp1.free;
  1428. stoploop:=false;
  1429. GetFinalDestination(taicpu(p),0);
  1430. end
  1431. else
  1432. begin
  1433. GetFinalDestination(taicpu(p),0);
  1434. p:=tai(p.next);
  1435. continue;
  1436. end;
  1437. end
  1438. else if IsJumpToLabel(taicpu(p)) then
  1439. GetFinalDestination(taicpu(p),0);
  1440. end;
  1441. end;
  1442. end
  1443. else
  1444. { All other optimizes }
  1445. begin
  1446. end; { if is_jmp }
  1447. end;
  1448. end;
  1449. UpdateUsedRegs(p);
  1450. p:=tai(p.next);
  1451. end;
  1452. until stoploop or not(cs_opt_level3 in current_settings.optimizerswitches);
  1453. end;
  1454. procedure TAOptObj.PeepHoleOptPass2;
  1455. var
  1456. p: tai;
  1457. begin
  1458. p := BlockStart;
  1459. ClearUsedRegs;
  1460. while (p <> BlockEnd) Do
  1461. begin
  1462. UpdateUsedRegs(tai(p.next));
  1463. if PeepHoleOptPass2Cpu(p) then
  1464. continue;
  1465. UpdateUsedRegs(p);
  1466. p:=tai(p.next);
  1467. end;
  1468. end;
  1469. procedure TAOptObj.PostPeepHoleOpts;
  1470. var
  1471. p: tai;
  1472. begin
  1473. p := BlockStart;
  1474. ClearUsedRegs;
  1475. while (p <> BlockEnd) Do
  1476. begin
  1477. UpdateUsedRegs(tai(p.next));
  1478. if PostPeepHoleOptsCpu(p) then
  1479. continue;
  1480. UpdateUsedRegs(p);
  1481. p:=tai(p.next);
  1482. end;
  1483. end;
  1484. function TAOptObj.PrePeepHoleOptsCpu(var p : tai) : boolean;
  1485. begin
  1486. result := false;
  1487. end;
  1488. function TAOptObj.PeepHoleOptPass1Cpu(var p: tai): boolean;
  1489. begin
  1490. result := false;
  1491. end;
  1492. function TAOptObj.PeepHoleOptPass2Cpu(var p : tai) : boolean;
  1493. begin
  1494. result := false;
  1495. end;
  1496. function TAOptObj.PostPeepHoleOptsCpu(var p: tai): boolean;
  1497. begin
  1498. result := false;
  1499. end;
  1500. procedure TAOptObj.Debug_InsertInstrRegisterDependencyInfo;
  1501. var
  1502. p: tai;
  1503. ri: tregisterindex;
  1504. reg: TRegister;
  1505. commentstr: AnsiString;
  1506. registers_found: Boolean;
  1507. begin
  1508. p:=tai(AsmL.First);
  1509. while (p<>AsmL.Last) Do
  1510. begin
  1511. if p.typ=ait_instruction then
  1512. begin
  1513. {$ifdef x86}
  1514. taicpu(p).SetOperandOrder(op_att);
  1515. {$endif x86}
  1516. commentstr:='Instruction reads';
  1517. registers_found:=false;
  1518. for ri in tregisterindex do
  1519. begin
  1520. reg:=regnumber_table[ri];
  1521. if (reg<>NR_NO) and InstructionLoadsFromReg(reg,p) then
  1522. begin
  1523. commentstr:=commentstr+' '+std_regname(reg);
  1524. registers_found:=true;
  1525. end;
  1526. end;
  1527. if not registers_found then
  1528. commentstr:=commentstr+' no registers';
  1529. commentstr:=commentstr+' and writes new values in';
  1530. registers_found:=false;
  1531. for ri in tregisterindex do
  1532. begin
  1533. reg:=regnumber_table[ri];
  1534. if (reg<>NR_NO) and RegLoadedWithNewValue(reg,p) then
  1535. begin
  1536. commentstr:=commentstr+' '+std_regname(reg);
  1537. registers_found:=true;
  1538. end;
  1539. end;
  1540. if not registers_found then
  1541. commentstr:=commentstr+' no registers';
  1542. AsmL.InsertAfter(tai_comment.Create(strpnew(commentstr)),p);
  1543. end;
  1544. p:=tai(p.next);
  1545. end;
  1546. end;
  1547. End.