aoptobj.pas 107 KB

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