aoptobj.pas 94 KB

123456789101112131415161718192021222324252627282930313233343536373839404142434445464748495051525354555657585960616263646566676869707172737475767778798081828384858687888990919293949596979899100101102103104105106107108109110111112113114115116117118119120121122123124125126127128129130131132133134135136137138139140141142143144145146147148149150151152153154155156157158159160161162163164165166167168169170171172173174175176177178179180181182183184185186187188189190191192193194195196197198199200201202203204205206207208209210211212213214215216217218219220221222223224225226227228229230231232233234235236237238239240241242243244245246247248249250251252253254255256257258259260261262263264265266267268269270271272273274275276277278279280281282283284285286287288289290291292293294295296297298299300301302303304305306307308309310311312313314315316317318319320321322323324325326327328329330331332333334335336337338339340341342343344345346347348349350351352353354355356357358359360361362363364365366367368369370371372373374375376377378379380381382383384385386387388389390391392393394395396397398399400401402403404405406407408409410411412413414415416417418419420421422423424425426427428429430431432433434435436437438439440441442443444445446447448449450451452453454455456457458459460461462463464465466467468469470471472473474475476477478479480481482483484485486487488489490491492493494495496497498499500501502503504505506507508509510511512513514515516517518519520521522523524525526527528529530531532533534535536537538539540541542543544545546547548549550551552553554555556557558559560561562563564565566567568569570571572573574575576577578579580581582583584585586587588589590591592593594595596597598599600601602603604605606607608609610611612613614615616617618619620621622623624625626627628629630631632633634635636637638639640641642643644645646647648649650651652653654655656657658659660661662663664665666667668669670671672673674675676677678679680681682683684685686687688689690691692693694695696697698699700701702703704705706707708709710711712713714715716717718719720721722723724725726727728729730731732733734735736737738739740741742743744745746747748749750751752753754755756757758759760761762763764765766767768769770771772773774775776777778779780781782783784785786787788789790791792793794795796797798799800801802803804805806807808809810811812813814815816817818819820821822823824825826827828829830831832833834835836837838839840841842843844845846847848849850851852853854855856857858859860861862863864865866867868869870871872873874875876877878879880881882883884885886887888889890891892893894895896897898899900901902903904905906907908909910911912913914915916917918919920921922923924925926927928929930931932933934935936937938939940941942943944945946947948949950951952953954955956957958959960961962963964965966967968969970971972973974975976977978979980981982983984985986987988989990991992993994995996997998999100010011002100310041005100610071008100910101011101210131014101510161017101810191020102110221023102410251026102710281029103010311032103310341035103610371038103910401041104210431044104510461047104810491050105110521053105410551056105710581059106010611062106310641065106610671068106910701071107210731074107510761077107810791080108110821083108410851086108710881089109010911092109310941095109610971098109911001101110211031104110511061107110811091110111111121113111411151116111711181119112011211122112311241125112611271128112911301131113211331134113511361137113811391140114111421143114411451146114711481149115011511152115311541155115611571158115911601161116211631164116511661167116811691170117111721173117411751176117711781179118011811182118311841185118611871188118911901191119211931194119511961197119811991200120112021203120412051206120712081209121012111212121312141215121612171218121912201221122212231224122512261227122812291230123112321233123412351236123712381239124012411242124312441245124612471248124912501251125212531254125512561257125812591260126112621263126412651266126712681269127012711272127312741275127612771278127912801281128212831284128512861287128812891290129112921293129412951296129712981299130013011302130313041305130613071308130913101311131213131314131513161317131813191320132113221323132413251326132713281329133013311332133313341335133613371338133913401341134213431344134513461347134813491350135113521353135413551356135713581359136013611362136313641365136613671368136913701371137213731374137513761377137813791380138113821383138413851386138713881389139013911392139313941395139613971398139914001401140214031404140514061407140814091410141114121413141414151416141714181419142014211422142314241425142614271428142914301431143214331434143514361437143814391440144114421443144414451446144714481449145014511452145314541455145614571458145914601461146214631464146514661467146814691470147114721473147414751476147714781479148014811482148314841485148614871488148914901491149214931494149514961497149814991500150115021503150415051506150715081509151015111512151315141515151615171518151915201521152215231524152515261527152815291530153115321533153415351536153715381539154015411542154315441545154615471548154915501551155215531554155515561557155815591560156115621563156415651566156715681569157015711572157315741575157615771578157915801581158215831584158515861587158815891590159115921593159415951596159715981599160016011602160316041605160616071608160916101611161216131614161516161617161816191620162116221623162416251626162716281629163016311632163316341635163616371638163916401641164216431644164516461647164816491650165116521653165416551656165716581659166016611662166316641665166616671668166916701671167216731674167516761677167816791680168116821683168416851686168716881689169016911692169316941695169616971698169917001701170217031704170517061707170817091710171117121713171417151716171717181719172017211722172317241725172617271728172917301731173217331734173517361737173817391740174117421743174417451746174717481749175017511752175317541755175617571758175917601761176217631764176517661767176817691770177117721773177417751776177717781779178017811782178317841785178617871788178917901791179217931794179517961797179817991800180118021803180418051806180718081809181018111812181318141815181618171818181918201821182218231824182518261827182818291830183118321833183418351836183718381839184018411842184318441845184618471848184918501851185218531854185518561857185818591860186118621863186418651866186718681869187018711872187318741875187618771878187918801881188218831884188518861887188818891890189118921893189418951896189718981899190019011902190319041905190619071908190919101911191219131914191519161917191819191920192119221923192419251926192719281929193019311932193319341935193619371938193919401941194219431944194519461947194819491950195119521953195419551956195719581959196019611962196319641965196619671968196919701971197219731974197519761977197819791980198119821983198419851986198719881989199019911992199319941995199619971998199920002001200220032004200520062007200820092010201120122013201420152016201720182019202020212022202320242025202620272028202920302031203220332034203520362037203820392040204120422043204420452046204720482049205020512052205320542055205620572058205920602061206220632064206520662067206820692070207120722073207420752076207720782079208020812082208320842085208620872088208920902091209220932094209520962097209820992100210121022103210421052106210721082109211021112112211321142115211621172118211921202121212221232124212521262127212821292130213121322133213421352136213721382139214021412142214321442145214621472148214921502151215221532154215521562157215821592160216121622163216421652166216721682169217021712172217321742175217621772178217921802181218221832184218521862187218821892190219121922193219421952196219721982199220022012202220322042205220622072208220922102211221222132214221522162217221822192220222122222223222422252226222722282229223022312232223322342235223622372238223922402241224222432244224522462247224822492250225122522253225422552256225722582259226022612262226322642265226622672268226922702271227222732274227522762277227822792280228122822283228422852286228722882289229022912292229322942295229622972298229923002301230223032304230523062307230823092310231123122313231423152316231723182319232023212322232323242325232623272328232923302331233223332334233523362337233823392340234123422343234423452346234723482349235023512352235323542355235623572358235923602361236223632364236523662367236823692370237123722373237423752376237723782379238023812382238323842385238623872388238923902391239223932394239523962397239823992400240124022403240424052406240724082409241024112412241324142415241624172418241924202421242224232424242524262427242824292430243124322433243424352436243724382439244024412442244324442445244624472448244924502451245224532454245524562457245824592460246124622463246424652466246724682469247024712472247324742475247624772478247924802481248224832484248524862487248824892490249124922493249424952496249724982499250025012502250325042505250625072508250925102511251225132514251525162517251825192520252125222523252425252526252725282529253025312532253325342535253625372538253925402541254225432544254525462547254825492550255125522553255425552556255725582559256025612562256325642565256625672568256925702571257225732574257525762577257825792580258125822583258425852586258725882589259025912592259325942595
  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. { $define DEBUG_AOPTOBJ}
  22. { $define DEBUG_JUMP}
  23. {$i fpcdefs.inc}
  24. { general, processor independent objects for use by the assembler optimizer }
  25. Interface
  26. uses
  27. globtype,
  28. aasmbase,aasmcpu,aasmtai,aasmdata,
  29. cclasses,
  30. cgbase,cgutils,
  31. cpubase,
  32. aoptbase,aoptcpub,aoptda;
  33. { ************************************************************************* }
  34. { ********************************* Constants ***************************** }
  35. { ************************************************************************* }
  36. Const
  37. {Possible register content types}
  38. con_Unknown = 0;
  39. con_ref = 1;
  40. con_const = 2;
  41. {***************** Types ****************}
  42. Type
  43. { ************************************************************************* }
  44. { ************************* Some general type definitions ***************** }
  45. { ************************************************************************* }
  46. TRefCompare = Function(const r1, r2: TReference): Boolean;
  47. //!!! FIXME
  48. TRegArray = Array[byte] of tsuperregister;
  49. TRegSet = tcpuregisterset;
  50. { possible actions on an operand: read, write or modify (= read & write) }
  51. TOpAction = (OpAct_Read, OpAct_Write, OpAct_Modify, OpAct_Unknown);
  52. { ************************************************************************* }
  53. { * Object to hold information on which regiters are in use and which not * }
  54. { ************************************************************************* }
  55. { TUsedRegs }
  56. TUsedRegs = class
  57. Constructor create(aTyp : TRegisterType);
  58. Constructor create_regset(aTyp : TRegisterType;Const _RegSet: TRegSet);
  59. Destructor Destroy;override;
  60. Procedure Clear;
  61. { update the info with the pairegalloc objects coming after
  62. p }
  63. procedure Update(p: Tai; IgnoreNewAllocs: Boolean=false);
  64. { is Reg currently in use }
  65. Function IsUsed(Reg: TRegister): Boolean;
  66. { get all the currently used registers }
  67. Function GetUsedRegs: TRegSet;
  68. { outputs the current set }
  69. Procedure Dump(var t : text);
  70. Private
  71. Typ : TRegisterType;
  72. UsedRegs: TRegSet;
  73. End;
  74. { ************************************************************************* }
  75. { ******************* Contents of the integer registers ******************* }
  76. { ************************************************************************* }
  77. { size of the integer that holds the state number of a register. Can be any }
  78. { integer type, so it can be changed to reduce the size of the TContent }
  79. { structure or to improve alignment }
  80. TStateInt = Byte;
  81. TContent = Record
  82. { start and end of block instructions that defines the }
  83. { content of this register. If Typ = con_const, then }
  84. { Longint(StartMod) = value of the constant) }
  85. StartMod: Tai;
  86. { starts at 0, gets increased everytime the register is }
  87. { written to }
  88. WState: TStateInt;
  89. { starts at 0, gets increased everytime the register is read }
  90. { from }
  91. RState: TStateInt;
  92. { how many instructions starting with StarMod does the block }
  93. { consist of }
  94. NrOfMods: Byte;
  95. { the type of the content of the register: unknown, memory }
  96. { (variable) or constant }
  97. Typ: Byte;
  98. End;
  99. //!!! FIXME
  100. TRegContent = Array[byte] Of TContent;
  101. { ************************************************************************** }
  102. { information object with the contents of every register. Every Tai object }
  103. { gets one of these assigned: a pointer to it is stored in the OptInfo field }
  104. { ************************************************************************** }
  105. { TPaiProp }
  106. TPaiProp = class(TAoptBaseCpu)
  107. Regs: TRegContent;
  108. { can this instruction be removed? }
  109. CanBeRemoved: Boolean;
  110. Constructor create; reintroduce;
  111. { checks the whole sequence of which (so regs[which].StartMod and and }
  112. { the next NrOfMods Tai objects) to see whether Reg is used somewhere, }
  113. { without it being loaded with something else first }
  114. Function RegInSequence(Reg, which: TRegister): Boolean;
  115. { destroy the contents of a register, as well as those whose contents }
  116. { are based on those of that register }
  117. Procedure DestroyReg(Reg: TRegister; var InstrSinceLastMod:
  118. TInstrSinceLastMod);
  119. { if the contents of WhichReg (can be R_NO in case of a constant) are }
  120. { written to memory at the location Ref, the contents of the registers }
  121. { that depend on Ref have to be destroyed }
  122. Procedure DestroyRefs(Const Ref: TReference; WhichReg: TRegister; var
  123. InstrSinceLastMod: TInstrSinceLastMod);
  124. { an instruction reads from operand o }
  125. Procedure ReadOp(const o:toper);
  126. { an instruction reads from reference Ref }
  127. Procedure ReadRef(Ref: PReference);
  128. { an instruction reads from register Reg }
  129. Procedure ReadReg(Reg: TRegister);
  130. { an instruction writes/modifies operand o and this has special }
  131. { side-effects or modifies the contents in such a way that we can't }
  132. { simply add this instruction to the sequence of instructions that }
  133. { describe the contents of the operand, so destroy it }
  134. Procedure DestroyOp(const o:Toper; var InstrSinceLastMod:
  135. TInstrSinceLastMod);
  136. { destroy the contents of all registers }
  137. Procedure DestroyAllRegs(var InstrSinceLastMod: TInstrSinceLastMod);
  138. { a register's contents are modified, but not destroyed (the new value
  139. depends on the old one) }
  140. Procedure ModifyReg(reg: TRegister; var InstrSinceLastMod:
  141. TInstrSinceLastMod);
  142. { an operand's contents are modified, but not destroyed (the new value
  143. depends on the old one) }
  144. Procedure ModifyOp(const oper: TOper; var InstrSinceLastMod:
  145. TInstrSinceLastMod);
  146. { increase the write state of a register (call every time a register is
  147. written to) }
  148. Procedure IncWState(Reg: TRegister);
  149. { increase the read state of a register (call every time a register is }
  150. { read from) }
  151. Procedure IncRState(Reg: TRegister);
  152. { get the write state of a register }
  153. Function GetWState(Reg: TRegister): TStateInt;
  154. { get the read state of a register }
  155. Function GetRState(Reg: TRegister): TStateInt;
  156. { get the type of contents of a register }
  157. Function GetRegContentType(Reg: TRegister): Byte;
  158. Destructor Done;
  159. Private
  160. Procedure IncState(var s: TStateInt);
  161. { returns whether the reference Ref is used somewhere in the loading }
  162. { sequence Content }
  163. class function RefInSequence(Const Ref: TReference; Content: TContent;
  164. RefsEq: TRefCompare): Boolean; static;
  165. { returns whether the instruction P reads from and/or writes }
  166. { to Reg }
  167. class function RefInInstruction(Const Ref: TReference; p: Tai;
  168. RefsEq: TRefCompare): Boolean; static;
  169. { returns whether two references with at least one pointing to an array }
  170. { may point to the same memory location }
  171. End;
  172. { ************************************************************************* }
  173. { ************************ Label information ****************************** }
  174. { ************************************************************************* }
  175. TLabelTableItem = Record
  176. PaiObj: Tai;
  177. End;
  178. TLabelTable = Array[0..2500000] Of TLabelTableItem;
  179. PLabelTable = ^TLabelTable;
  180. PLabelInfo = ^TLabelInfo;
  181. TLabelInfo = Record
  182. { the highest and lowest label number occurring in the current code }
  183. { fragment }
  184. LowLabel, HighLabel: longint;
  185. LabelDif: cardinal;
  186. { table that contains the addresses of the Pai_Label objects associated
  187. with each label number }
  188. LabelTable: PLabelTable;
  189. End;
  190. { ************************************************************************* }
  191. { ********** General optimizer object, used to derive others from ********* }
  192. { ************************************************************************* }
  193. TAllUsedRegs = array[TRegisterType] of TUsedRegs;
  194. { TAOptObj }
  195. TAOptObj = class(TAoptBaseCpu)
  196. { the PAasmOutput list this optimizer instance works on }
  197. AsmL: TAsmList;
  198. { The labelinfo record contains the addresses of the Tai objects }
  199. { that are labels, how many labels there are and the min and max }
  200. { label numbers }
  201. LabelInfo: PLabelInfo;
  202. { Start and end of the block that is currently being optimized, and
  203. a selected start point after the start of the block }
  204. BlockStart, BlockEnd, StartPoint: Tai;
  205. DFA: TAOptDFA;
  206. UsedRegs: TAllUsedRegs;
  207. { _AsmL is the PAasmOutpout list that has to be optimized, }
  208. { _BlockStart and _BlockEnd the start and the end of the block }
  209. { that has to be optimized and _LabelInfo a pointer to a }
  210. { TLabelInfo record }
  211. Constructor create(_AsmL: TAsmList; _BlockStart, _BlockEnd: Tai;
  212. _LabelInfo: PLabelInfo); virtual; reintroduce;
  213. Destructor Destroy;override;
  214. { processor independent methods }
  215. Procedure CreateUsedRegs(var regs: TAllUsedRegs);
  216. Procedure ClearUsedRegs;
  217. Procedure UpdateUsedRegs(p : Tai);
  218. class procedure UpdateUsedRegs(var Regs: TAllUsedRegs; p: Tai); static;
  219. { If UpdateUsedRegsAndOptimize has read ahead, the result is one before
  220. the next valid entry (so "p.Next" returns what's expected). If no
  221. reading ahead happened, then the result is equal to p. }
  222. function UpdateUsedRegsAndOptimize(p : Tai): Tai;
  223. Function CopyUsedRegs(var dest : TAllUsedRegs) : boolean;
  224. procedure RestoreUsedRegs(const Regs : TAllUsedRegs);
  225. procedure TransferUsedRegs(var dest: TAllUsedRegs);
  226. class procedure ReleaseUsedRegs(const regs : TAllUsedRegs); static;
  227. class function RegInUsedRegs(reg : TRegister;regs : TAllUsedRegs) : boolean; static;
  228. class procedure IncludeRegInUsedRegs(reg : TRegister;var regs : TAllUsedRegs); static;
  229. class procedure ExcludeRegFromUsedRegs(reg: TRegister;var regs : TAllUsedRegs); static;
  230. class function GetAllocationString(const regs : TAllUsedRegs) : string; static;
  231. { returns true if the label L is found between hp and the next }
  232. { instruction }
  233. class function FindLabel(L: TasmLabel; Var hp: Tai): Boolean; static;
  234. { inserts new_one between prev and foll in AsmL }
  235. Procedure InsertLLItem(prev, foll, new_one: TLinkedListItem);
  236. { If P is a Tai object releveant to the optimizer, P is returned
  237. If it is not relevant tot he optimizer, the first object after P
  238. that is relevant is returned }
  239. class function SkipHead(P: Tai): Tai; static;
  240. { returns true if the operands o1 and o2 are completely equal }
  241. class function OpsEqual(const o1,o2:toper): Boolean; static;
  242. { Returns the next ait_alloc object with ratype ra_alloc for
  243. Reg is found in the block
  244. of Tai's starting with StartPai and ending with the next "real"
  245. instruction. If none is found, it returns
  246. nil
  247. }
  248. class function FindRegAlloc(Reg: TRegister; StartPai: Tai): tai_regalloc; static;
  249. { Returns the last ait_alloc object with ratype ra_alloc for
  250. Reg is found in the block
  251. of Tai's starting with StartPai and ending with the next "real"
  252. instruction. If none is found, it returns
  253. nil
  254. }
  255. class function FindRegAllocBackward(Reg : TRegister; StartPai : Tai) : tai_regalloc; static;
  256. { Returns the next ait_alloc object with ratype ra_dealloc
  257. for Reg which is found in the block of Tai's starting with StartPai
  258. and ending with the next "real" instruction. If none is found, it returns
  259. nil }
  260. class function FindRegDeAlloc(Reg: TRegister; StartPai: Tai): tai_regalloc; static;
  261. { allocates register reg between (and including) instructions p1 and p2
  262. the type of p1 and p2 must not be in SkipInstr }
  263. procedure AllocRegBetween(reg : tregister; p1,p2 : tai; var initialusedregs : TAllUsedRegs);
  264. { reg used after p? }
  265. function RegUsedAfterInstruction(reg: Tregister; p: tai; var AllUsedRegs: TAllUsedRegs): Boolean;
  266. { returns true if reg reaches it's end of life at p, this means it is either
  267. reloaded with a new value or it is deallocated afterwards }
  268. function RegEndOfLife(reg: TRegister;p: taicpu): boolean;
  269. { removes p from asml, updates registers and replaces it by a valid value, if this is the case true is returned }
  270. function RemoveCurrentP(var p : tai): boolean;
  271. { traces sucessive jumps to their final destination and sets it, e.g.
  272. je l1 je l3
  273. <code> <code>
  274. l1: becomes l1:
  275. je l2 je l3
  276. <code> <code>
  277. l2: l2:
  278. jmp l3 jmp l3
  279. the level parameter denotes how deeep we have already followed the jump,
  280. to avoid endless loops with constructs such as "l5: ; jmp l5" }
  281. function GetFinalDestination(hp: taicpu; level: longint): boolean;
  282. function getlabelwithsym(sym: tasmlabel): tai;
  283. { Removes an instruction following hp1 (possibly with reg.deallocations in between),
  284. if its opcode is A_NOP. }
  285. procedure RemoveDelaySlot(hp1: tai);
  286. { peephole optimizer }
  287. procedure PrePeepHoleOpts; virtual;
  288. procedure PeepHoleOptPass1; virtual;
  289. procedure PeepHoleOptPass2; virtual;
  290. procedure PostPeepHoleOpts; virtual;
  291. { processor dependent methods }
  292. // if it returns true, perform a "continue"
  293. function PrePeepHoleOptsCpu(var p: tai): boolean; virtual;
  294. function PeepHoleOptPass1Cpu(var p: tai): boolean; virtual;
  295. function PeepHoleOptPass2Cpu(var p: tai): boolean; virtual;
  296. function PostPeepHoleOptsCpu(var p: tai): boolean; virtual;
  297. { Output debug message to console - null function if EXTDEBUG is not defined }
  298. class procedure DebugWrite(Message: string); static; inline;
  299. { Converts a conditional jump into an unconditional jump. Only call this
  300. procedure on an instruction that you already know is a conditional jump }
  301. procedure MakeUnconditional(p: taicpu); virtual;
  302. { Removes all instructions between an unconditional jump and the next label.
  303. Returns True if a jump in between was removed (as it may open up new
  304. optimisations if the label appeared earlier in the stream) }
  305. function RemoveDeadCodeAfterJump(p: tai): Boolean;
  306. { If hp is a label, strip it if its reference count is zero. Repeat until
  307. a non-label is found, or a label with a non-zero reference count.
  308. True is returned if something was stripped }
  309. function StripDeadLabels(hp: tai; var NextValid: tai): Boolean;
  310. { Strips a label and any aligns that appear before it (if hp points to
  311. them rather than the label). Only call this procedure on a label that
  312. you already know is no longer referenced }
  313. procedure StripLabelFast(hp: tai); {$ifdef USEINLINE}inline;{$endif USEINLINE}
  314. { Checks and removes "jmp @@lbl; @lbl". Returns True if the jump was removed }
  315. function CollapseZeroDistJump(var p: tai; ThisLabel: TAsmLabel): Boolean;
  316. { If a group of labels are clustered, change the jump to point to the last one that is still referenced }
  317. function CollapseLabelCluster(jump: tai; var lbltai: tai): TAsmLabel;
  318. {$ifndef JVM}
  319. function OptimizeConditionalJump(CJLabel: TAsmLabel; var p: tai; hp1: tai; var stoploop: Boolean): Boolean;
  320. {$endif JVM}
  321. { Function to determine if the jump optimisations can be performed }
  322. function CanDoJumpOpts: Boolean; virtual;
  323. { Jump/label optimisation entry method }
  324. function DoJumpOptimizations(var p: tai; var stoploop: Boolean): Boolean;
  325. { insert debug comments about which registers are read and written by
  326. each instruction. Useful for debugging the InstructionLoadsFromReg and
  327. other similar functions. }
  328. procedure Debug_InsertInstrRegisterDependencyInfo; virtual;
  329. private
  330. procedure DebugMsg(const s: string; p: tai);
  331. End;
  332. Function ArrayRefsEq(const r1, r2: TReference): Boolean;
  333. { Returns a pointer to the operand that contains the destination label }
  334. function JumpTargetOp(ai: taicpu): poper;
  335. { Returns True if hp is any jump to a label }
  336. function IsJumpToLabel(hp: taicpu): boolean;
  337. { Returns True if hp is an unconditional jump to a label }
  338. function IsJumpToLabelUncond(hp: taicpu): boolean;
  339. { ***************************** Implementation **************************** }
  340. Implementation
  341. uses
  342. cutils,
  343. globals,
  344. verbose,
  345. aoptutils,
  346. aasmcfi,
  347. {$if defined(ARM)}
  348. cpuinfo,
  349. {$endif defined(ARM)}
  350. procinfo;
  351. {$ifdef DEBUG_AOPTOBJ}
  352. const
  353. SPeepholeOptimization: shortstring = 'Peephole Optimization: ';
  354. {$else DEBUG_AOPTOBJ}
  355. { Empty strings help the optimizer to remove string concatenations that won't
  356. ever appear to the user on release builds. [Kit] }
  357. const
  358. SPeepholeOptimization = '';
  359. {$endif DEBUG_AOPTOBJ}
  360. function JumpTargetOp(ai: taicpu): poper; inline;
  361. begin
  362. {$if defined(MIPS) or defined(riscv64) or defined(riscv32)}
  363. { MIPS or RiscV branches can have 1,2 or 3 operands, target label is the last one. }
  364. result:=ai.oper[ai.ops-1];
  365. {$elseif defined(SPARC64)}
  366. if ai.ops=2 then
  367. result:=ai.oper[1]
  368. else
  369. result:=ai.oper[0];
  370. {$else MIPS}
  371. result:=ai.oper[0];
  372. {$endif}
  373. end;
  374. { ************************************************************************* }
  375. { ******************************** TUsedRegs ****************************** }
  376. { ************************************************************************* }
  377. Constructor TUsedRegs.create(aTyp : TRegisterType);
  378. Begin
  379. Typ:=aTyp;
  380. UsedRegs := [];
  381. End;
  382. Constructor TUsedRegs.create_regset(aTyp : TRegisterType;Const _RegSet: TRegSet);
  383. Begin
  384. Typ:=aTyp;
  385. UsedRegs := _RegSet;
  386. End;
  387. {
  388. updates UsedRegs with the RegAlloc Information coming after P
  389. }
  390. Procedure TUsedRegs.Update(p: Tai;IgnoreNewAllocs : Boolean = false);
  391. Begin
  392. { this code is normally not used because updating the register allocation information is done in
  393. TAOptObj.UpdateUsedRegs for speed reasons }
  394. repeat
  395. while assigned(p) and
  396. ((p.typ in (SkipInstr - [ait_RegAlloc])) or
  397. (p.typ = ait_label) or
  398. ((p.typ = ait_marker) and
  399. (tai_Marker(p).Kind in [mark_AsmBlockEnd,mark_NoLineInfoStart,mark_NoLineInfoEnd]))) do
  400. p := tai(p.next);
  401. while assigned(p) and
  402. (p.typ=ait_RegAlloc) Do
  403. begin
  404. if (getregtype(tai_regalloc(p).reg) = typ) then
  405. begin
  406. case tai_regalloc(p).ratype of
  407. ra_alloc :
  408. if not(IgnoreNewAllocs) then
  409. Include(UsedRegs, getsupreg(tai_regalloc(p).reg));
  410. ra_dealloc :
  411. Exclude(UsedRegs, getsupreg(tai_regalloc(p).reg));
  412. else
  413. ;
  414. end;
  415. end;
  416. p := tai(p.next);
  417. end;
  418. until not(assigned(p)) or
  419. (not(p.typ in SkipInstr) and
  420. not((p.typ = ait_label) and
  421. labelCanBeSkipped(tai_label(p))));
  422. End;
  423. Function TUsedRegs.IsUsed(Reg: TRegister): Boolean;
  424. Begin
  425. IsUsed := (getregtype(Reg)=Typ) and (getsupreg(Reg) in UsedRegs);
  426. End;
  427. Function TUsedRegs.GetUsedRegs: TRegSet; inline;
  428. Begin
  429. GetUsedRegs := UsedRegs;
  430. End;
  431. procedure TUsedRegs.Dump(var t: text);
  432. var
  433. i: dword;
  434. begin
  435. write(t,Typ,' ');
  436. for i:=low(TRegSet) to high(TRegSet) do
  437. if i in UsedRegs then
  438. write(t,i,' ');
  439. writeln(t);
  440. end;
  441. Destructor TUsedRegs.Destroy;
  442. Begin
  443. inherited destroy;
  444. end;
  445. procedure TUsedRegs.Clear;
  446. begin
  447. UsedRegs := [];
  448. end;
  449. { ************************************************************************* }
  450. { **************************** TPaiProp *********************************** }
  451. { ************************************************************************* }
  452. Constructor TPaiProp.Create;
  453. Begin
  454. {!!!!!!
  455. UsedRegs.Init;
  456. CondRegs.init;
  457. }
  458. { DirFlag: TFlagContents; I386 specific}
  459. End;
  460. Function TPaiProp.RegInSequence(Reg, which: TRegister): Boolean;
  461. {
  462. Var p: Tai;
  463. RegsChecked: TRegSet;
  464. content: TContent;
  465. Counter: Byte;
  466. TmpResult: Boolean;
  467. }
  468. begin
  469. Result:=False; { unimplemented }
  470. (*!!!!!!!!!!1
  471. RegsChecked := [];
  472. content := regs[which];
  473. p := content.StartMod;
  474. TmpResult := False;
  475. Counter := 1;
  476. While Not(TmpResult) And
  477. (Counter <= Content.NrOfMods) Do
  478. Begin
  479. If IsLoadMemReg(p) Then
  480. With PInstr(p)^.oper[LoadSrc]^.ref^ Do
  481. If (Base = ProcInfo.FramePointer)
  482. {$ifdef cpurefshaveindexreg}
  483. And (Index = R_NO)
  484. {$endif cpurefshaveindexreg} Then
  485. Begin
  486. RegsChecked := RegsChecked +
  487. [RegMaxSize(PInstr(p)^.oper[LoadDst]^.reg)];
  488. If Reg = RegMaxSize(PInstr(p)^.oper[LoadDst]^.reg) Then
  489. Break;
  490. End
  491. Else
  492. Begin
  493. If (Base = Reg) And
  494. Not(Base In RegsChecked)
  495. Then TmpResult := True;
  496. {$ifdef cpurefshaveindexreg}
  497. If Not(TmpResult) And
  498. (Index = Reg) And
  499. Not(Index In RegsChecked)
  500. Then TmpResult := True;
  501. {$Endif cpurefshaveindexreg}
  502. End
  503. Else TmpResult := RegInInstruction(Reg, p);
  504. Inc(Counter);
  505. GetNextInstruction(p,p)
  506. End;
  507. RegInSequence := TmpResult
  508. *)
  509. End;
  510. Procedure TPaiProp.DestroyReg(Reg: TRegister; var InstrSinceLastMod:
  511. TInstrSinceLastMod);
  512. { Destroys the contents of the register Reg in the PPaiProp p1, as well as }
  513. { the contents of registers are loaded with a memory location based on Reg }
  514. {
  515. Var TmpWState, TmpRState: Byte;
  516. Counter: TRegister;
  517. }
  518. Begin
  519. {!!!!!!!
  520. Reg := RegMaxSize(Reg);
  521. If (Reg in [LoGPReg..HiGPReg]) Then
  522. For Counter := LoGPReg to HiGPReg Do
  523. With Regs[Counter] Do
  524. If (Counter = reg) Or
  525. ((Typ = Con_Ref) And
  526. RegInSequence(Reg, Counter)) Then
  527. Begin
  528. InstrSinceLastMod[Counter] := 0;
  529. IncWState(Counter);
  530. TmpWState := GetWState(Counter);
  531. TmpRState := GetRState(Counter);
  532. FillChar(Regs[Counter], SizeOf(TContent), 0);
  533. WState := TmpWState;
  534. RState := TmpRState
  535. End
  536. }
  537. End;
  538. Function ArrayRefsEq(const r1, r2: TReference): Boolean;
  539. Begin
  540. Result:=False; { unimplemented }
  541. (*!!!!!!!!!!
  542. ArrayRefsEq := (R1.Offset+R1.OffsetFixup = R2.Offset+R2.OffsetFixup) And
  543. {$ifdef refsHaveSegmentReg}
  544. (R1.Segment = R2.Segment) And
  545. {$endif}
  546. (R1.Base = R2.Base) And
  547. (R1.Symbol=R2.Symbol);
  548. *)
  549. End;
  550. Procedure TPaiProp.DestroyRefs(Const Ref: TReference; WhichReg: TRegister;
  551. var InstrSinceLastMod: TInstrSinceLastMod);
  552. { destroys all registers which possibly contain a reference to Ref, WhichReg }
  553. { is the register whose contents are being written to memory (if this proc }
  554. { is called because of a "mov?? %reg, (mem)" instruction) }
  555. {
  556. Var RefsEq: TRefCompare;
  557. Counter: TRegister;
  558. }
  559. Begin
  560. (*!!!!!!!!!!!
  561. WhichReg := RegMaxSize(WhichReg);
  562. If (Ref.base = procinfo.FramePointer) or
  563. Assigned(Ref.Symbol) Then
  564. Begin
  565. If
  566. {$ifdef cpurefshaveindexreg}
  567. (Ref.Index = R_NO) And
  568. {$endif cpurefshaveindexreg}
  569. (Not(Assigned(Ref.Symbol)) or
  570. (Ref.base = R_NO)) Then
  571. { local variable which is not an array }
  572. RefsEq := @RefsEqual
  573. Else
  574. { local variable which is an array }
  575. RefsEq := @ArrayRefsEq;
  576. {write something to a parameter, a local or global variable, so
  577. * with uncertain optimizations on:
  578. - destroy the contents of registers whose contents have somewhere a
  579. "mov?? (Ref), %reg". WhichReg (this is the register whose contents
  580. are being written to memory) is not destroyed if it's StartMod is
  581. of that form and NrOfMods = 1 (so if it holds ref, but is not a
  582. pointer or value based on Ref)
  583. * with uncertain optimizations off:
  584. - also destroy registers that contain any pointer}
  585. For Counter := LoGPReg to HiGPReg Do
  586. With Regs[Counter] Do
  587. Begin
  588. If (typ = Con_Ref) And
  589. ((Not(cs_opt_size in current_settings.optimizerswitches) And
  590. (NrOfMods <> 1)
  591. ) Or
  592. (RefInSequence(Ref,Regs[Counter], RefsEq) And
  593. ((Counter <> WhichReg) Or
  594. ((NrOfMods <> 1) And
  595. {StarMod is always of the type ait_instruction}
  596. (PInstr(StartMod)^.oper[0].typ = top_ref) And
  597. RefsEq(PInstr(StartMod)^.oper[0].ref^, Ref)
  598. )
  599. )
  600. )
  601. )
  602. Then
  603. DestroyReg(Counter, InstrSinceLastMod)
  604. End
  605. End
  606. Else
  607. {write something to a pointer location, so
  608. * with uncertain optimzations on:
  609. - do not destroy registers which contain a local/global variable or a
  610. parameter, except if DestroyRefs is called because of a "movsl"
  611. * with uncertain optimzations off:
  612. - destroy every register which contains a memory location
  613. }
  614. For Counter := LoGPReg to HiGPReg Do
  615. With Regs[Counter] Do
  616. If (typ = Con_Ref) And
  617. (Not(cs_opt_size in current_settings.optimizerswitches) Or
  618. {$ifdef x86}
  619. {for movsl}
  620. (Ref.Base = R_EDI) Or
  621. {$endif}
  622. {don't destroy if reg contains a parameter, local or global variable}
  623. Not((NrOfMods = 1) And
  624. (PInstr(StartMod)^.oper[0].typ = top_ref) And
  625. ((PInstr(StartMod)^.oper[0].ref^.base = ProcInfo.FramePointer) Or
  626. Assigned(PInstr(StartMod)^.oper[0].ref^.Symbol)
  627. )
  628. )
  629. )
  630. Then DestroyReg(Counter, InstrSinceLastMod)
  631. *)
  632. End;
  633. Procedure TPaiProp.DestroyAllRegs(var InstrSinceLastMod: TInstrSinceLastMod);
  634. {Var Counter: TRegister;}
  635. Begin {initializes/desrtoys all registers}
  636. (*!!!!!!!!!
  637. For Counter := LoGPReg To HiGPReg Do
  638. Begin
  639. ReadReg(Counter);
  640. DestroyReg(Counter, InstrSinceLastMod);
  641. End;
  642. CondRegs.Init;
  643. { FPURegs.Init; }
  644. *)
  645. End;
  646. Procedure TPaiProp.DestroyOp(const o:Toper; var InstrSinceLastMod:
  647. TInstrSinceLastMod);
  648. Begin
  649. {!!!!!!!
  650. Case o.typ Of
  651. top_reg: DestroyReg(o.reg, InstrSinceLastMod);
  652. top_ref:
  653. Begin
  654. ReadRef(o.ref);
  655. DestroyRefs(o.ref^, R_NO, InstrSinceLastMod);
  656. End;
  657. top_symbol:;
  658. End;
  659. }
  660. End;
  661. Procedure TPaiProp.ReadReg(Reg: TRegister);
  662. Begin
  663. {!!!!!!!
  664. Reg := RegMaxSize(Reg);
  665. If Reg in General_Registers Then
  666. IncRState(RegMaxSize(Reg))
  667. }
  668. End;
  669. Procedure TPaiProp.ReadRef(Ref: PReference);
  670. Begin
  671. (*!!!!!!
  672. If Ref^.Base <> R_NO Then
  673. ReadReg(Ref^.Base);
  674. {$ifdef cpurefshaveindexreg}
  675. If Ref^.Index <> R_NO Then
  676. ReadReg(Ref^.Index);
  677. {$endif cpurefshaveindexreg}
  678. *)
  679. End;
  680. Procedure TPaiProp.ReadOp(const o:toper);
  681. Begin
  682. Case o.typ Of
  683. top_reg: ReadReg(o.reg);
  684. top_ref: ReadRef(o.ref);
  685. else
  686. internalerror(200410241);
  687. End;
  688. End;
  689. Procedure TPaiProp.ModifyReg(reg: TRegister; Var InstrSinceLastMod:
  690. TInstrSinceLastMod);
  691. Begin
  692. (*!!!!!!!
  693. With Regs[reg] Do
  694. If (Typ = Con_Ref)
  695. Then
  696. Begin
  697. IncState(WState);
  698. {also store how many instructions are part of the sequence in the first
  699. instructions PPaiProp, so it can be easily accessed from within
  700. CheckSequence}
  701. Inc(NrOfMods, InstrSinceLastMod[Reg]);
  702. PPaiProp(StartMod.OptInfo)^.Regs[Reg].NrOfMods := NrOfMods;
  703. InstrSinceLastMod[Reg] := 0;
  704. End
  705. Else
  706. DestroyReg(Reg, InstrSinceLastMod);
  707. *)
  708. End;
  709. Procedure TPaiProp.ModifyOp(const oper: TOper; var InstrSinceLastMod:
  710. TInstrSinceLastMod);
  711. Begin
  712. If oper.typ = top_reg Then
  713. ModifyReg(RegMaxSize(oper.reg),InstrSinceLastMod)
  714. Else
  715. Begin
  716. ReadOp(oper);
  717. DestroyOp(oper, InstrSinceLastMod);
  718. End
  719. End;
  720. Procedure TPaiProp.IncWState(Reg: TRegister);{$ifdef inl} inline;{$endif inl}
  721. Begin
  722. //!!!! IncState(Regs[Reg].WState);
  723. End;
  724. Procedure TPaiProp.IncRState(Reg: TRegister);{$ifdef inl} inline;{$endif inl}
  725. Begin
  726. //!!!! IncState(Regs[Reg].RState);
  727. End;
  728. Function TPaiProp.GetWState(Reg: TRegister): TStateInt; {$ifdef inl} inline;{$endif inl}
  729. Begin
  730. Result:=0; { unimplemented }
  731. //!!!! GetWState := Regs[Reg].WState
  732. End;
  733. Function TPaiProp.GetRState(Reg: TRegister): TStateInt; {$ifdef inl} inline;{$endif inl}
  734. Begin
  735. Result:=0; { unimplemented }
  736. //!!!! GetRState := Regs[Reg].RState
  737. End;
  738. Function TPaiProp.GetRegContentType(Reg: TRegister): Byte; {$ifdef inl} inline;{$endif inl}
  739. Begin
  740. Result:=0; { unimplemented }
  741. //!!!! GetRegContentType := Regs[Reg].typ
  742. End;
  743. Destructor TPaiProp.Done;
  744. Begin
  745. //!!!! UsedRegs.Done;
  746. //!!!! CondRegs.Done;
  747. { DirFlag: TFlagContents; I386 specific}
  748. End;
  749. { ************************ private TPaiProp stuff ************************* }
  750. Procedure TPaiProp.IncState(Var s: TStateInt); {$ifdef inl} inline;{$endif inl}
  751. Begin
  752. If s <> High(TStateInt) Then Inc(s)
  753. Else s := 0
  754. End;
  755. class Function TPaiProp.RefInInstruction(Const Ref: TReference; p: Tai;
  756. RefsEq: TRefCompare): Boolean;
  757. Var Count: AWord;
  758. TmpResult: Boolean;
  759. Begin
  760. TmpResult := False;
  761. If (p.typ = ait_instruction) Then
  762. Begin
  763. Count := 0;
  764. Repeat
  765. If (TInstr(p).oper[Count]^.typ = Top_Ref) Then
  766. TmpResult := RefsEq(Ref, PInstr(p)^.oper[Count]^.ref^);
  767. Inc(Count);
  768. Until (Count = max_operands) or TmpResult;
  769. End;
  770. RefInInstruction := TmpResult;
  771. End;
  772. class function TPaiProp.RefInSequence(Const Ref: TReference; Content: TContent;
  773. RefsEq: TRefCompare): Boolean;
  774. Var p: Tai;
  775. Counter: Byte;
  776. TmpResult: Boolean;
  777. Begin
  778. p := Content.StartMod;
  779. TmpResult := False;
  780. Counter := 1;
  781. While Not(TmpResult) And
  782. (Counter <= Content.NrOfMods) Do
  783. Begin
  784. If (p.typ = ait_instruction) And
  785. RefInInstruction(Ref, p, @references_equal)
  786. Then TmpResult := True;
  787. Inc(Counter);
  788. GetNextInstruction(p,p)
  789. End;
  790. RefInSequence := TmpResult
  791. End;
  792. { ************************************************************************* }
  793. { ***************************** TAoptObj ********************************** }
  794. { ************************************************************************* }
  795. Constructor TAoptObj.create(_AsmL: TAsmList; _BlockStart, _BlockEnd: Tai;
  796. _LabelInfo: PLabelInfo);
  797. Begin
  798. AsmL := _AsmL;
  799. BlockStart := _BlockStart;
  800. BlockEnd := _BlockEnd;
  801. LabelInfo := _LabelInfo;
  802. CreateUsedRegs(UsedRegs);
  803. End;
  804. destructor TAOptObj.Destroy;
  805. var
  806. i : TRegisterType;
  807. begin
  808. for i:=low(TRegisterType) to high(TRegisterType) do
  809. UsedRegs[i].Destroy;
  810. inherited Destroy;
  811. end;
  812. {$ifdef DEBUG_AOPTOBJ}
  813. procedure TAOptObj.DebugMsg(const s: string;p : tai);
  814. begin
  815. asml.insertbefore(tai_comment.Create(strpnew(s)), p);
  816. end;
  817. {$else DEBUG_AOPTOBJ}
  818. procedure TAOptObj.DebugMsg(const s: string;p : tai);inline;
  819. begin
  820. end;
  821. {$endif DEBUG_AOPTOBJ}
  822. procedure TAOptObj.CreateUsedRegs(var regs: TAllUsedRegs);
  823. var
  824. i : TRegisterType;
  825. begin
  826. for i:=low(TRegisterType) to high(TRegisterType) do
  827. Regs[i]:=TUsedRegs.Create(i);
  828. end;
  829. procedure TAOptObj.ClearUsedRegs;
  830. var
  831. i : TRegisterType;
  832. begin
  833. for i:=low(TRegisterType) to high(TRegisterType) do
  834. UsedRegs[i].Clear;
  835. end;
  836. { If UpdateUsedRegsAndOptimize has read ahead, the result is one before
  837. the next valid entry (so "p.Next" returns what's expected). If no
  838. reading ahead happened, then the result is equal to p. }
  839. function TAOptObj.UpdateUsedRegsAndOptimize(p : Tai): Tai;
  840. var
  841. NotFirst: Boolean;
  842. begin
  843. { this code is based on TUsedRegs.Update to avoid multiple passes through the asmlist,
  844. the code is duplicated here }
  845. Result := p;
  846. if (p.typ in [ait_instruction, ait_label]) then
  847. begin
  848. if (p.next <> BlockEnd) and (tai(p.next).typ <> ait_instruction) then
  849. begin
  850. { Advance one, otherwise the routine exits immediately and wastes time }
  851. p := tai(p.Next);
  852. NotFirst := True;
  853. end
  854. else
  855. { If the next entry is an instruction, nothing will be updated or
  856. optimised here, so exit now to save time }
  857. Exit;
  858. end
  859. else
  860. NotFirst := False;
  861. repeat
  862. while assigned(p) and
  863. ((p.typ in (SkipInstr + [ait_align, ait_label] - [ait_RegAlloc])) or
  864. ((p.typ = ait_marker) and
  865. (tai_Marker(p).Kind in [mark_AsmBlockEnd,mark_NoLineInfoStart,mark_NoLineInfoEnd]))) do
  866. begin
  867. prefetch(pointer(p.Next)^);
  868. { Here's the optimise part }
  869. if (p.typ in [ait_align, ait_label]) then
  870. begin
  871. if StripDeadLabels(p, p) then
  872. begin
  873. { Note, if the first instruction is stripped and is
  874. the only one that gets removed, Result will now
  875. contain a dangling pointer, so compensate for this. }
  876. if not NotFirst then
  877. Result := tai(p.Previous);
  878. Continue;
  879. end;
  880. if ((p.typ = ait_label) and not labelCanBeSkipped(tai_label(p))) then
  881. Break;
  882. end;
  883. Result := p;
  884. p := tai(p.next);
  885. end;
  886. while assigned(p) and
  887. (p.typ=ait_RegAlloc) Do
  888. begin
  889. prefetch(pointer(p.Next)^);
  890. case tai_regalloc(p).ratype of
  891. ra_alloc :
  892. Include(UsedRegs[getregtype(tai_regalloc(p).reg)].UsedRegs, getsupreg(tai_regalloc(p).reg));
  893. ra_dealloc :
  894. Exclude(UsedRegs[getregtype(tai_regalloc(p).reg)].UsedRegs, getsupreg(tai_regalloc(p).reg));
  895. else
  896. { Do nothing };
  897. end;
  898. Result := p;
  899. p := tai(p.next);
  900. end;
  901. NotFirst := True;
  902. until not(assigned(p)) or
  903. (not(p.typ in SkipInstr + [ait_align]) and
  904. not((p.typ = ait_label) and
  905. labelCanBeSkipped(tai_label(p))));
  906. end;
  907. procedure TAOptObj.UpdateUsedRegs(p : Tai);
  908. begin
  909. { this code is based on TUsedRegs.Update to avoid multiple passes through the asmlist,
  910. the code is duplicated here }
  911. repeat
  912. while assigned(p) and
  913. ((p.typ in (SkipInstr - [ait_RegAlloc])) or
  914. ((p.typ = ait_label) and
  915. labelCanBeSkipped(tai_label(p))) or
  916. ((p.typ = ait_marker) and
  917. (tai_Marker(p).Kind in [mark_AsmBlockEnd,mark_NoLineInfoStart,mark_NoLineInfoEnd]))) do
  918. p := tai(p.next);
  919. while assigned(p) and
  920. (p.typ=ait_RegAlloc) Do
  921. begin
  922. prefetch(pointer(p.Next)^);
  923. case tai_regalloc(p).ratype of
  924. ra_alloc :
  925. Include(UsedRegs[getregtype(tai_regalloc(p).reg)].UsedRegs, getsupreg(tai_regalloc(p).reg));
  926. ra_dealloc :
  927. Exclude(UsedRegs[getregtype(tai_regalloc(p).reg)].UsedRegs, getsupreg(tai_regalloc(p).reg));
  928. else
  929. ;
  930. end;
  931. p := tai(p.next);
  932. end;
  933. until not(assigned(p)) or
  934. (not(p.typ in SkipInstr) and
  935. not((p.typ = ait_label) and
  936. labelCanBeSkipped(tai_label(p))));
  937. end;
  938. class procedure TAOptObj.UpdateUsedRegs(var Regs : TAllUsedRegs;p : Tai);
  939. var
  940. i : TRegisterType;
  941. begin
  942. for i:=low(TRegisterType) to high(TRegisterType) do
  943. Regs[i].Update(p);
  944. end;
  945. function TAOptObj.CopyUsedRegs(var dest: TAllUsedRegs): boolean;
  946. var
  947. i : TRegisterType;
  948. begin
  949. Result:=true;
  950. for i:=low(TRegisterType) to high(TRegisterType) do
  951. dest[i]:=TUsedRegs.Create_Regset(i,UsedRegs[i].GetUsedRegs);
  952. end;
  953. procedure TAOptObj.RestoreUsedRegs(const Regs: TAllUsedRegs);
  954. var
  955. i : TRegisterType;
  956. begin
  957. { Note that the constructor Create_Regset is being called as a regular
  958. method - it is not instantiating a new object. This is because it is
  959. the only published means to modify the internal state en-masse. [Kit] }
  960. for i:=low(TRegisterType) to high(TRegisterType) do
  961. UsedRegs[i].Create_Regset(i,Regs[i].GetUsedRegs);
  962. end;
  963. procedure TAOptObj.TransferUsedRegs(var dest: TAllUsedRegs);
  964. var
  965. i : TRegisterType;
  966. begin
  967. { Note that the constructor Create_Regset is being called as a regular
  968. method - it is not instantiating a new object. This is because it is
  969. the only published means to modify the internal state en-masse. [Kit] }
  970. for i:=low(TRegisterType) to high(TRegisterType) do
  971. dest[i].Create_Regset(i, UsedRegs[i].GetUsedRegs);
  972. end;
  973. class procedure TAOptObj.ReleaseUsedRegs(const regs: TAllUsedRegs);
  974. var
  975. i : TRegisterType;
  976. begin
  977. for i:=low(TRegisterType) to high(TRegisterType) do
  978. regs[i].Free;
  979. end;
  980. class Function TAOptObj.RegInUsedRegs(reg : TRegister;regs : TAllUsedRegs) : boolean;
  981. begin
  982. result:=regs[getregtype(reg)].IsUsed(reg);
  983. end;
  984. class procedure TAOptObj.IncludeRegInUsedRegs(reg: TRegister;
  985. var regs: TAllUsedRegs);
  986. begin
  987. include(regs[getregtype(reg)].UsedRegs,getsupreg(Reg));
  988. end;
  989. class procedure TAOptObj.ExcludeRegFromUsedRegs(reg: TRegister;
  990. var regs: TAllUsedRegs);
  991. begin
  992. exclude(regs[getregtype(reg)].UsedRegs,getsupreg(Reg));
  993. end;
  994. class function TAOptObj.GetAllocationString(const regs: TAllUsedRegs): string;
  995. var
  996. i : TRegisterType;
  997. j : TSuperRegister;
  998. begin
  999. Result:='';
  1000. for i:=low(TRegisterType) to high(TRegisterType) do
  1001. for j in regs[i].UsedRegs do
  1002. Result:=Result+std_regname(newreg(i,j,R_SUBWHOLE))+' ';
  1003. end;
  1004. class function TAOptObj.FindLabel(L: TasmLabel; Var hp: Tai): Boolean;
  1005. Var TempP: Tai;
  1006. Begin
  1007. TempP := hp;
  1008. While Assigned(TempP) and
  1009. (TempP.typ In SkipInstr + [ait_label,ait_align]) Do
  1010. If (TempP.typ <> ait_Label) Or
  1011. (Tai_label(TempP).labsym <> L)
  1012. Then GetNextInstruction(TempP, TempP)
  1013. Else
  1014. Begin
  1015. hp := TempP;
  1016. FindLabel := True;
  1017. exit
  1018. End;
  1019. FindLabel := False;
  1020. End;
  1021. Procedure TAOptObj.InsertLLItem(prev, foll, new_one : TLinkedListItem);
  1022. Begin
  1023. If Assigned(prev) Then
  1024. If Assigned(foll) Then
  1025. Begin
  1026. If Assigned(new_one) Then
  1027. Begin
  1028. new_one.previous := prev;
  1029. new_one.next := foll;
  1030. prev.next := new_one;
  1031. foll.previous := new_one;
  1032. { should we update line information? }
  1033. if (not (tai(new_one).typ in SkipLineInfo)) and
  1034. (not (tai(foll).typ in SkipLineInfo)) then
  1035. Tailineinfo(new_one).fileinfo := Tailineinfo(foll).fileinfo
  1036. End
  1037. End
  1038. Else AsmL.Concat(new_one)
  1039. Else If Assigned(Foll) Then AsmL.Insert(new_one)
  1040. End;
  1041. class function TAOptObj.SkipHead(P: Tai): Tai;
  1042. Var OldP: Tai;
  1043. Begin
  1044. Repeat
  1045. OldP := P;
  1046. If (P.typ in SkipInstr) Or
  1047. ((P.typ = ait_marker) And
  1048. (Tai_Marker(P).Kind = mark_AsmBlockEnd)) Then
  1049. GetNextInstruction(P, P)
  1050. Else If ((P.Typ = Ait_Marker) And
  1051. (Tai_Marker(P).Kind = mark_NoPropInfoStart)) Then
  1052. { a marker of the type mark_NoPropInfoStart can't be the first instruction of a }
  1053. { paasmoutput list }
  1054. GetNextInstruction(Tai(P.Previous),P);
  1055. If (P.Typ = Ait_Marker) And
  1056. (Tai_Marker(P).Kind = mark_AsmBlockStart) Then
  1057. Begin
  1058. P := Tai(P.Next);
  1059. While (P.typ <> Ait_Marker) Or
  1060. (Tai_Marker(P).Kind <> mark_AsmBlockEnd) Do
  1061. P := Tai(P.Next)
  1062. End;
  1063. Until P = OldP;
  1064. SkipHead := P;
  1065. End;
  1066. class function TAOptObj.OpsEqual(const o1,o2:toper): Boolean;
  1067. Begin
  1068. if o1.typ=o2.typ then
  1069. Case o1.typ Of
  1070. Top_Reg :
  1071. OpsEqual:=o1.reg=o2.reg;
  1072. Top_Ref :
  1073. OpsEqual:=
  1074. references_equal(o1.ref^, o2.ref^) and
  1075. (o1.ref^.volatility=[]) and
  1076. (o2.ref^.volatility=[]);
  1077. Top_Const :
  1078. OpsEqual:=o1.val=o2.val;
  1079. Top_None :
  1080. OpsEqual := True
  1081. else OpsEqual := False
  1082. End
  1083. else
  1084. OpsEqual := False;
  1085. End;
  1086. class function TAOptObj.FindRegAlloc(Reg: TRegister; StartPai: Tai): tai_regalloc;
  1087. Begin
  1088. Result:=nil;
  1089. Repeat
  1090. While Assigned(StartPai) And
  1091. ((StartPai.typ in (SkipInstr - [ait_regAlloc])) Or
  1092. {$ifdef cpudelayslot}
  1093. ((startpai.typ=ait_instruction) and (taicpu(startpai).opcode=A_NOP)) or
  1094. {$endif cpudelayslot}
  1095. ((StartPai.typ = ait_label) and
  1096. Not(Tai_Label(StartPai).labsym.Is_Used))) Do
  1097. StartPai := Tai(StartPai.Next);
  1098. If Assigned(StartPai) And
  1099. (StartPai.typ = ait_regAlloc) Then
  1100. Begin
  1101. if (tai_regalloc(StartPai).ratype=ra_alloc) and
  1102. (getregtype(tai_regalloc(StartPai).Reg) = getregtype(Reg)) and
  1103. (getsupreg(tai_regalloc(StartPai).Reg) = getsupreg(Reg)) then
  1104. begin
  1105. Result:=tai_regalloc(StartPai);
  1106. exit;
  1107. end;
  1108. StartPai := Tai(StartPai.Next);
  1109. End
  1110. else
  1111. exit;
  1112. Until false;
  1113. End;
  1114. class function TAOptObj.FindRegAllocBackward(Reg: TRegister; StartPai: Tai): tai_regalloc;
  1115. Begin
  1116. Result:=nil;
  1117. Repeat
  1118. While Assigned(StartPai) And
  1119. ((StartPai.typ in (SkipInstr - [ait_regAlloc])) Or
  1120. ((StartPai.typ = ait_label) and
  1121. Not(Tai_Label(StartPai).labsym.Is_Used))) Do
  1122. StartPai := Tai(StartPai.Previous);
  1123. If Assigned(StartPai) And
  1124. (StartPai.typ = ait_regAlloc) Then
  1125. Begin
  1126. if (tai_regalloc(StartPai).ratype=ra_alloc) and
  1127. SuperRegistersEqual(tai_regalloc(StartPai).Reg,Reg) then
  1128. begin
  1129. Result:=tai_regalloc(StartPai);
  1130. exit;
  1131. end;
  1132. StartPai := Tai(StartPai.Previous);
  1133. End
  1134. else
  1135. exit;
  1136. Until false;
  1137. End;
  1138. class function TAOptObj.FindRegDeAlloc(Reg: TRegister; StartPai: Tai): tai_regalloc;
  1139. Begin
  1140. Result:=nil;
  1141. Repeat
  1142. While Assigned(StartPai) And
  1143. ((StartPai.typ in (SkipInstr - [ait_regAlloc])) Or
  1144. ((StartPai.typ = ait_label) and
  1145. Not(Tai_Label(StartPai).labsym.Is_Used))) Do
  1146. StartPai := Tai(StartPai.Next);
  1147. If Assigned(StartPai) And
  1148. (StartPai.typ = ait_regAlloc) Then
  1149. Begin
  1150. if (tai_regalloc(StartPai).ratype=ra_dealloc) and
  1151. (getregtype(tai_regalloc(StartPai).Reg) = getregtype(Reg)) and
  1152. (getsupreg(tai_regalloc(StartPai).Reg) = getsupreg(Reg)) then
  1153. begin
  1154. Result:=tai_regalloc(StartPai);
  1155. exit;
  1156. end;
  1157. StartPai := Tai(StartPai.Next);
  1158. End
  1159. else
  1160. exit;
  1161. Until false;
  1162. End;
  1163. { allocates register reg between (and including) instructions p1 and p2
  1164. the type of p1 and p2 must not be in SkipInstr }
  1165. procedure TAOptObj.AllocRegBetween(reg: tregister; p1, p2: tai; var initialusedregs: TAllUsedRegs);
  1166. var
  1167. hp, start: tai;
  1168. removedsomething,
  1169. firstRemovedWasAlloc,
  1170. lastRemovedWasDealloc: boolean;
  1171. begin
  1172. {$ifdef EXTDEBUG}
  1173. { if assigned(p1.optinfo) and
  1174. (ptaiprop(p1.optinfo)^.usedregs <> initialusedregs) then
  1175. internalerror(2004101010); }
  1176. {$endif EXTDEBUG}
  1177. start := p1;
  1178. if (reg = NR_STACK_POINTER_REG) or
  1179. (reg = current_procinfo.framepointer) or
  1180. not(assigned(p1)) then
  1181. { this happens with registers which are loaded implicitely, outside the }
  1182. { current block (e.g. esi with self) }
  1183. exit;
  1184. { make sure we allocate it for this instruction }
  1185. getnextinstruction(p2,p2);
  1186. lastRemovedWasDealloc := false;
  1187. removedSomething := false;
  1188. firstRemovedWasAlloc := false;
  1189. {$ifdef allocregdebug}
  1190. hp := tai_comment.Create(strpnew('allocating '+std_regname(newreg(R_INTREGISTER,supreg,R_SUBWHOLE))+
  1191. ' from here...'));
  1192. insertllitem(asml,p1.previous,p1,hp);
  1193. hp := tai_comment.Create(strpnew('allocated '+std_regname(newreg(R_INTREGISTER,supreg,R_SUBWHOLE))+
  1194. ' till here...'));
  1195. insertllitem(asml,p2,p2.next,hp);
  1196. {$endif allocregdebug}
  1197. { do it the safe way: always allocate the full super register,
  1198. as we do no register re-allocation in the peephole optimizer,
  1199. this does not hurt
  1200. }
  1201. case getregtype(reg) of
  1202. R_MMREGISTER:
  1203. reg:=newreg(R_MMREGISTER,getsupreg(reg),R_SUBMMWHOLE);
  1204. R_INTREGISTER:
  1205. reg:=newreg(R_INTREGISTER,getsupreg(reg),R_SUBWHOLE);
  1206. R_FPUREGISTER:
  1207. reg:=newreg(R_FPUREGISTER,getsupreg(reg),R_SUBWHOLE);
  1208. R_ADDRESSREGISTER:
  1209. reg:=newreg(R_ADDRESSREGISTER,getsupreg(reg),R_SUBWHOLE);
  1210. else
  1211. Internalerror(2018030701);
  1212. end;
  1213. if not(RegInUsedRegs(reg,initialusedregs)) then
  1214. begin
  1215. hp := tai_regalloc.alloc(reg,nil);
  1216. insertllItem(p1.previous,p1,hp);
  1217. IncludeRegInUsedRegs(reg,initialusedregs);
  1218. end;
  1219. while assigned(p1) and
  1220. (p1 <> p2) do
  1221. begin
  1222. if assigned(p1.optinfo) then
  1223. internalerror(2014022301); // IncludeRegInUsedRegs(reg,ptaiprop(p1.optinfo)^.usedregs);
  1224. p1 := tai(p1.next);
  1225. repeat
  1226. while assigned(p1) and
  1227. (p1.typ in (SkipInstr-[ait_regalloc])) Do
  1228. p1 := tai(p1.next);
  1229. { remove all allocation/deallocation info about the register in between }
  1230. if assigned(p1) and
  1231. (p1.typ = ait_regalloc) then
  1232. begin
  1233. { same super register, different sub register? }
  1234. if SuperRegistersEqual(reg,tai_regalloc(p1).reg) and (tai_regalloc(p1).reg<>reg) then
  1235. begin
  1236. if (getsubreg(tai_regalloc(p1).reg)>getsubreg(reg)) or (getsubreg(reg)=R_SUBH) then
  1237. internalerror(2016101501);
  1238. tai_regalloc(p1).reg:=reg;
  1239. end;
  1240. if tai_regalloc(p1).reg=reg then
  1241. begin
  1242. if not removedSomething then
  1243. begin
  1244. firstRemovedWasAlloc := tai_regalloc(p1).ratype=ra_alloc;
  1245. removedSomething := true;
  1246. end;
  1247. lastRemovedWasDealloc := (tai_regalloc(p1).ratype=ra_dealloc);
  1248. hp := tai(p1.Next);
  1249. asml.Remove(p1);
  1250. p1.free;
  1251. p1 := hp;
  1252. end
  1253. else
  1254. p1 := tai(p1.next);
  1255. end;
  1256. until not(assigned(p1)) or
  1257. not(p1.typ in SkipInstr);
  1258. end;
  1259. if assigned(p1) then
  1260. begin
  1261. if firstRemovedWasAlloc then
  1262. begin
  1263. hp := tai_regalloc.Alloc(reg,nil);
  1264. insertLLItem(start.previous,start,hp);
  1265. end;
  1266. if lastRemovedWasDealloc then
  1267. begin
  1268. hp := tai_regalloc.DeAlloc(reg,nil);
  1269. insertLLItem(p1.previous,p1,hp);
  1270. end;
  1271. end;
  1272. end;
  1273. function TAOptObj.RegUsedAfterInstruction(reg: Tregister; p: tai;var AllUsedRegs: TAllUsedRegs): Boolean;
  1274. begin
  1275. AllUsedRegs[getregtype(reg)].Update(tai(p.Next),true);
  1276. RegUsedAfterInstruction :=
  1277. AllUsedRegs[getregtype(reg)].IsUsed(reg) and
  1278. not(regLoadedWithNewValue(reg,p)) and
  1279. (
  1280. not(GetNextInstruction(p,p)) or
  1281. InstructionLoadsFromReg(reg,p) or
  1282. not(regLoadedWithNewValue(reg,p))
  1283. );
  1284. end;
  1285. function TAOptObj.RegEndOfLife(reg : TRegister;p : taicpu) : boolean;
  1286. begin
  1287. Result:=assigned(FindRegDealloc(reg,tai(p.Next))) or
  1288. RegLoadedWithNewValue(reg,p);
  1289. end;
  1290. function TAOptObj.RemoveCurrentP(var p : tai) : boolean;
  1291. var
  1292. hp1 : tai;
  1293. begin
  1294. result:=GetNextInstruction(p,hp1);
  1295. { p will be removed, update used register as we continue
  1296. with the next instruction after p }
  1297. UpdateUsedRegs(tai(p.Next));
  1298. AsmL.Remove(p);
  1299. p.Free;
  1300. p:=hp1;
  1301. end;
  1302. function FindLiveLabel(hp: tai; var l: tasmlabel): Boolean;
  1303. var
  1304. next: tai;
  1305. begin
  1306. FindLiveLabel := false;
  1307. while True do
  1308. begin
  1309. while assigned(hp.next) and
  1310. (tai(hp.next).typ in (SkipInstr+[ait_align])) Do
  1311. hp := tai(hp.next);
  1312. next := tai(hp.next);
  1313. if assigned(next) and
  1314. (tai(next).typ = ait_label) then
  1315. begin
  1316. l := tai_label(next).labsym;
  1317. if not l.is_used then
  1318. begin
  1319. { Unsafe label }
  1320. hp := next;
  1321. Continue;
  1322. end;
  1323. FindLiveLabel := true;
  1324. end;
  1325. Exit;
  1326. end;
  1327. end;
  1328. {$push}
  1329. {$r-}
  1330. function TAOptObj.getlabelwithsym(sym: tasmlabel): tai;
  1331. begin
  1332. if (int64(sym.labelnr) >= int64(labelinfo^.lowlabel)) and
  1333. (int64(sym.labelnr) <= int64(labelinfo^.highlabel)) then { range check, a jump can go past an assembler block! }
  1334. getlabelwithsym := labelinfo^.labeltable^[sym.labelnr-labelinfo^.lowlabel].paiobj
  1335. else
  1336. getlabelwithsym := nil;
  1337. end;
  1338. {$pop}
  1339. { Returns True if hp is an unconditional jump to a label }
  1340. function IsJumpToLabelUncond(hp: taicpu): boolean;
  1341. begin
  1342. {$if defined(avr)}
  1343. result:=(hp.opcode in aopt_uncondjmp) and
  1344. {$else avr}
  1345. result:=(hp.opcode=aopt_uncondjmp) and
  1346. {$endif avr}
  1347. {$if defined(arm) or defined(aarch64)}
  1348. (hp.condition=c_None) and
  1349. {$endif arm or aarch64}
  1350. (hp.ops>0) and
  1351. {$if defined(riscv32) or defined(riscv64)}
  1352. (hp.oper[0]^.reg=NR_X0) and
  1353. {$endif riscv}
  1354. (JumpTargetOp(hp)^.typ = top_ref) and
  1355. (JumpTargetOp(hp)^.ref^.symbol is TAsmLabel);
  1356. end;
  1357. { Returns True if hp is any jump to a label }
  1358. function IsJumpToLabel(hp: taicpu): boolean;
  1359. begin
  1360. result:=hp.is_jmp and
  1361. (hp.ops>0) and
  1362. (JumpTargetOp(hp)^.typ = top_ref) and
  1363. (JumpTargetOp(hp)^.ref^.symbol is TAsmLabel);
  1364. end;
  1365. procedure TAOptObj.RemoveDelaySlot(hp1:tai);
  1366. var
  1367. hp2: tai;
  1368. begin
  1369. hp2:=tai(hp1.next);
  1370. while assigned(hp2) and (hp2.typ in SkipInstr) do
  1371. hp2:=tai(hp2.next);
  1372. if assigned(hp2) and (hp2.typ=ait_instruction) and
  1373. (taicpu(hp2).opcode=A_NOP) then
  1374. begin
  1375. asml.remove(hp2);
  1376. hp2.free;
  1377. end;
  1378. { Anything except A_NOP must be left in place: these instructions
  1379. execute before branch, so code stays correct if branch is removed. }
  1380. end;
  1381. { Output debug message to console - null function if EXTDEBUG is not defined }
  1382. class procedure TAOptObj.DebugWrite(Message: string); inline;
  1383. begin
  1384. {$ifdef DEBUG_JUMP}
  1385. WriteLn(Message);
  1386. {$else DEBUG_JUMP}
  1387. { Do nothing }
  1388. {$endif DEBUG_JUMP}
  1389. end;
  1390. { Converts a conditional jump into an unconditional jump. Only call this
  1391. procedure on an instruction that you already know is a conditional jump }
  1392. procedure TAOptObj.MakeUnconditional(p: taicpu);
  1393. begin
  1394. { TODO: If anyone can improve this particular optimisation to work on
  1395. AVR, please do (it's currently not called at all). [Kit] }
  1396. {$if not defined(avr)}
  1397. {$if defined(powerpc) or defined(powerpc64)}
  1398. p.condition.cond := C_None;
  1399. p.condition.simple := True;
  1400. {$else powerpc}
  1401. p.condition := C_None;
  1402. {$endif powerpc}
  1403. p.opcode := aopt_uncondjmp;
  1404. {$ifdef RISCV}
  1405. p.loadoper(1, p.oper[p.ops-1]^);
  1406. p.loadreg(0, NR_X0);
  1407. p.ops:=2;
  1408. {$endif}
  1409. {$endif not avr}
  1410. end;
  1411. { Removes all instructions between an unconditional jump and the next label.
  1412. Returns True if a jump in between was removed (as it may open up new
  1413. optimisations if the label appeared earlier in the stream) }
  1414. function TAOptObj.RemoveDeadCodeAfterJump(p: tai): Boolean;
  1415. const
  1416. {$ifdef JVM}
  1417. TaiFence = SkipInstr + [ait_const, ait_realconst, ait_typedconst, ait_label, ait_jcatch];
  1418. {$else JVM}
  1419. { Stop if it reaches SEH directive information in the form of
  1420. consts, which may occur if RemoveDeadCodeAfterJump is called on
  1421. the final RET instruction on x86, for example }
  1422. TaiFence = SkipInstr + [ait_const, ait_realconst, ait_typedconst, ait_label];
  1423. {$endif JVM}
  1424. var
  1425. hp1, hp2: tai;
  1426. begin
  1427. { the following code removes all code between a jmp and the next label,
  1428. because it can never be executed
  1429. }
  1430. Result := False;
  1431. while GetNextInstruction(p, hp1) and
  1432. (hp1 <> BlockEnd) and
  1433. not (hp1.typ in TaiFence) do
  1434. begin
  1435. if (hp1.typ = ait_instruction) and
  1436. taicpu(hp1).is_jmp and
  1437. (JumpTargetOp(taicpu(hp1))^.typ = top_ref) and
  1438. (JumpTargetOp(taicpu(hp1))^.ref^.symbol is TAsmLabel) then
  1439. begin
  1440. { If the destination label appears earlier, it may permit
  1441. further optimisations, so signal this in the Result }
  1442. Result := True;
  1443. TAsmLabel(JumpTargetOp(taicpu(hp1))^.ref^.symbol).decrefs;
  1444. end;
  1445. { don't kill start/end of assembler block,
  1446. no-line-info-start/end etc }
  1447. if (hp1.typ<>ait_marker) and
  1448. ((hp1.typ<>ait_cfi) or
  1449. (tai_cfi_base(hp1).cfityp<>cfi_endproc)) then
  1450. begin
  1451. {$ifdef cpudelayslot}
  1452. if (hp1.typ=ait_instruction) and (taicpu(hp1).is_jmp) then
  1453. RemoveDelaySlot(hp1);
  1454. {$endif cpudelayslot}
  1455. if (hp1.typ = ait_align) then
  1456. begin
  1457. { Only remove the align if a label doesn't immediately follow }
  1458. if GetNextInstruction(hp1, hp2) and (hp2.typ = ait_label) then
  1459. { The label is unskippable }
  1460. Exit;
  1461. end;
  1462. asml.remove(hp1);
  1463. hp1.free;
  1464. end
  1465. else
  1466. p:=hp1;
  1467. end;
  1468. end;
  1469. { If hp is a label, strip it if its reference count is zero. Repeat until
  1470. a non-label is found, or a label with a non-zero reference count.
  1471. True is returned if something was stripped }
  1472. function TAOptObj.StripDeadLabels(hp: tai; var NextValid: tai): Boolean;
  1473. var
  1474. tmp, tmpNext: tai;
  1475. hp1: tai;
  1476. CurrentAlign: tai;
  1477. begin
  1478. CurrentAlign := nil;
  1479. Result := False;
  1480. hp1 := hp;
  1481. NextValid := hp;
  1482. { Stop if hp is an instruction, for example }
  1483. while (hp1 <> BlockEnd) and (hp1.typ in [ait_label,ait_align]) do
  1484. begin
  1485. prefetch(pointer(hp1.Next)^);
  1486. case hp1.typ of
  1487. ait_label:
  1488. begin
  1489. with tai_label(hp1).labsym do
  1490. if is_used or (bind <> AB_LOCAL) or (labeltype <> alt_jump) then
  1491. begin
  1492. { Valid label }
  1493. if Result then
  1494. NextValid := hp1;
  1495. DebugWrite('JUMP DEBUG: Last label in cluster:' + tostr(labelnr));
  1496. Exit;
  1497. end;
  1498. DebugWrite('JUMP DEBUG: Removed label ' + tostr(TAsmLabel(tai_label(hp1).labsym).labelnr));
  1499. { Set tmp to the next valid entry }
  1500. tmp := tai(hp1.Next);
  1501. { Remove label }
  1502. AsmL.Remove(hp1);
  1503. hp1.Free;
  1504. hp1 := tmp;
  1505. Result := True;
  1506. Continue;
  1507. end;
  1508. { Also remove the align if it comes before an unused label }
  1509. ait_align:
  1510. begin
  1511. tmp := tai(hp1.Next);
  1512. if tmp = BlockEnd then
  1513. { End of block }
  1514. Exit;
  1515. repeat
  1516. case tmp.typ of
  1517. ait_align: { Merge the aligns if permissible }
  1518. begin
  1519. { Check the maxbytes field though, since this may result in the
  1520. alignment being ignored }
  1521. if ((tai_align_abstract(hp1).maxbytes = 0) and (tai_align_abstract(tmp).maxbytes = 0)) or
  1522. { If a maxbytes field is present, only merge if the aligns have the same granularity }
  1523. ((tai_align_abstract(hp1).aligntype = tai_align_abstract(tmp).aligntype)) then
  1524. begin
  1525. with tai_align_abstract(hp1) do
  1526. begin
  1527. aligntype := max(aligntype, tai_align_abstract(tmp).aligntype);
  1528. maxbytes := max(maxbytes, tai_align_abstract(tmp).maxbytes);
  1529. fillsize := max(fillsize, tai_align_abstract(tmp).fillsize);
  1530. use_op := use_op or tai_align_abstract(tmp).use_op;
  1531. if use_op and (tai_align_abstract(tmp).fillop <> 0) then
  1532. fillop := tai_align_abstract(tmp).fillop;
  1533. end;
  1534. tmpNext := tai(tmp.Next);
  1535. AsmL.Remove(tmp);
  1536. tmp.Free;
  1537. Result := True;
  1538. tmp := tmpNext;
  1539. end
  1540. else
  1541. tmp := tai(tmp.Next);
  1542. Continue;
  1543. end;
  1544. ait_label:
  1545. begin
  1546. { Signal that we can possibly delete this align entry }
  1547. CurrentAlign := hp1;
  1548. repeat
  1549. with tai_label(tmp).labsym do
  1550. if is_used or (bind <> AB_LOCAL) or (labeltype <> alt_jump) then
  1551. begin
  1552. { Valid label }
  1553. if Result then
  1554. NextValid := tmp;
  1555. DebugWrite('JUMP DEBUG: Last label in cluster:' + tostr(labelnr));
  1556. Exit;
  1557. end;
  1558. DebugWrite('JUMP DEBUG: Removed label ' + tostr(TAsmLabel(tai_label(tmp).labsym).labelnr));
  1559. { Remove label }
  1560. tmpNext := tai(tmp.Next);
  1561. AsmL.Remove(tmp);
  1562. tmp.Free;
  1563. Result := True;
  1564. tmp := tmpNext;
  1565. { Loop here for a minor performance gain }
  1566. until (tmp = BlockEnd) or (tmp.typ <> ait_label);
  1567. { Re-evaluate the align and see what follows }
  1568. Continue;
  1569. end
  1570. else
  1571. begin
  1572. { Set hp1 to the instruction after the align, because the
  1573. align might get deleted later and hence set NextValid
  1574. to a dangling pointer. [Kit] }
  1575. hp1 := tmp;
  1576. Break;
  1577. end;
  1578. end;
  1579. until (tmp = BlockEnd);
  1580. { Break out of the outer loop if the above Break is called }
  1581. if (hp1 = tmp) then
  1582. Break;
  1583. end
  1584. else
  1585. Break;
  1586. end;
  1587. hp1 := tai(hp1.Next);
  1588. end;
  1589. { hp1 will be the next valid entry }
  1590. NextValid := hp1;
  1591. { Remove the alignment field (but only if the next valid entry is not a live label) }
  1592. while Assigned(CurrentAlign) and (CurrentAlign.typ = ait_align) do
  1593. begin
  1594. DebugWrite('JUMP DEBUG: Alignment field removed');
  1595. tmp := tai(CurrentAlign.next);
  1596. AsmL.Remove(CurrentAlign);
  1597. CurrentAlign.Free;
  1598. CurrentAlign := tmp;
  1599. end;
  1600. end;
  1601. { Strips a label and any aligns that appear before it (if hp points to
  1602. them rather than the label). Only call this procedure on a label that
  1603. you already know is no longer referenced }
  1604. procedure TAOptObj.StripLabelFast(hp: tai); {$ifdef USEINLINE}inline;{$endif USEINLINE}
  1605. var
  1606. tmp: tai;
  1607. begin
  1608. repeat
  1609. case hp.typ of
  1610. ait_align:
  1611. begin
  1612. tmp := tai(hp.Next);
  1613. asml.Remove(hp);
  1614. hp.Free;
  1615. hp := tmp;
  1616. { Control flow will now return to 'repeat' }
  1617. end;
  1618. ait_label:
  1619. begin
  1620. {$ifdef EXTDEBUG}
  1621. { When not in debug mode, deleting a live label will cause an
  1622. access violation later on. [Kit] }
  1623. if tai_label(hp).labsym.getrefs <> 0 then
  1624. InternalError(2019110802);
  1625. {$endif EXTDEBUG}
  1626. asml.Remove(hp);
  1627. hp.Free;
  1628. Exit;
  1629. end;
  1630. else
  1631. begin
  1632. { Might be a comment or temporary allocation entry }
  1633. if not (hp.typ in SkipInstr) then
  1634. InternalError(2019110801);
  1635. hp := tai(hp.Next);
  1636. end;
  1637. end;
  1638. until False;
  1639. end;
  1640. { If a group of labels are clustered, change the jump to point to the last one
  1641. that is still referenced }
  1642. function TAOptObj.CollapseLabelCluster(jump: tai; var lbltai: tai): TAsmLabel;
  1643. var
  1644. LastLabel: TAsmLabel;
  1645. hp2: tai;
  1646. begin
  1647. Result := tai_label(lbltai).labsym;
  1648. LastLabel := Result;
  1649. hp2 := tai(lbltai.next);
  1650. while (hp2 <> BlockEnd) and (hp2.typ in SkipInstr + [ait_align, ait_label]) do
  1651. begin
  1652. if (hp2.typ = ait_label) and
  1653. (tai_label(hp2).labsym.is_used) and
  1654. (tai_label(hp2).labsym.labeltype = alt_jump) then
  1655. LastLabel := tai_label(hp2).labsym;
  1656. hp2 := tai(hp2.next);
  1657. end;
  1658. if (Result <> LastLabel) then
  1659. begin
  1660. Result.decrefs;
  1661. JumpTargetOp(taicpu(jump))^.ref^.symbol := LastLabel;
  1662. LastLabel.increfs;
  1663. Result := LastLabel;
  1664. lbltai := hp2;
  1665. end;
  1666. end;
  1667. {$ifndef JVM}
  1668. function TAOptObj.OptimizeConditionalJump(CJLabel: TAsmLabel; var p: tai; hp1: tai; var stoploop: Boolean): Boolean;
  1669. var
  1670. hp2: tai;
  1671. NCJLabel: TAsmLabel;
  1672. begin
  1673. Result := False;
  1674. while (hp1 <> BlockEnd) do
  1675. begin
  1676. StripDeadLabels(hp1, hp1);
  1677. if (hp1 <> BlockEnd) and
  1678. (tai(hp1).typ=ait_instruction) and
  1679. IsJumpToLabel(taicpu(hp1)) then
  1680. begin
  1681. NCJLabel := TAsmLabel(JumpTargetOp(taicpu(hp1))^.ref^.symbol);
  1682. if IsJumpToLabelUncond(taicpu(hp1)) then
  1683. begin
  1684. { Do it now to get it out of the way and to aid optimisations
  1685. later on in this method }
  1686. if RemoveDeadCodeAfterJump(taicpu(hp1)) then
  1687. stoploop := False;
  1688. hp2 := getlabelwithsym(NCJLabel);
  1689. if Assigned(hp2) then
  1690. { Collapse the cluster now to aid optimisation and potentially
  1691. cut down on the number of iterations required }
  1692. NCJLabel := CollapseLabelCluster(hp1, hp2);
  1693. { GetNextInstruction could be factored out, but hp2 might be
  1694. different after "RemoveDeadCodeAfterJump" }
  1695. GetNextInstruction(hp1, hp2);
  1696. { Check for:
  1697. jmp<cond> @Lbl
  1698. jmp @Lbl
  1699. }
  1700. if (CJLabel = NCJLabel) then
  1701. begin
  1702. DebugMsg(SPeepholeOptimization+'Short-circuited conditional jump',p);
  1703. { Both jumps go to the same label }
  1704. CJLabel.decrefs;
  1705. {$ifdef cpudelayslot}
  1706. RemoveDelaySlot(p);
  1707. {$endif cpudelayslot}
  1708. UpdateUsedRegs(tai(p.Next));
  1709. AsmL.Remove(p);
  1710. p.Free;
  1711. p := hp1;
  1712. Result := True;
  1713. Exit;
  1714. end;
  1715. if FindLabel(CJLabel, hp2) then
  1716. begin
  1717. { change the following jumps:
  1718. jmp<cond> CJLabel jmp<inv_cond> NCJLabel
  1719. jmp NCJLabel >>> <code>
  1720. CJLabel: NCJLabel:
  1721. <code>
  1722. NCJLabel:
  1723. }
  1724. {$if defined(arm) or defined(aarch64)}
  1725. if (taicpu(p).condition<>C_None)
  1726. {$if defined(aarch64)}
  1727. { can't have conditional branches to
  1728. global labels on AArch64, because the
  1729. offset may become too big }
  1730. and (NCJLabel.bind=AB_LOCAL)
  1731. {$endif aarch64}
  1732. then
  1733. begin
  1734. {$endif arm or aarch64}
  1735. DebugMsg(SPeepholeOptimization+'Conditional jump inversion',p);
  1736. taicpu(p).condition:=inverse_cond(taicpu(p).condition);
  1737. CJLabel.decrefs;
  1738. JumpTargetOp(taicpu(p))^.ref^.symbol := NCJLabel;
  1739. { when freeing hp1, the reference count
  1740. isn't decreased, so don't increase }
  1741. {$ifdef cpudelayslot}
  1742. RemoveDelaySlot(hp1);
  1743. {$endif cpudelayslot}
  1744. asml.remove(hp1);
  1745. hp1.free;
  1746. stoploop := False;
  1747. if not CJLabel.is_used then
  1748. begin
  1749. CJLabel := NCJLabel;
  1750. StripDeadLabels(tai(p.Next), hp1);
  1751. if (hp1 = BlockEnd) then
  1752. Exit;
  1753. { Attempt another iteration in case more jumps follow }
  1754. if (hp1.typ in SkipInstr) then
  1755. GetNextInstruction(hp1, hp1);
  1756. Continue;
  1757. end;
  1758. {$if defined(arm) or defined(aarch64)}
  1759. end;
  1760. {$endif arm or aarch64}
  1761. end
  1762. else if CollapseZeroDistJump(hp1, NCJLabel) then
  1763. begin
  1764. if (hp1 = BlockEnd) then
  1765. Exit;
  1766. { Attempt another iteration in case more jumps follow }
  1767. if (hp1.typ in SkipInstr) then
  1768. GetNextInstruction(hp1, hp1);
  1769. Continue;
  1770. end;
  1771. end
  1772. else
  1773. begin
  1774. { Check for:
  1775. jmp<cond1> @Lbl1
  1776. jmp<cond2> @Lbl2
  1777. Remove 2nd jump if conditions are equal or cond2 is fully covered by cond1
  1778. }
  1779. if condition_in(taicpu(hp1).condition, taicpu(p).condition) then
  1780. begin
  1781. DebugMsg(SPeepholeOptimization+'Dominated conditional jump',p);
  1782. NCJLabel.decrefs;
  1783. GetNextInstruction(hp1, hp2);
  1784. AsmL.Remove(hp1);
  1785. hp1.Free;
  1786. hp1 := hp2;
  1787. { Flag another pass in case @Lbl2 appeared earlier in the procedure and is now a dead label }
  1788. stoploop := False;
  1789. { Attempt another iteration in case more jumps follow }
  1790. Continue;
  1791. end;
  1792. { Check for:
  1793. jmp<cond1> @Lbl1
  1794. jmp<cond2> @Lbl2
  1795. And inv(cond2) is a subset of cond1 (e.g. je followed by jne, or jae followed by jbe) )
  1796. }
  1797. if condition_in(inverse_cond(taicpu(hp1).condition), taicpu(p).condition) then
  1798. begin
  1799. GetNextInstruction(hp1, hp2);
  1800. { If @lbl1 immediately follows jmp<cond2>, we can remove
  1801. the first jump completely }
  1802. if FindLabel(CJLabel, hp2) then
  1803. begin
  1804. DebugMsg(SPeepholeOptimization+'jmp<cond> before jmp<inv_cond> - removed first jump',p);
  1805. CJLabel.decrefs;
  1806. {$ifdef cpudelayslot}
  1807. RemoveDelaySlot(p);
  1808. {$endif cpudelayslot}
  1809. UpdateUsedRegs(tai(p.Next));
  1810. AsmL.Remove(p);
  1811. p.Free;
  1812. p := hp1;
  1813. Result := True;
  1814. Exit;
  1815. {$if not defined(avr)}
  1816. end
  1817. else
  1818. { NOTE: There is currently no watertight, cross-platform way to create
  1819. an unconditional jump without access to the cg object. If anyone can
  1820. improve this particular optimisation to work on AVR,
  1821. please do. [Kit] }
  1822. begin
  1823. { Since cond1 is a subset of inv(cond2), jmp<cond2> will always branch if
  1824. jmp<cond1> does not, so change jmp<cond2> to an unconditional jump. }
  1825. DebugMsg(SPeepholeOptimization+'jmp<cond> before jmp<inv_cond> - made second jump unconditional',p);
  1826. MakeUnconditional(taicpu(hp1));
  1827. { NOTE: Changing the jump to unconditional won't open up new opportunities
  1828. for GetFinalDestination on earlier jumps because there's no live label
  1829. between the two jump instructions, so setting 'stoploop' to False only
  1830. wastes time. [Kit] }
  1831. { See if more optimisations are possible }
  1832. Continue;
  1833. {$endif}
  1834. end;
  1835. end;
  1836. end;
  1837. end;
  1838. if GetFinalDestination(taicpu(p),0) then
  1839. stoploop := False;
  1840. Exit;
  1841. end;
  1842. end;
  1843. {$endif JVM}
  1844. function TAOptObj.CollapseZeroDistJump(var p: tai; ThisLabel: TAsmLabel): Boolean;
  1845. var
  1846. tmp, hp1: tai;
  1847. begin
  1848. Result := False;
  1849. hp1 := tai(p.Next);
  1850. tmp := hp1; { Might be an align before the label, so keep a note of it }
  1851. if (hp1 = BlockEnd) then
  1852. Exit;
  1853. { remove jumps to labels coming right after them }
  1854. if FindLabel(ThisLabel, hp1) and
  1855. { Cannot remove the first instruction }
  1856. (p<>StartPoint) then
  1857. begin
  1858. ThisLabel.decrefs;
  1859. {$ifdef cpudelayslot}
  1860. RemoveDelaySlot(p);
  1861. {$endif cpudelayslot}
  1862. asml.remove(p);
  1863. p.free;
  1864. StripDeadLabels(tmp, p);
  1865. if p.typ <> ait_instruction then
  1866. GetNextInstruction(UpdateUsedRegsAndOptimize(p), p);
  1867. Result := True;
  1868. end;
  1869. end;
  1870. function TAOptObj.CanDoJumpOpts: Boolean;
  1871. begin
  1872. { Always allow by default }
  1873. Result := True;
  1874. end;
  1875. function TAOptObj.DoJumpOptimizations(var p: tai; var stoploop: Boolean): Boolean;
  1876. var
  1877. hp1, hp2: tai;
  1878. ThisLabel: TAsmLabel;
  1879. ThisPassResult: Boolean;
  1880. begin
  1881. Result := False;
  1882. if (p.typ <> ait_instruction) or not IsJumpToLabel(taicpu(p)) then
  1883. Exit;
  1884. repeat
  1885. ThisPassResult := False;
  1886. if GetNextInstruction(p, hp1) and (hp1 <> BlockEnd) then
  1887. begin
  1888. SkipEntryExitMarker(hp1,hp1);
  1889. if (hp1 = BlockEnd) then
  1890. Exit;
  1891. ThisLabel := TAsmLabel(JumpTargetOp(taicpu(p))^.ref^.symbol);
  1892. hp2 := getlabelwithsym(ThisLabel);
  1893. { getlabelwithsym returning nil occurs if a label is in a
  1894. different block (e.g. on the other side of an asm...end pair). }
  1895. if Assigned(hp2) then
  1896. begin
  1897. { If there are multiple labels in a row, change the destination to the last one
  1898. in order to aid optimisation later }
  1899. ThisLabel := CollapseLabelCluster(p, hp2);
  1900. if CollapseZeroDistJump(p, ThisLabel) then
  1901. begin
  1902. stoploop := False;
  1903. Result := True;
  1904. Exit;
  1905. end;
  1906. if IsJumpToLabelUncond(taicpu(p)) then
  1907. begin
  1908. { Remove unreachable code between the jump and the next label }
  1909. ThisPassResult := RemoveDeadCodeAfterJump(taicpu(p));
  1910. if GetFinalDestination(taicpu(p), 0) or ThisPassResult then
  1911. { Might have caused some earlier labels to become dead }
  1912. stoploop := False;
  1913. end
  1914. {$ifndef JVM}
  1915. else if (taicpu(p).opcode = aopt_condjmp) then
  1916. ThisPassResult := OptimizeConditionalJump(ThisLabel, p, hp1, stoploop)
  1917. {$endif JVM}
  1918. ;
  1919. end;
  1920. end;
  1921. Result := Result or ThisPassResult;
  1922. until not (ThisPassResult and (p.typ = ait_instruction) and IsJumpToLabel(taicpu(p)));
  1923. end;
  1924. function TAOptObj.GetFinalDestination(hp: taicpu; level: longint): boolean;
  1925. {traces sucessive jumps to their final destination and sets it, e.g.
  1926. je l1 je l3 <code> <code>
  1927. l1: becomes l1:
  1928. je l2 je l3
  1929. <code> <code>
  1930. l2: l2:
  1931. jmp l3 jmp l3
  1932. the level parameter denotes how deep we have already followed the jump,
  1933. to avoid endless loops with constructs such as "l5: ; jmp l5" }
  1934. var p1: tai;
  1935. p2: tai;
  1936. {$if not defined(MIPS) and not defined(riscv64) and not defined(riscv32) and not defined(JVM)}
  1937. p3: tai;
  1938. {$endif}
  1939. ThisLabel, l: tasmlabel;
  1940. begin
  1941. GetFinalDestination := false;
  1942. if level > 20 then
  1943. exit;
  1944. ThisLabel := TAsmLabel(JumpTargetOp(hp)^.ref^.symbol);
  1945. p1 := getlabelwithsym(ThisLabel);
  1946. if assigned(p1) then
  1947. begin
  1948. SkipLabels(p1,p1);
  1949. if (p1.typ = ait_instruction) and
  1950. (taicpu(p1).is_jmp) then
  1951. begin
  1952. p2 := tai(p1.Next);
  1953. if p2 = BlockEnd then
  1954. Exit;
  1955. { Collapse any zero distance jumps we stumble across }
  1956. while (p1<>StartPoint) and CollapseZeroDistJump(p1, TAsmLabel(JumpTargetOp(taicpu(p1))^.ref^.symbol)) do
  1957. begin
  1958. { Note: Cannot remove the first instruction }
  1959. if (p1.typ = ait_label) then
  1960. SkipLabels(p1, p1);
  1961. if not Assigned(p1) then
  1962. { No more valid commands }
  1963. Exit;
  1964. { Check to see that we are actually still at a jump }
  1965. if not ((tai(p1).typ = ait_instruction) and (taicpu(p1).is_jmp)) then
  1966. begin
  1967. { Required to ensure recursion works properly, but to also
  1968. return false if a jump isn't modified. [Kit] }
  1969. if level > 0 then GetFinalDestination := True;
  1970. Exit;
  1971. end;
  1972. p2 := tai(p1.Next);
  1973. if p2 = BlockEnd then
  1974. Exit;
  1975. end;
  1976. {$if not defined(MIPS) and not defined(riscv64) and not defined(riscv32) and not defined(JVM)}
  1977. p3 := p2;
  1978. {$endif not MIPS and not RV64 and not RV32 and not JVM}
  1979. if { the next instruction after the label where the jump hp arrives}
  1980. { is unconditional or of the same type as hp, so continue }
  1981. IsJumpToLabelUncond(taicpu(p1))
  1982. { TODO: For anyone with experience with MIPS or RISC-V, please add support for tracing
  1983. conditional jumps. [Kit] }
  1984. {$if not defined(MIPS) and not defined(riscv64) and not defined(riscv32) and not defined(JVM)}
  1985. { for MIPS, it isn't enough to check the condition; first operands must be same, too. }
  1986. or
  1987. condition_in(hp.condition, taicpu(p1).condition) or
  1988. { the next instruction after the label where the jump hp arrives
  1989. is the opposite of hp (so this one is never taken), but after
  1990. that one there is a branch that will be taken, so perform a
  1991. little hack: set p1 equal to this instruction }
  1992. (condition_in(hp.condition, inverse_cond(taicpu(p1).condition)) and
  1993. SkipLabels(p3,p2) and
  1994. (p2.typ = ait_instruction) and
  1995. (taicpu(p2).is_jmp) and
  1996. (IsJumpToLabelUncond(taicpu(p2)) or
  1997. (condition_in(hp.condition, taicpu(p2).condition))
  1998. ) and
  1999. SetAndTest(p2,p1)
  2000. )
  2001. {$endif not MIPS and not RV64 and not RV32 and not JVM}
  2002. then
  2003. begin
  2004. { quick check for loops of the form "l5: ; jmp l5" }
  2005. if (TAsmLabel(JumpTargetOp(taicpu(p1))^.ref^.symbol).labelnr = ThisLabel.labelnr) then
  2006. exit;
  2007. if not GetFinalDestination(taicpu(p1),succ(level)) then
  2008. exit;
  2009. { NOTE: Do not move this before the "l5: ; jmp l5" check,
  2010. because GetFinalDestination may change the destination
  2011. label of p1. [Kit] }
  2012. l := tasmlabel(JumpTargetOp(taicpu(p1))^.ref^.symbol);
  2013. {$if defined(aarch64)}
  2014. { can't have conditional branches to
  2015. global labels on AArch64, because the
  2016. offset may become too big }
  2017. if not(taicpu(hp).condition in [C_None,C_AL,C_NV]) and
  2018. (l.bind<>AB_LOCAL) then
  2019. exit;
  2020. {$endif aarch64}
  2021. ThisLabel.decrefs;
  2022. JumpTargetOp(hp)^.ref^.symbol:=l;
  2023. l.increfs;
  2024. GetFinalDestination := True;
  2025. Exit;
  2026. end
  2027. {$if not defined(MIPS) and not defined(riscv64) and not defined(riscv32) and not defined(JVM)}
  2028. else
  2029. if condition_in(inverse_cond(hp.condition), taicpu(p1).condition) then
  2030. begin
  2031. if not FindLiveLabel(p1,l) then
  2032. begin
  2033. {$ifdef finaldestdebug}
  2034. insertllitem(asml,p1,p1.next,tai_comment.Create(
  2035. strpnew('previous label inserted'))));
  2036. {$endif finaldestdebug}
  2037. current_asmdata.getjumplabel(l);
  2038. insertllitem(p1,p1.next,tai_label.Create(l));
  2039. ThisLabel.decrefs;
  2040. JumpTargetOp(hp)^.ref^.symbol := l;
  2041. l.increfs;
  2042. GetFinalDestination := True;
  2043. { this won't work, since the new label isn't in the labeltable }
  2044. { so it will fail the rangecheck. Labeltable should become a }
  2045. { hashtable to support this: }
  2046. { GetFinalDestination(asml, hp); }
  2047. end
  2048. else
  2049. begin
  2050. {$ifdef finaldestdebug}
  2051. insertllitem(asml,p1,p1.next,tai_comment.Create(
  2052. strpnew('next label reused'))));
  2053. {$endif finaldestdebug}
  2054. l.increfs;
  2055. ThisLabel.decrefs;
  2056. JumpTargetOp(hp)^.ref^.symbol := l;
  2057. if not GetFinalDestination(hp,succ(level)) then
  2058. exit;
  2059. end;
  2060. GetFinalDestination := True;
  2061. Exit;
  2062. end;
  2063. {$endif not MIPS and not RV64 and not RV32 and not JVM}
  2064. end;
  2065. end;
  2066. { Required to ensure recursion works properly, but to also
  2067. return false if a jump isn't modified. [Kit] }
  2068. if level > 0 then GetFinalDestination := True;
  2069. end;
  2070. procedure TAOptObj.PrePeepHoleOpts;
  2071. var
  2072. p: tai;
  2073. begin
  2074. p := BlockStart;
  2075. ClearUsedRegs;
  2076. while (p <> BlockEnd) Do
  2077. begin
  2078. prefetch(pointer(p.Next)^);
  2079. if PrePeepHoleOptsCpu(p) then
  2080. continue;
  2081. if assigned(p) then
  2082. begin
  2083. p:=tai(p.next);
  2084. UpdateUsedRegs(p);
  2085. end;
  2086. end;
  2087. end;
  2088. procedure TAOptObj.PeepHoleOptPass1;
  2089. var
  2090. p : tai;
  2091. stoploop, FirstInstruction, JumpOptsAvailable: boolean;
  2092. begin
  2093. JumpOptsAvailable := CanDoJumpOpts();
  2094. StartPoint := BlockStart;
  2095. repeat
  2096. stoploop:=true;
  2097. p := StartPoint;
  2098. FirstInstruction := True;
  2099. ClearUsedRegs;
  2100. while Assigned(p) and (p <> BlockEnd) Do
  2101. begin
  2102. prefetch(pointer(p.Next)^);
  2103. { I'am not sure why this is done, UsedRegs should reflect the register usage before the instruction
  2104. If an instruction needs the information of this, it can easily create a TempUsedRegs (FK)
  2105. UpdateUsedRegs(tai(p.next));
  2106. }
  2107. {$ifdef DEBUG_OPTALLOC}
  2108. if p.Typ=ait_instruction then
  2109. InsertLLItem(tai(p.Previous),p,tai_comment.create(strpnew(GetAllocationString(UsedRegs))));
  2110. {$endif DEBUG_OPTALLOC}
  2111. { Handle jump optimizations first }
  2112. if JumpOptsAvailable and DoJumpOptimizations(p, stoploop) then
  2113. begin
  2114. if FirstInstruction then
  2115. { Update StartPoint, since the old p was removed;
  2116. don't set FirstInstruction to False though, as
  2117. the new p might get removed too. }
  2118. StartPoint := p;
  2119. if (p.typ = ait_instruction) and IsJumpToLabel(taicpu(p)) then
  2120. Continue;
  2121. end;
  2122. if PeepHoleOptPass1Cpu(p) then
  2123. begin
  2124. stoploop:=false;
  2125. UpdateUsedRegs(p);
  2126. if FirstInstruction then
  2127. { Update StartPoint, since the old p was modified;
  2128. don't set FirstInstruction to False though, as
  2129. the new p might get modified too. }
  2130. StartPoint := p;
  2131. continue;
  2132. end;
  2133. FirstInstruction := False;
  2134. if assigned(p) then
  2135. p := tai(UpdateUsedRegsAndOptimize(p).Next);
  2136. end;
  2137. until stoploop or not(cs_opt_level3 in current_settings.optimizerswitches);
  2138. end;
  2139. procedure TAOptObj.PeepHoleOptPass2;
  2140. var
  2141. p: tai;
  2142. begin
  2143. p := BlockStart;
  2144. ClearUsedRegs;
  2145. while (p <> BlockEnd) Do
  2146. begin
  2147. prefetch(pointer(p.Next)^);
  2148. if PeepHoleOptPass2Cpu(p) then
  2149. continue;
  2150. if assigned(p) then
  2151. p := tai(UpdateUsedRegsAndOptimize(p).Next);
  2152. end;
  2153. end;
  2154. procedure TAOptObj.PostPeepHoleOpts;
  2155. var
  2156. p: tai;
  2157. begin
  2158. p := BlockStart;
  2159. ClearUsedRegs;
  2160. while (p <> BlockEnd) Do
  2161. begin
  2162. prefetch(pointer(p.Next)^);
  2163. if PostPeepHoleOptsCpu(p) then
  2164. continue;
  2165. if assigned(p) then
  2166. begin
  2167. p:=tai(p.next);
  2168. UpdateUsedRegs(p);
  2169. end;
  2170. end;
  2171. end;
  2172. function TAOptObj.PrePeepHoleOptsCpu(var p : tai) : boolean;
  2173. begin
  2174. result := false;
  2175. end;
  2176. function TAOptObj.PeepHoleOptPass1Cpu(var p: tai): boolean;
  2177. begin
  2178. result := false;
  2179. end;
  2180. function TAOptObj.PeepHoleOptPass2Cpu(var p : tai) : boolean;
  2181. begin
  2182. result := false;
  2183. end;
  2184. function TAOptObj.PostPeepHoleOptsCpu(var p: tai): boolean;
  2185. begin
  2186. result := false;
  2187. end;
  2188. procedure TAOptObj.Debug_InsertInstrRegisterDependencyInfo;
  2189. var
  2190. p: tai;
  2191. ri: tregisterindex;
  2192. reg: TRegister;
  2193. commentstr: AnsiString;
  2194. registers_found: Boolean;
  2195. begin
  2196. p:=tai(AsmL.First);
  2197. while (p<>AsmL.Last) Do
  2198. begin
  2199. if p.typ=ait_instruction then
  2200. begin
  2201. {$ifdef x86}
  2202. taicpu(p).SetOperandOrder(op_att);
  2203. {$endif x86}
  2204. commentstr:='Instruction reads';
  2205. registers_found:=false;
  2206. for ri in tregisterindex do
  2207. begin
  2208. reg:=regnumber_table[ri];
  2209. if (reg<>NR_NO) and InstructionLoadsFromReg(reg,p) then
  2210. begin
  2211. commentstr:=commentstr+' '+std_regname(reg);
  2212. registers_found:=true;
  2213. end;
  2214. end;
  2215. if not registers_found then
  2216. commentstr:=commentstr+' no registers';
  2217. commentstr:=commentstr+' and writes new values in';
  2218. registers_found:=false;
  2219. for ri in tregisterindex do
  2220. begin
  2221. reg:=regnumber_table[ri];
  2222. if (reg<>NR_NO) and RegLoadedWithNewValue(reg,p) then
  2223. begin
  2224. commentstr:=commentstr+' '+std_regname(reg);
  2225. registers_found:=true;
  2226. end;
  2227. end;
  2228. if not registers_found then
  2229. commentstr:=commentstr+' no registers';
  2230. AsmL.InsertAfter(tai_comment.Create(strpnew(commentstr)),p);
  2231. end;
  2232. p:=tai(p.next);
  2233. end;
  2234. end;
  2235. End.