daopt386.pas 93 KB

12345678910111213141516171819202122232425262728293031323334353637383940414243444546474849505152535455565758596061626364656667686970717273747576777879808182838485868788899091929394959697989910010110210310410510610710810911011111211311411511611711811912012112212312412512612712812913013113213313413513613713813914014114214314414514614714814915015115215315415515615715815916016116216316416516616716816917017117217317417517617717817918018118218318418518618718818919019119219319419519619719819920020120220320420520620720820921021121221321421521621721821922022122222322422522622722822923023123223323423523623723823924024124224324424524624724824925025125225325425525625725825926026126226326426526626726826927027127227327427527627727827928028128228328428528628728828929029129229329429529629729829930030130230330430530630730830931031131231331431531631731831932032132232332432532632732832933033133233333433533633733833934034134234334434534634734834935035135235335435535635735835936036136236336436536636736836937037137237337437537637737837938038138238338438538638738838939039139239339439539639739839940040140240340440540640740840941041141241341441541641741841942042142242342442542642742842943043143243343443543643743843944044144244344444544644744844945045145245345445545645745845946046146246346446546646746846947047147247347447547647747847948048148248348448548648748848949049149249349449549649749849950050150250350450550650750850951051151251351451551651751851952052152252352452552652752852953053153253353453553653753853954054154254354454554654754854955055155255355455555655755855956056156256356456556656756856957057157257357457557657757857958058158258358458558658758858959059159259359459559659759859960060160260360460560660760860961061161261361461561661761861962062162262362462562662762862963063163263363463563663763863964064164264364464564664764864965065165265365465565665765865966066166266366466566666766866967067167267367467567667767867968068168268368468568668768868969069169269369469569669769869970070170270370470570670770870971071171271371471571671771871972072172272372472572672772872973073173273373473573673773873974074174274374474574674774874975075175275375475575675775875976076176276376476576676776876977077177277377477577677777877978078178278378478578678778878979079179279379479579679779879980080180280380480580680780880981081181281381481581681781881982082182282382482582682782882983083183283383483583683783883984084184284384484584684784884985085185285385485585685785885986086186286386486586686786886987087187287387487587687787887988088188288388488588688788888989089189289389489589689789889990090190290390490590690790890991091191291391491591691791891992092192292392492592692792892993093193293393493593693793893994094194294394494594694794894995095195295395495595695795895996096196296396496596696796896997097197297397497597697797897998098198298398498598698798898999099199299399499599699799899910001001100210031004100510061007100810091010101110121013101410151016101710181019102010211022102310241025102610271028102910301031103210331034103510361037103810391040104110421043104410451046104710481049105010511052105310541055105610571058105910601061106210631064106510661067106810691070107110721073107410751076107710781079108010811082108310841085108610871088108910901091109210931094109510961097109810991100110111021103110411051106110711081109111011111112111311141115111611171118111911201121112211231124112511261127112811291130113111321133113411351136113711381139114011411142114311441145114611471148114911501151115211531154115511561157115811591160116111621163116411651166116711681169117011711172117311741175117611771178117911801181118211831184118511861187118811891190119111921193119411951196119711981199120012011202120312041205120612071208120912101211121212131214121512161217121812191220122112221223122412251226122712281229123012311232123312341235123612371238123912401241124212431244124512461247124812491250125112521253125412551256125712581259126012611262126312641265126612671268126912701271127212731274127512761277127812791280128112821283128412851286128712881289129012911292129312941295129612971298129913001301130213031304130513061307130813091310131113121313131413151316131713181319132013211322132313241325132613271328132913301331133213331334133513361337133813391340134113421343134413451346134713481349135013511352135313541355135613571358135913601361136213631364136513661367136813691370137113721373137413751376137713781379138013811382138313841385138613871388138913901391139213931394139513961397139813991400140114021403140414051406140714081409141014111412141314141415141614171418141914201421142214231424142514261427142814291430143114321433143414351436143714381439144014411442144314441445144614471448144914501451145214531454145514561457145814591460146114621463146414651466146714681469147014711472147314741475147614771478147914801481148214831484148514861487148814891490149114921493149414951496149714981499150015011502150315041505150615071508150915101511151215131514151515161517151815191520152115221523152415251526152715281529153015311532153315341535153615371538153915401541154215431544154515461547154815491550155115521553155415551556155715581559156015611562156315641565156615671568156915701571157215731574157515761577157815791580158115821583158415851586158715881589159015911592159315941595159615971598159916001601160216031604160516061607160816091610161116121613161416151616161716181619162016211622162316241625162616271628162916301631163216331634163516361637163816391640164116421643164416451646164716481649165016511652165316541655165616571658165916601661166216631664166516661667166816691670167116721673167416751676167716781679168016811682168316841685168616871688168916901691169216931694169516961697169816991700170117021703170417051706170717081709171017111712171317141715171617171718171917201721172217231724172517261727172817291730173117321733173417351736173717381739174017411742174317441745174617471748174917501751175217531754175517561757175817591760176117621763176417651766176717681769177017711772177317741775177617771778177917801781178217831784178517861787178817891790179117921793179417951796179717981799180018011802180318041805180618071808180918101811181218131814181518161817181818191820182118221823182418251826182718281829183018311832183318341835183618371838183918401841184218431844184518461847184818491850185118521853185418551856185718581859186018611862186318641865186618671868186918701871187218731874187518761877187818791880188118821883188418851886188718881889189018911892189318941895189618971898189919001901190219031904190519061907190819091910191119121913191419151916191719181919192019211922192319241925192619271928192919301931193219331934193519361937193819391940194119421943194419451946194719481949195019511952195319541955195619571958195919601961196219631964196519661967196819691970197119721973197419751976197719781979198019811982198319841985198619871988198919901991199219931994199519961997199819992000200120022003200420052006200720082009201020112012201320142015201620172018201920202021202220232024202520262027202820292030203120322033203420352036203720382039204020412042204320442045204620472048204920502051205220532054205520562057205820592060206120622063206420652066206720682069207020712072207320742075207620772078207920802081208220832084208520862087208820892090209120922093209420952096209720982099210021012102210321042105210621072108210921102111211221132114211521162117211821192120212121222123212421252126212721282129213021312132213321342135213621372138213921402141214221432144214521462147214821492150215121522153215421552156215721582159216021612162216321642165216621672168216921702171217221732174217521762177217821792180218121822183218421852186218721882189219021912192219321942195219621972198219922002201220222032204220522062207220822092210221122122213221422152216221722182219222022212222222322242225222622272228222922302231223222332234223522362237223822392240224122422243224422452246224722482249225022512252225322542255225622572258225922602261226222632264226522662267226822692270227122722273227422752276227722782279228022812282228322842285228622872288228922902291229222932294229522962297229822992300230123022303230423052306230723082309231023112312231323142315231623172318231923202321232223232324232523262327232823292330233123322333233423352336233723382339234023412342234323442345234623472348234923502351235223532354235523562357235823592360236123622363236423652366236723682369237023712372237323742375237623772378237923802381238223832384238523862387238823892390239123922393239423952396239723982399240024012402240324042405240624072408240924102411241224132414241524162417241824192420242124222423242424252426242724282429243024312432243324342435243624372438243924402441244224432444244524462447244824492450245124522453245424552456245724582459246024612462246324642465246624672468246924702471247224732474247524762477247824792480248124822483248424852486248724882489249024912492249324942495249624972498249925002501250225032504250525062507250825092510251125122513251425152516251725182519252025212522252325242525252625272528252925302531253225332534253525362537253825392540254125422543254425452546254725482549255025512552255325542555255625572558255925602561256225632564256525662567256825692570257125722573257425752576257725782579258025812582258325842585258625872588258925902591259225932594259525962597259825992600260126022603260426052606260726082609261026112612261326142615261626172618261926202621262226232624262526262627262826292630263126322633263426352636263726382639264026412642264326442645264626472648264926502651265226532654265526562657265826592660266126622663266426652666266726682669267026712672267326742675267626772678
  1. {
  2. $Id$
  3. Copyright (c) 1998-2000 by Jonas Maebe, member of the Freepascal
  4. development team
  5. This unit contains the data flow analyzer and several helper procedures
  6. and functions.
  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 DAOpt386;
  21. {$i defines.inc}
  22. Interface
  23. Uses
  24. GlobType,
  25. CClasses,Aasm,
  26. cpubase,cpuasm;
  27. {******************************* Constants *******************************}
  28. Const
  29. {Possible register content types}
  30. con_Unknown = 0;
  31. con_ref = 1;
  32. con_const = 2;
  33. { The contents aren't usable anymore for CSE, but they may still be }
  34. { usefull for detecting whether the result of a load is actually used }
  35. con_invalid = 3;
  36. { the reverse of the above (in case a (conditional) jump is encountered): }
  37. { CSE is still possible, but the original instruction can't be removed }
  38. con_noRemoveRef = 4;
  39. { same, but for constants }
  40. con_noRemoveConst = 5;
  41. {********************************* Types *********************************}
  42. type
  43. TRegArray = Array[R_EAX..R_BL] of TRegister;
  44. TRegSet = Set of R_EAX..R_BL;
  45. TRegInfo = Record
  46. NewRegsEncountered, OldRegsEncountered: TRegSet;
  47. RegsLoadedForRef: TRegSet;
  48. regsStillUsedAfterSeq: TRegSet;
  49. lastReload: array[R_EAX..R_EDI] of Tai;
  50. New2OldReg: TRegArray;
  51. End;
  52. {possible actions on an operand: read, write or modify (= read & write)}
  53. TOpAction = (OpAct_Read, OpAct_Write, OpAct_Modify, OpAct_Unknown);
  54. {the possible states of a flag}
  55. TFlagContents = (F_Unknown, F_NotSet, F_Set);
  56. TContent = Packed Record
  57. {start and end of block instructions that defines the
  58. content of this register.}
  59. StartMod: Tai;
  60. {how many instructions starting with StarMod does the block consist of}
  61. NrOfMods: Byte;
  62. {the type of the content of the register: unknown, memory, constant}
  63. Typ: Byte;
  64. case byte of
  65. {starts at 0, gets increased everytime the register is written to}
  66. 1: (WState: Byte;
  67. {starts at 0, gets increased everytime the register is read from}
  68. RState: Byte);
  69. { to compare both states in one operation }
  70. 2: (state: word);
  71. End;
  72. {Contents of the integer registers}
  73. TRegContent = Array[R_EAX..R_EDI] Of TContent;
  74. {contents of the FPU registers}
  75. TRegFPUContent = Array[R_ST..R_ST7] Of TContent;
  76. {$ifdef tempOpts}
  77. { linked list which allows searching/deleting based on value, no extra frills}
  78. PSearchLinkedListItem = ^TSearchLinkedListItem;
  79. TSearchLinkedListItem = object(TLinkedList_Item)
  80. constructor init;
  81. function equals(p: PSearchLinkedListItem): boolean; virtual;
  82. end;
  83. PSearchDoubleIntItem = ^TSearchDoubleInttem;
  84. TSearchDoubleIntItem = object(TLinkedList_Item)
  85. constructor init(_int1,_int2: longint);
  86. function equals(p: PSearchLinkedListItem): boolean; virtual;
  87. private
  88. int1, int2: longint;
  89. end;
  90. PSearchLinkedList = ^TSearchLinkedList;
  91. TSearchLinkedList = object(TLinkedList)
  92. function searchByValue(p: PSearchLinkedListItem): boolean;
  93. procedure removeByValue(p: PSearchLinkedListItem);
  94. end;
  95. {$endif tempOpts}
  96. {information record with the contents of every register. Every Tai object
  97. gets one of these assigned: a pointer to it is stored in the OptInfo field}
  98. TTaiProp = Record
  99. Regs: TRegContent;
  100. { FPURegs: TRegFPUContent;} {currently not yet used}
  101. { allocated Registers }
  102. UsedRegs: TRegSet;
  103. { status of the direction flag }
  104. DirFlag: TFlagContents;
  105. {$ifdef tempOpts}
  106. { currently used temps }
  107. tempAllocs: PSearchLinkedList;
  108. {$endif tempOpts}
  109. { can this instruction be removed? }
  110. CanBeRemoved: Boolean;
  111. { are the resultflags set by this instruction used? }
  112. FlagsUsed: Boolean;
  113. End;
  114. PTaiProp = ^TTaiProp;
  115. TTaiPropBlock = Array[1..250000] Of TTaiProp;
  116. PTaiPropBlock = ^TTaiPropBlock;
  117. TInstrSinceLastMod = Array[R_EAX..R_EDI] Of Byte;
  118. TLabelTableItem = Record
  119. TaiObj: Tai;
  120. {$IfDef JumpAnal}
  121. InstrNr: Longint;
  122. RefsFound: Word;
  123. JmpsProcessed: Word
  124. {$EndIf JumpAnal}
  125. End;
  126. TLabelTable = Array[0..2500000] Of TLabelTableItem;
  127. PLabelTable = ^TLabelTable;
  128. {*********************** Procedures and Functions ************************}
  129. Procedure InsertLLItem(AsmL: TAAsmOutput; prev, foll, new_one: TLinkedListItem);
  130. Function Reg32(Reg: TRegister): TRegister;
  131. Function RefsEquivalent(Const R1, R2: TReference; Var RegInfo: TRegInfo; OpAct: TOpAction): Boolean;
  132. Function RefsEqual(Const R1, R2: TReference): Boolean;
  133. Function IsGP32Reg(Reg: TRegister): Boolean;
  134. Function RegInRef(Reg: TRegister; Const Ref: TReference): Boolean;
  135. function RegReadByInstruction(reg: TRegister; hp: Tai): boolean;
  136. function RegModifiedByInstruction(Reg: TRegister; p1: Tai): Boolean;
  137. function RegInInstruction(Reg: TRegister; p1: Tai): Boolean;
  138. function RegInOp(Reg: TRegister; const o:toper): Boolean;
  139. function instrWritesFlags(p: Tai): boolean;
  140. function instrReadsFlags(p: Tai): boolean;
  141. function writeToMemDestroysContents(regWritten: tregister; const ref: treference;
  142. reg: tregister; const c: tcontent): boolean;
  143. function writeToRegDestroysContents(destReg: tregister; reg: tregister;
  144. const c: tcontent): boolean;
  145. function writeDestroysContents(const op: toper; reg: tregister;
  146. const c: tcontent): boolean;
  147. Function GetNextInstruction(Current: Tai; Var Next: Tai): Boolean;
  148. Function GetLastInstruction(Current: Tai; Var Last: Tai): Boolean;
  149. Procedure SkipHead(var P: Tai);
  150. function labelCanBeSkipped(p: Tai_label): boolean;
  151. Procedure RemoveLastDeallocForFuncRes(asmL: TAAsmOutput; p: Tai);
  152. Function regLoadedWithNewValue(reg: tregister; canDependOnPrevValue: boolean;
  153. hp: Tai): boolean;
  154. Procedure UpdateUsedRegs(Var UsedRegs: TRegSet; p: Tai);
  155. Procedure AllocRegBetween(AsmL: TAAsmOutput; Reg: TRegister; p1, p2: Tai);
  156. function FindRegDealloc(reg: tregister; p: Tai): boolean;
  157. Function RegsEquivalent(OldReg, NewReg: TRegister; Var RegInfo: TRegInfo; OpAct: TopAction): Boolean;
  158. Function InstructionsEquivalent(p1, p2: Tai; Var RegInfo: TRegInfo): Boolean;
  159. Function OpsEqual(const o1,o2:toper): Boolean;
  160. Function DFAPass1(AsmL: TAAsmOutput; BlockStart: Tai): Tai;
  161. Function DFAPass2(
  162. {$ifdef statedebug}
  163. AsmL: TAAsmOutPut;
  164. {$endif statedebug}
  165. BlockStart, BlockEnd: Tai): Boolean;
  166. Procedure ShutDownDFA;
  167. Function FindLabel(L: tasmlabel; Var hp: Tai): Boolean;
  168. Procedure IncState(Var S: Byte; amount: longint);
  169. {******************************* Variables *******************************}
  170. Var
  171. {the amount of TaiObjects in the current assembler list}
  172. NrOfTaiObjs: Longint;
  173. {Array which holds all TTaiProps}
  174. TaiPropBlock: PTaiPropBlock;
  175. LoLab, HiLab, LabDif: Longint;
  176. LTable: PLabelTable;
  177. {*********************** End of Interface section ************************}
  178. Implementation
  179. Uses
  180. globals, systems, verbose, cgbase, symconst, symsym, tgcpu;
  181. Type
  182. TRefCompare = function(const r1, r2: TReference): Boolean;
  183. Var
  184. {How many instructions are between the current instruction and the last one
  185. that modified the register}
  186. NrOfInstrSinceLastMod: TInstrSinceLastMod;
  187. {$ifdef tempOpts}
  188. constructor TSearchLinkedListItem.init;
  189. begin
  190. end;
  191. function TSearchLinkedListItem.equals(p: PSearchLinkedListItem): boolean;
  192. begin
  193. equals := false;
  194. end;
  195. constructor TSearchDoubleIntItem.init(_int1,_int2: longint);
  196. begin
  197. int1 := _int1;
  198. int2 := _int2;
  199. end;
  200. function TSearchDoubleIntItem.equals(p: PSearchLinkedListItem): boolean;
  201. begin
  202. equals := (TSearchDoubleIntItem(p).int1 = int1) and
  203. (TSearchDoubleIntItem(p).int2 = int2);
  204. end;
  205. function TSearchLinkedList.searchByValue(p: PSearchLinkedListItem): boolean;
  206. var temp: PSearchLinkedListItem;
  207. begin
  208. temp := first;
  209. while (temp <> last.next) and
  210. not(temp.equals(p)) do
  211. temp := temp.next;
  212. searchByValue := temp <> last.next;
  213. end;
  214. procedure TSearchLinkedList.removeByValue(p: PSearchLinkedListItem);
  215. begin
  216. temp := first;
  217. while (temp <> last.next) and
  218. not(temp.equals(p)) do
  219. temp := temp.next;
  220. if temp <> last.next then
  221. begin
  222. remove(temp);
  223. dispose(temp,done);
  224. end;
  225. end;
  226. Procedure updateTempAllocs(Var UsedRegs: TRegSet; p: Tai);
  227. {updates UsedRegs with the RegAlloc Information coming after P}
  228. Begin
  229. Repeat
  230. While Assigned(p) And
  231. ((p.typ in (SkipInstr - [ait_RegAlloc])) or
  232. ((p.typ = ait_label) And
  233. labelCanBeSkipped(Tai_label(current)))) Do
  234. p := Tai(p.next);
  235. While Assigned(p) And
  236. (p.typ=ait_RegAlloc) Do
  237. Begin
  238. if Tairegalloc(p).allocation then
  239. UsedRegs := UsedRegs + [TaiRegAlloc(p).Reg]
  240. else
  241. UsedRegs := UsedRegs - [TaiRegAlloc(p).Reg];
  242. p := Tai(p.next);
  243. End;
  244. Until Not(Assigned(p)) Or
  245. (Not(p.typ in SkipInstr) And
  246. Not((p.typ = ait_label) And
  247. labelCanBeSkipped(Tai_label(current))));
  248. End;
  249. {$endif tempOpts}
  250. {************************ Create the Label table ************************}
  251. Function FindLoHiLabels(Var LowLabel, HighLabel, LabelDif: Longint; BlockStart: Tai): Tai;
  252. {Walks through the TAAsmlist to find the lowest and highest label number}
  253. Var LabelFound: Boolean;
  254. P, lastP: Tai;
  255. Begin
  256. LabelFound := False;
  257. LowLabel := MaxLongint;
  258. HighLabel := 0;
  259. P := BlockStart;
  260. lastP := p;
  261. While Assigned(P) Do
  262. Begin
  263. If (Tai(p).typ = ait_label) Then
  264. If not labelCanBeSkipped(Tai_label(p))
  265. Then
  266. Begin
  267. LabelFound := True;
  268. If (Tai_Label(p).l.labelnr < LowLabel) Then
  269. LowLabel := Tai_Label(p).l.labelnr;
  270. If (Tai_Label(p).l.labelnr > HighLabel) Then
  271. HighLabel := Tai_Label(p).l.labelnr;
  272. End;
  273. lastP := p;
  274. GetNextInstruction(p, p);
  275. End;
  276. if (lastP.typ = ait_marker) and
  277. (Tai_marker(lastp).kind = asmBlockStart) then
  278. FindLoHiLabels := lastP
  279. else FindLoHiLabels := nil;
  280. If LabelFound
  281. Then LabelDif := HighLabel+1-LowLabel
  282. Else LabelDif := 0;
  283. End;
  284. Function FindRegAlloc(Reg: TRegister; StartTai: Tai; alloc: boolean): Boolean;
  285. { Returns true if a ait_alloc object for Reg is found in the block of Tai's }
  286. { starting with StartTai and ending with the next "real" instruction }
  287. Begin
  288. FindRegAlloc := false;
  289. Repeat
  290. While Assigned(StartTai) And
  291. ((StartTai.typ in (SkipInstr - [ait_regAlloc])) Or
  292. ((StartTai.typ = ait_label) and
  293. labelCanBeSkipped(Tai_label(startTai)))) Do
  294. StartTai := Tai(StartTai.Next);
  295. If Assigned(StartTai) and
  296. (StartTai.typ = ait_regAlloc) then
  297. begin
  298. if (TairegAlloc(StartTai).allocation = alloc) and
  299. (TairegAlloc(StartTai).Reg = Reg) then
  300. begin
  301. FindRegAlloc:=true;
  302. break;
  303. end;
  304. StartTai := Tai(StartTai.Next);
  305. end
  306. else
  307. break;
  308. Until false;
  309. End;
  310. Procedure RemoveLastDeallocForFuncRes(asmL: TAAsmOutput; p: Tai);
  311. Procedure DoRemoveLastDeallocForFuncRes(asmL: TAAsmOutput; reg: TRegister);
  312. var
  313. hp2: Tai;
  314. begin
  315. hp2 := p;
  316. repeat
  317. hp2 := Tai(hp2.previous);
  318. if assigned(hp2) and
  319. (hp2.typ = ait_regalloc) and
  320. not(Tairegalloc(hp2).allocation) and
  321. (Tairegalloc(hp2).reg = reg) then
  322. begin
  323. asml.remove(hp2);
  324. hp2.free;
  325. break;
  326. end;
  327. until not(assigned(hp2)) or
  328. regInInstruction(reg,hp2);
  329. end;
  330. begin
  331. case aktprocsym.definition.rettype.def.deftype of
  332. arraydef,recorddef,pointerdef,
  333. stringdef,enumdef,procdef,objectdef,errordef,
  334. filedef,setdef,procvardef,
  335. classrefdef,forwarddef:
  336. DoRemoveLastDeallocForFuncRes(asmL,R_EAX);
  337. orddef:
  338. if aktprocsym.definition.rettype.def.size <> 0 then
  339. begin
  340. DoRemoveLastDeallocForFuncRes(asmL,R_EAX);
  341. { for int64/qword }
  342. if aktprocsym.definition.rettype.def.size = 8 then
  343. DoRemoveLastDeallocForFuncRes(asmL,R_EDX);
  344. end;
  345. end;
  346. end;
  347. procedure getNoDeallocRegs(var regs: TRegSet);
  348. var regCounter: TRegister;
  349. begin
  350. regs := [];
  351. case aktprocsym.definition.rettype.def.deftype of
  352. arraydef,recorddef,pointerdef,
  353. stringdef,enumdef,procdef,objectdef,errordef,
  354. filedef,setdef,procvardef,
  355. classrefdef,forwarddef:
  356. regs := [R_EAX];
  357. orddef:
  358. if aktprocsym.definition.rettype.def.size <> 0 then
  359. begin
  360. regs := [R_EAX];
  361. { for int64/qword }
  362. if aktprocsym.definition.rettype.def.size = 8 then
  363. regs := regs + [R_EDX];
  364. end;
  365. end;
  366. for regCounter := R_EAX to R_EBX do
  367. if not(regCounter in usableregs) then
  368. regs := regs + [regCounter];
  369. end;
  370. Procedure AddRegDeallocFor(asmL: TAAsmOutput; reg: TRegister; p: Tai);
  371. var hp1: Tai;
  372. funcResRegs: TRegset;
  373. funcResReg: boolean;
  374. begin
  375. if not(reg in usableregs) then
  376. exit;
  377. getNoDeallocRegs(funcResRegs);
  378. funcResRegs := funcResRegs - usableregs;
  379. funcResReg := reg in funcResRegs;
  380. hp1 := p;
  381. while not(funcResReg and
  382. (p.typ = ait_instruction) and
  383. (Taicpu(p).opcode = A_JMP) and
  384. (tasmlabel(Taicpu(p).oper[0].sym) = aktexit2label)) and
  385. getLastInstruction(p, p) And
  386. not(regInInstruction(reg, p)) Do
  387. hp1 := p;
  388. { don't insert a dealloc for registers which contain the function result }
  389. { if they are followed by a jump to the exit label (for exit(...)) }
  390. if not(funcResReg) or
  391. not((hp1.typ = ait_instruction) and
  392. (Taicpu(hp1).opcode = A_JMP) and
  393. (tasmlabel(Taicpu(hp1).oper[0].sym) = aktexit2label)) then
  394. begin
  395. p := TaiRegAlloc.deAlloc(reg);
  396. insertLLItem(AsmL, hp1.previous, hp1, p);
  397. end;
  398. end;
  399. Procedure BuildLabelTableAndFixRegAlloc(asmL: TAAsmOutput; Var LabelTable: PLabelTable; LowLabel: Longint;
  400. Var LabelDif: Longint; BlockStart, BlockEnd: Tai);
  401. {Builds a table with the locations of the labels in the TAAsmoutput.
  402. Also fixes some RegDeallocs like "# %eax released; push (%eax)"}
  403. Var p, hp1, hp2, lastP: Tai;
  404. regCounter: TRegister;
  405. UsedRegs, noDeallocRegs: TRegSet;
  406. Begin
  407. UsedRegs := [];
  408. If (LabelDif <> 0) Then
  409. Begin
  410. GetMem(LabelTable, LabelDif*SizeOf(TLabelTableItem));
  411. FillChar(LabelTable^, LabelDif*SizeOf(TLabelTableItem), 0);
  412. End;
  413. p := BlockStart;
  414. lastP := p;
  415. While (P <> BlockEnd) Do
  416. Begin
  417. Case p.typ Of
  418. ait_Label:
  419. If not labelCanBeSkipped(Tai_label(p)) Then
  420. LabelTable^[Tai_Label(p).l.labelnr-LowLabel].TaiObj := p;
  421. ait_regAlloc:
  422. { ESI and EDI are (de)allocated manually, don't mess with them }
  423. if not(TaiRegAlloc(p).Reg in [R_EDI,R_ESI]) then
  424. begin
  425. if TairegAlloc(p).Allocation then
  426. Begin
  427. If Not(TaiRegAlloc(p).Reg in UsedRegs) Then
  428. UsedRegs := UsedRegs + [TaiRegAlloc(p).Reg]
  429. Else
  430. addRegDeallocFor(asmL, TaiRegAlloc(p).reg, p);
  431. End
  432. else
  433. begin
  434. UsedRegs := UsedRegs - [TaiRegAlloc(p).Reg];
  435. hp1 := p;
  436. hp2 := nil;
  437. While Not(FindRegAlloc(TaiRegAlloc(p).Reg, Tai(hp1.Next),true)) And
  438. GetNextInstruction(hp1, hp1) And
  439. RegInInstruction(TaiRegAlloc(p).Reg, hp1) Do
  440. hp2 := hp1;
  441. If hp2 <> nil Then
  442. Begin
  443. hp1 := Tai(p.previous);
  444. AsmL.Remove(p);
  445. InsertLLItem(AsmL, hp2, Tai(hp2.Next), p);
  446. p := hp1;
  447. end;
  448. end;
  449. end;
  450. end;
  451. repeat
  452. lastP := p;
  453. P := Tai(P.Next);
  454. until not(Assigned(p)) or
  455. not(p.typ in (SkipInstr - [ait_regalloc]));
  456. End;
  457. { don't add deallocation for function result variable or for regvars}
  458. getNoDeallocRegs(noDeallocRegs);
  459. usedRegs := usedRegs - noDeallocRegs;
  460. for regCounter := R_EAX to R_EDI do
  461. if regCounter in usedRegs then
  462. addRegDeallocFor(asmL,regCounter,lastP);
  463. End;
  464. {************************ Search the Label table ************************}
  465. Function FindLabel(L: tasmlabel; Var hp: Tai): Boolean;
  466. {searches for the specified label starting from hp as long as the
  467. encountered instructions are labels, to be able to optimize constructs like
  468. jne l2 jmp l2
  469. jmp l3 and l1:
  470. l1: l2:
  471. l2:}
  472. Var TempP: Tai;
  473. Begin
  474. TempP := hp;
  475. While Assigned(TempP) and
  476. (Tempp.typ In SkipInstr + [ait_label,ait_align]) Do
  477. If (Tempp.typ <> ait_Label) Or
  478. (Tai_label(Tempp).l <> L)
  479. Then GetNextInstruction(TempP, TempP)
  480. Else
  481. Begin
  482. hp := TempP;
  483. FindLabel := True;
  484. exit
  485. End;
  486. FindLabel := False;
  487. End;
  488. {************************ Some general functions ************************}
  489. Function TCh2Reg(Ch: TInsChange): TRegister;
  490. {converts a TChange variable to a TRegister}
  491. Begin
  492. If (Ch <= Ch_REDI) Then
  493. TCh2Reg := TRegister(Byte(Ch))
  494. Else
  495. If (Ch <= Ch_WEDI) Then
  496. TCh2Reg := TRegister(Byte(Ch) - Byte(Ch_REDI))
  497. Else
  498. If (Ch <= Ch_RWEDI) Then
  499. TCh2Reg := TRegister(Byte(Ch) - Byte(Ch_WEDI))
  500. Else
  501. If (Ch <= Ch_MEDI) Then
  502. TCh2Reg := TRegister(Byte(Ch) - Byte(Ch_RWEDI))
  503. Else InternalError($db)
  504. End;
  505. Function Reg32(Reg: TRegister): TRegister;
  506. {Returns the 32 bit component of Reg if it exists, otherwise Reg is returned}
  507. Begin
  508. Reg32 := Reg;
  509. If (Reg >= R_AX)
  510. Then
  511. If (Reg <= R_DI)
  512. Then Reg32 := Reg16ToReg32(Reg)
  513. Else
  514. If (Reg <= R_BL)
  515. Then Reg32 := Reg8toReg32(Reg);
  516. End;
  517. { inserts new_one between prev and foll }
  518. Procedure InsertLLItem(AsmL: TAAsmOutput; prev, foll, new_one: TLinkedListItem);
  519. Begin
  520. If Assigned(prev) Then
  521. If Assigned(foll) Then
  522. Begin
  523. If Assigned(new_one) Then
  524. Begin
  525. new_one.previous := prev;
  526. new_one.next := foll;
  527. prev.next := new_one;
  528. foll.previous := new_one;
  529. Tai(new_one).fileinfo := Tai(foll).fileinfo;
  530. End;
  531. End
  532. Else asml.Concat(new_one)
  533. Else If Assigned(Foll) Then asml.Insert(new_one)
  534. End;
  535. {********************* Compare parts of Tai objects *********************}
  536. Function RegsSameSize(Reg1, Reg2: TRegister): Boolean;
  537. {returns true if Reg1 and Reg2 are of the same size (so if they're both
  538. 8bit, 16bit or 32bit)}
  539. Begin
  540. If (Reg1 <= R_EDI)
  541. Then RegsSameSize := (Reg2 <= R_EDI)
  542. Else
  543. If (Reg1 <= R_DI)
  544. Then RegsSameSize := (Reg2 in [R_AX..R_DI])
  545. Else
  546. If (Reg1 <= R_BL)
  547. Then RegsSameSize := (Reg2 in [R_AL..R_BL])
  548. Else RegsSameSize := False
  549. End;
  550. Procedure AddReg2RegInfo(OldReg, NewReg: TRegister; Var RegInfo: TRegInfo);
  551. {updates the ???RegsEncountered and ???2???Reg fields of RegInfo. Assumes that
  552. OldReg and NewReg have the same size (has to be chcked in advance with
  553. RegsSameSize) and that neither equals R_NO}
  554. Begin
  555. With RegInfo Do
  556. Begin
  557. NewRegsEncountered := NewRegsEncountered + [NewReg];
  558. OldRegsEncountered := OldRegsEncountered + [OldReg];
  559. New2OldReg[NewReg] := OldReg;
  560. Case OldReg Of
  561. R_EAX..R_EDI:
  562. Begin
  563. NewRegsEncountered := NewRegsEncountered + [Reg32toReg16(NewReg)];
  564. OldRegsEncountered := OldRegsEncountered + [Reg32toReg16(OldReg)];
  565. New2OldReg[Reg32toReg16(NewReg)] := Reg32toReg16(OldReg);
  566. If (NewReg in [R_EAX..R_EBX]) And
  567. (OldReg in [R_EAX..R_EBX]) Then
  568. Begin
  569. NewRegsEncountered := NewRegsEncountered + [Reg32toReg8(NewReg)];
  570. OldRegsEncountered := OldRegsEncountered + [Reg32toReg8(OldReg)];
  571. New2OldReg[Reg32toReg8(NewReg)] := Reg32toReg8(OldReg);
  572. End;
  573. End;
  574. R_AX..R_DI:
  575. Begin
  576. NewRegsEncountered := NewRegsEncountered + [Reg16toReg32(NewReg)];
  577. OldRegsEncountered := OldRegsEncountered + [Reg16toReg32(OldReg)];
  578. New2OldReg[Reg16toReg32(NewReg)] := Reg16toReg32(OldReg);
  579. If (NewReg in [R_AX..R_BX]) And
  580. (OldReg in [R_AX..R_BX]) Then
  581. Begin
  582. NewRegsEncountered := NewRegsEncountered + [Reg16toReg8(NewReg)];
  583. OldRegsEncountered := OldRegsEncountered + [Reg16toReg8(OldReg)];
  584. New2OldReg[Reg16toReg8(NewReg)] := Reg16toReg8(OldReg);
  585. End;
  586. End;
  587. R_AL..R_BL:
  588. Begin
  589. NewRegsEncountered := NewRegsEncountered + [Reg8toReg32(NewReg)]
  590. + [Reg8toReg16(NewReg)];
  591. OldRegsEncountered := OldRegsEncountered + [Reg8toReg32(OldReg)]
  592. + [Reg8toReg16(OldReg)];
  593. New2OldReg[Reg8toReg32(NewReg)] := Reg8toReg32(OldReg);
  594. End;
  595. End;
  596. End;
  597. End;
  598. Procedure AddOp2RegInfo(const o:Toper; Var RegInfo: TRegInfo);
  599. Begin
  600. Case o.typ Of
  601. Top_Reg:
  602. If (o.reg <> R_NO) Then
  603. AddReg2RegInfo(o.reg, o.reg, RegInfo);
  604. Top_Ref:
  605. Begin
  606. If o.ref^.base <> R_NO Then
  607. AddReg2RegInfo(o.ref^.base, o.ref^.base, RegInfo);
  608. If o.ref^.index <> R_NO Then
  609. AddReg2RegInfo(o.ref^.index, o.ref^.index, RegInfo);
  610. End;
  611. End;
  612. End;
  613. Function RegsEquivalent(OldReg, NewReg: TRegister; Var RegInfo: TRegInfo; OPAct: TOpAction): Boolean;
  614. Begin
  615. If Not((OldReg = R_NO) Or (NewReg = R_NO)) Then
  616. If RegsSameSize(OldReg, NewReg) Then
  617. With RegInfo Do
  618. {here we always check for the 32 bit component, because it is possible that
  619. the 8 bit component has not been set, event though NewReg already has been
  620. processed. This happens if it has been compared with a register that doesn't
  621. have an 8 bit component (such as EDI). In that case the 8 bit component is
  622. still set to R_NO and the comparison in the Else-part will fail}
  623. If (Reg32(OldReg) in OldRegsEncountered) Then
  624. If (Reg32(NewReg) in NewRegsEncountered) Then
  625. RegsEquivalent := (OldReg = New2OldReg[NewReg])
  626. { If we haven't encountered the new register yet, but we have encountered the
  627. old one already, the new one can only be correct if it's being written to
  628. (and consequently the old one is also being written to), otherwise
  629. movl -8(%ebp), %eax and movl -8(%ebp), %eax
  630. movl (%eax), %eax movl (%edx), %edx
  631. are considered equivalent}
  632. Else
  633. If (OpAct = OpAct_Write) Then
  634. Begin
  635. AddReg2RegInfo(OldReg, NewReg, RegInfo);
  636. RegsEquivalent := True
  637. End
  638. Else Regsequivalent := False
  639. Else
  640. If Not(Reg32(NewReg) in NewRegsEncountered) and
  641. ((OpAct = OpAct_Write) or
  642. (newReg = oldReg)) Then
  643. Begin
  644. AddReg2RegInfo(OldReg, NewReg, RegInfo);
  645. RegsEquivalent := True
  646. End
  647. Else RegsEquivalent := False
  648. Else RegsEquivalent := False
  649. Else RegsEquivalent := OldReg = NewReg
  650. End;
  651. Function RefsEquivalent(Const R1, R2: TReference; var RegInfo: TRegInfo; OpAct: TOpAction): Boolean;
  652. Begin
  653. If R1.is_immediate Then
  654. RefsEquivalent := R2.is_immediate and (R1.Offset = R2.Offset)
  655. Else
  656. RefsEquivalent := (R1.Offset+R1.OffsetFixup = R2.Offset+R2.OffsetFixup) And
  657. RegsEquivalent(R1.Base, R2.Base, RegInfo, OpAct) And
  658. RegsEquivalent(R1.Index, R2.Index, RegInfo, OpAct) And
  659. (R1.Segment = R2.Segment) And (R1.ScaleFactor = R2.ScaleFactor) And
  660. (R1.Symbol = R2.Symbol);
  661. End;
  662. Function RefsEqual(Const R1, R2: TReference): Boolean;
  663. Begin
  664. If R1.is_immediate Then
  665. RefsEqual := R2.is_immediate and (R1.Offset = R2.Offset)
  666. Else
  667. RefsEqual := (R1.Offset+R1.OffsetFixup = R2.Offset+R2.OffsetFixup) And
  668. (R1.Segment = R2.Segment) And (R1.Base = R2.Base) And
  669. (R1.Index = R2.Index) And (R1.ScaleFactor = R2.ScaleFactor) And
  670. (R1.Symbol=R2.Symbol);
  671. End;
  672. Function IsGP32Reg(Reg: TRegister): Boolean;
  673. {Checks if the register is a 32 bit general purpose register}
  674. Begin
  675. If (Reg >= R_EAX) and (Reg <= R_EBX)
  676. Then IsGP32Reg := True
  677. Else IsGP32reg := False
  678. End;
  679. Function RegInRef(Reg: TRegister; Const Ref: TReference): Boolean;
  680. Begin {checks whether Ref contains a reference to Reg}
  681. Reg := Reg32(Reg);
  682. RegInRef := (Ref.Base = Reg) Or (Ref.Index = Reg)
  683. End;
  684. function RegReadByInstruction(reg: TRegister; hp: Tai): boolean;
  685. var p: Taicpu;
  686. opCount: byte;
  687. begin
  688. RegReadByInstruction := false;
  689. reg := reg32(reg);
  690. p := Taicpu(hp);
  691. if hp.typ <> ait_instruction then
  692. exit;
  693. case p.opcode of
  694. A_IMUL:
  695. case p.ops of
  696. 1: regReadByInstruction := (reg = R_EAX) or reginOp(reg,p.oper[0]);
  697. 2,3:
  698. regReadByInstruction := regInOp(reg,p.oper[0]) or
  699. regInOp(reg,p.oper[1]);
  700. end;
  701. A_IDIV,A_DIV,A_MUL:
  702. begin
  703. regReadByInstruction :=
  704. regInOp(reg,p.oper[0]) or (reg = R_EAX);
  705. end;
  706. else
  707. begin
  708. for opCount := 0 to 2 do
  709. if (p.oper[opCount].typ = top_ref) and
  710. RegInRef(reg,p.oper[opCount].ref^) then
  711. begin
  712. RegReadByInstruction := true;
  713. exit
  714. end;
  715. for opCount := 1 to MaxCh do
  716. case InsProp[p.opcode].Ch[opCount] of
  717. Ch_REAX..CH_REDI,CH_RWEAX..Ch_MEDI:
  718. if reg = TCh2Reg(InsProp[p.opcode].Ch[opCount]) then
  719. begin
  720. RegReadByInstruction := true;
  721. exit
  722. end;
  723. Ch_RWOp1,Ch_ROp1,Ch_MOp1:
  724. if (p.oper[0].typ = top_reg) and
  725. (reg32(p.oper[0].reg) = reg) then
  726. begin
  727. RegReadByInstruction := true;
  728. exit
  729. end;
  730. Ch_RWOp2,Ch_ROp2,Ch_MOp2:
  731. if (p.oper[1].typ = top_reg) and
  732. (reg32(p.oper[1].reg) = reg) then
  733. begin
  734. RegReadByInstruction := true;
  735. exit
  736. end;
  737. Ch_RWOp3,Ch_ROp3,Ch_MOp3:
  738. if (p.oper[2].typ = top_reg) and
  739. (reg32(p.oper[2].reg) = reg) then
  740. begin
  741. RegReadByInstruction := true;
  742. exit
  743. end;
  744. end;
  745. end;
  746. end;
  747. end;
  748. function regInInstruction(Reg: TRegister; p1: Tai): Boolean;
  749. { Checks if Reg is used by the instruction p1 }
  750. { Difference with "regReadBysinstruction() or regModifiedByInstruction()": }
  751. { this one ignores CH_ALL opcodes, while regModifiedByInstruction doesn't }
  752. var p: Taicpu;
  753. opCount: byte;
  754. begin
  755. reg := reg32(reg);
  756. regInInstruction := false;
  757. p := Taicpu(p1);
  758. if p1.typ <> ait_instruction then
  759. exit;
  760. case p.opcode of
  761. A_IMUL:
  762. case p.ops of
  763. 1: regInInstruction := (reg = R_EAX) or reginOp(reg,p.oper[0]);
  764. 2,3:
  765. regInInstruction := regInOp(reg,p.oper[0]) or
  766. regInOp(reg,p.oper[1]) or regInOp(reg,p.oper[2]);
  767. end;
  768. A_IDIV,A_DIV,A_MUL:
  769. regInInstruction :=
  770. regInOp(reg,p.oper[0]) or
  771. (reg = R_EAX) or (reg = R_EDX)
  772. else
  773. begin
  774. for opCount := 1 to MaxCh do
  775. case InsProp[p.opcode].Ch[opCount] of
  776. CH_REAX..CH_MEDI:
  777. if tch2reg(InsProp[p.opcode].Ch[opCount]) = reg then
  778. begin
  779. regInInstruction := true;
  780. exit;
  781. end;
  782. Ch_ROp1..Ch_MOp1:
  783. if regInOp(reg,p.oper[0]) then
  784. begin
  785. regInInstruction := true;
  786. exit
  787. end;
  788. Ch_ROp2..Ch_MOp2:
  789. if regInOp(reg,p.oper[1]) then
  790. begin
  791. regInInstruction := true;
  792. exit
  793. end;
  794. Ch_ROp3..Ch_MOp3:
  795. if regInOp(reg,p.oper[2]) then
  796. begin
  797. regInInstruction := true;
  798. exit
  799. end;
  800. end;
  801. end;
  802. end;
  803. end;
  804. Function RegInOp(Reg: TRegister; const o:toper): Boolean;
  805. Begin
  806. RegInOp := False;
  807. reg := reg32(reg);
  808. Case o.typ Of
  809. top_reg: RegInOp := Reg = reg32(o.reg);
  810. top_ref: RegInOp := (Reg = o.ref^.Base) Or
  811. (Reg = o.ref^.Index);
  812. End;
  813. End;
  814. Function RegModifiedByInstruction(Reg: TRegister; p1: Tai): Boolean;
  815. Var InstrProp: TInsProp;
  816. TmpResult: Boolean;
  817. Cnt: Byte;
  818. Begin
  819. TmpResult := False;
  820. Reg := Reg32(Reg);
  821. If (p1.typ = ait_instruction) Then
  822. Case Taicpu(p1).opcode of
  823. A_IMUL:
  824. With Taicpu(p1) Do
  825. TmpResult :=
  826. ((ops = 1) and (reg in [R_EAX,R_EDX])) or
  827. ((ops = 2) and (Reg32(oper[1].reg) = reg)) or
  828. ((ops = 3) and (Reg32(oper[2].reg) = reg));
  829. A_DIV, A_IDIV, A_MUL:
  830. With Taicpu(p1) Do
  831. TmpResult :=
  832. (Reg = R_EAX) or
  833. (Reg = R_EDX);
  834. Else
  835. Begin
  836. Cnt := 1;
  837. InstrProp := InsProp[Taicpu(p1).OpCode];
  838. While (Cnt <= MaxCh) And
  839. (InstrProp.Ch[Cnt] <> Ch_None) And
  840. Not(TmpResult) Do
  841. Begin
  842. Case InstrProp.Ch[Cnt] Of
  843. Ch_WEAX..Ch_MEDI:
  844. TmpResult := Reg = TCh2Reg(InstrProp.Ch[Cnt]);
  845. Ch_RWOp1,Ch_WOp1,Ch_Mop1:
  846. TmpResult := (Taicpu(p1).oper[0].typ = top_reg) and
  847. (Reg32(Taicpu(p1).oper[0].reg) = reg);
  848. Ch_RWOp2,Ch_WOp2,Ch_Mop2:
  849. TmpResult := (Taicpu(p1).oper[1].typ = top_reg) and
  850. (Reg32(Taicpu(p1).oper[1].reg) = reg);
  851. Ch_RWOp3,Ch_WOp3,Ch_Mop3:
  852. TmpResult := (Taicpu(p1).oper[2].typ = top_reg) and
  853. (Reg32(Taicpu(p1).oper[2].reg) = reg);
  854. Ch_FPU: TmpResult := Reg in [R_ST..R_ST7,R_MM0..R_MM7];
  855. Ch_ALL: TmpResult := true;
  856. End;
  857. Inc(Cnt)
  858. End
  859. End
  860. End;
  861. RegModifiedByInstruction := TmpResult
  862. End;
  863. function instrWritesFlags(p: Tai): boolean;
  864. var
  865. l: longint;
  866. begin
  867. instrWritesFlags := true;
  868. case p.typ of
  869. ait_instruction:
  870. begin
  871. for l := 1 to MaxCh do
  872. if InsProp[Taicpu(p).opcode].Ch[l] in [Ch_WFlags,Ch_RWFlags,Ch_All] then
  873. exit;
  874. end;
  875. ait_label:
  876. exit;
  877. else
  878. instrWritesFlags := false;
  879. end;
  880. end;
  881. function instrReadsFlags(p: Tai): boolean;
  882. var
  883. l: longint;
  884. begin
  885. instrReadsFlags := true;
  886. case p.typ of
  887. ait_instruction:
  888. begin
  889. for l := 1 to MaxCh do
  890. if InsProp[Taicpu(p).opcode].Ch[l] in [Ch_RFlags,Ch_RWFlags,Ch_All] then
  891. exit;
  892. end;
  893. ait_label:
  894. exit;
  895. else
  896. instrReadsFlags := false;
  897. end;
  898. end;
  899. {********************* GetNext and GetLastInstruction *********************}
  900. Function GetNextInstruction(Current: Tai; Var Next: Tai): Boolean;
  901. { skips ait_regalloc, ait_regdealloc and ait_stab* objects and puts the }
  902. { next Tai object in Next. Returns false if there isn't any }
  903. Begin
  904. Repeat
  905. If (Current.typ = ait_marker) And
  906. (Tai_Marker(current).Kind = AsmBlockStart) Then
  907. Begin
  908. GetNextInstruction := False;
  909. Next := Nil;
  910. Exit
  911. End;
  912. Current := Tai(current.Next);
  913. While Assigned(Current) And
  914. ((current.typ In skipInstr) or
  915. ((current.typ = ait_label) and
  916. labelCanBeSkipped(Tai_label(current)))) do
  917. Current := Tai(current.Next);
  918. { If Assigned(Current) And
  919. (current.typ = ait_Marker) And
  920. (Tai_Marker(current).Kind = NoPropInfoStart) Then
  921. Begin
  922. While Assigned(Current) And
  923. ((current.typ <> ait_Marker) Or
  924. (Tai_Marker(current).Kind <> NoPropInfoEnd)) Do
  925. Current := Tai(current.Next);
  926. End;}
  927. Until Not(Assigned(Current)) Or
  928. (current.typ <> ait_Marker) Or
  929. not(Tai_Marker(current).Kind in [NoPropInfoStart,NoPropInfoEnd]);
  930. Next := Current;
  931. If Assigned(Current) And
  932. Not((current.typ In SkipInstr) or
  933. ((current.typ = ait_label) And
  934. labelCanBeSkipped(Tai_label(current))))
  935. Then
  936. GetNextInstruction :=
  937. not((current.typ = ait_marker) and
  938. (Tai_marker(current).kind = asmBlockStart))
  939. Else
  940. Begin
  941. GetNextInstruction := False;
  942. Next := nil;
  943. End;
  944. End;
  945. Function GetLastInstruction(Current: Tai; Var Last: Tai): Boolean;
  946. {skips the ait-types in SkipInstr puts the previous Tai object in
  947. Last. Returns false if there isn't any}
  948. Begin
  949. Repeat
  950. Current := Tai(current.previous);
  951. While Assigned(Current) And
  952. (((current.typ = ait_Marker) And
  953. Not(Tai_Marker(current).Kind in [AsmBlockEnd{,NoPropInfoEnd}])) or
  954. (current.typ In SkipInstr) or
  955. ((current.typ = ait_label) And
  956. labelCanBeSkipped(Tai_label(current)))) Do
  957. Current := Tai(current.previous);
  958. { If Assigned(Current) And
  959. (current.typ = ait_Marker) And
  960. (Tai_Marker(current).Kind = NoPropInfoEnd) Then
  961. Begin
  962. While Assigned(Current) And
  963. ((current.typ <> ait_Marker) Or
  964. (Tai_Marker(current).Kind <> NoPropInfoStart)) Do
  965. Current := Tai(current.previous);
  966. End;}
  967. Until Not(Assigned(Current)) Or
  968. (current.typ <> ait_Marker) Or
  969. not(Tai_Marker(current).Kind in [NoPropInfoStart,NoPropInfoEnd]);
  970. If Not(Assigned(Current)) or
  971. (current.typ In SkipInstr) or
  972. ((current.typ = ait_label) And
  973. labelCanBeSkipped(Tai_label(current))) or
  974. ((current.typ = ait_Marker) And
  975. (Tai_Marker(current).Kind = AsmBlockEnd))
  976. Then
  977. Begin
  978. Last := nil;
  979. GetLastInstruction := False
  980. End
  981. Else
  982. Begin
  983. Last := Current;
  984. GetLastInstruction := True;
  985. End;
  986. End;
  987. Procedure SkipHead(var P: Tai);
  988. Var OldP: Tai;
  989. Begin
  990. Repeat
  991. OldP := P;
  992. If (p.typ in SkipInstr) Or
  993. ((p.typ = ait_marker) And
  994. (Tai_Marker(p).Kind in [AsmBlockEnd,inlinestart,inlineend])) Then
  995. GetNextInstruction(P, P)
  996. Else If ((p.Typ = Ait_Marker) And
  997. (Tai_Marker(p).Kind = nopropinfostart)) Then
  998. {a marker of the NoPropInfoStart can't be the first instruction of a
  999. TAAsmoutput list}
  1000. GetNextInstruction(Tai(p.Previous),P);
  1001. Until P = OldP
  1002. End;
  1003. function labelCanBeSkipped(p: Tai_label): boolean;
  1004. begin
  1005. labelCanBeSkipped := not(p.l.is_used) or p.l.is_addr;
  1006. end;
  1007. {******************* The Data Flow Analyzer functions ********************}
  1008. function regLoadedWithNewValue(reg: tregister; canDependOnPrevValue: boolean;
  1009. hp: Tai): boolean;
  1010. { assumes reg is a 32bit register }
  1011. var p: Taicpu;
  1012. begin
  1013. p := Taicpu(hp);
  1014. regLoadedWithNewValue :=
  1015. assigned(hp) and
  1016. (hp.typ = ait_instruction) and
  1017. (((p.opcode = A_MOV) or
  1018. (p.opcode = A_MOVZX) or
  1019. (p.opcode = A_MOVSX) or
  1020. (p.opcode = A_LEA)) and
  1021. (p.oper[1].typ = top_reg) and
  1022. (Reg32(p.oper[1].reg) = reg) and
  1023. (canDependOnPrevValue or
  1024. (p.oper[0].typ <> top_ref) or
  1025. not regInRef(reg,p.oper[0].ref^)) or
  1026. ((p.opcode = A_POP) and
  1027. (Reg32(p.oper[0].reg) = reg)));
  1028. end;
  1029. Procedure UpdateUsedRegs(Var UsedRegs: TRegSet; p: Tai);
  1030. {updates UsedRegs with the RegAlloc Information coming after P}
  1031. Begin
  1032. Repeat
  1033. While Assigned(p) And
  1034. ((p.typ in (SkipInstr - [ait_RegAlloc])) or
  1035. ((p.typ = ait_label) And
  1036. labelCanBeSkipped(Tai_label(p)))) Do
  1037. p := Tai(p.next);
  1038. While Assigned(p) And
  1039. (p.typ=ait_RegAlloc) Do
  1040. Begin
  1041. if Tairegalloc(p).allocation then
  1042. UsedRegs := UsedRegs + [TaiRegAlloc(p).Reg]
  1043. else
  1044. UsedRegs := UsedRegs - [TaiRegAlloc(p).Reg];
  1045. p := Tai(p.next);
  1046. End;
  1047. Until Not(Assigned(p)) Or
  1048. (Not(p.typ in SkipInstr) And
  1049. Not((p.typ = ait_label) And
  1050. labelCanBeSkipped(Tai_label(p))));
  1051. End;
  1052. Procedure AllocRegBetween(AsmL: TAAsmOutput; Reg: TRegister; p1, p2: Tai);
  1053. { allocates register Reg between (and including) instructions p1 and p2 }
  1054. { the type of p1 and p2 must not be in SkipInstr }
  1055. var
  1056. hp, start: Tai;
  1057. lastRemovedWasDealloc, firstRemovedWasAlloc, first: boolean;
  1058. Begin
  1059. If not(reg in usableregs+[R_EDI,R_ESI]) or
  1060. not(assigned(p1)) Then
  1061. { this happens with registers which are loaded implicitely, outside the }
  1062. { current block (e.g. esi with self) }
  1063. exit;
  1064. lastRemovedWasDealloc := false;
  1065. firstRemovedWasAlloc := false;
  1066. first := true;
  1067. {$ifdef allocregdebug}
  1068. hp := Tai_asm_comment.Create(strpnew('allocating '+att_reg2str[reg]+
  1069. ' from here...')));
  1070. insertllitem(asml,p1.previous,p1,hp);
  1071. hp := Tai_asm_comment.Create(strpnew('allocated '+att_reg2str[reg]+
  1072. ' till here...')));
  1073. insertllitem(asml,p2,p1.next,hp);
  1074. {$endif allocregdebug}
  1075. start := p1;
  1076. Repeat
  1077. If Assigned(p1.OptInfo) Then
  1078. Include(PTaiProp(p1.OptInfo)^.UsedRegs,Reg);
  1079. p1 := Tai(p1.next);
  1080. Repeat
  1081. While assigned(p1) and
  1082. (p1.typ in (SkipInstr-[ait_regalloc])) Do
  1083. p1 := Tai(p1.next);
  1084. { remove all allocation/deallocation info about the register in between }
  1085. If assigned(p1) and
  1086. (p1.typ = ait_regalloc) Then
  1087. If (TaiRegAlloc(p1).Reg = Reg) Then
  1088. Begin
  1089. if first then
  1090. begin
  1091. firstRemovedWasAlloc := TaiRegAlloc(p1).allocation;
  1092. first := false;
  1093. end;
  1094. lastRemovedWasDealloc := not TaiRegAlloc(p1).allocation;
  1095. hp := Tai(p1.Next);
  1096. asml.Remove(p1);
  1097. p1.free;
  1098. p1 := hp;
  1099. End
  1100. Else p1 := Tai(p1.next);
  1101. Until not(assigned(p1)) or
  1102. Not(p1.typ in SkipInstr);
  1103. Until not(assigned(p1)) or
  1104. (p1 = p2);
  1105. if assigned(p1) then
  1106. begin
  1107. if assigned(p1.optinfo) then
  1108. include(PTaiProp(p1.OptInfo)^.UsedRegs,Reg);
  1109. if lastRemovedWasDealloc then
  1110. begin
  1111. hp := TaiRegalloc.DeAlloc(reg);
  1112. insertLLItem(asmL,p1,p1.next,hp);
  1113. end;
  1114. end;
  1115. if firstRemovedWasAlloc then
  1116. begin
  1117. hp := TaiRegalloc.Alloc(reg);
  1118. insertLLItem(asmL,start.previous,start,hp);
  1119. end;
  1120. End;
  1121. function FindRegDealloc(reg: tregister; p: Tai): boolean;
  1122. { assumes reg is a 32bit register }
  1123. var
  1124. hp: Tai;
  1125. first: boolean;
  1126. begin
  1127. findregdealloc := false;
  1128. first := true;
  1129. while assigned(p.previous) and
  1130. ((Tai(p.previous).typ in (skipinstr+[ait_align])) or
  1131. ((Tai(p.previous).typ = ait_label) and
  1132. labelCanBeSkipped(Tai_label(p.previous)))) do
  1133. begin
  1134. p := Tai(p.previous);
  1135. if (p.typ = ait_regalloc) and
  1136. (Tairegalloc(p).reg = reg) then
  1137. if not(Tairegalloc(p).allocation) then
  1138. if first then
  1139. begin
  1140. findregdealloc := true;
  1141. break;
  1142. end
  1143. else
  1144. begin
  1145. findRegDealloc :=
  1146. getNextInstruction(p,hp) and
  1147. regLoadedWithNewValue(reg,false,hp);
  1148. break
  1149. end
  1150. else
  1151. first := false;
  1152. end
  1153. end;
  1154. Procedure IncState(Var S: Byte; amount: longint);
  1155. {Increases S by 1, wraps around at $ffff to 0 (so we won't get overflow
  1156. errors}
  1157. Begin
  1158. if (s <= $ff - amount) then
  1159. inc(s, amount)
  1160. else s := longint(s) + amount - $ff;
  1161. End;
  1162. Function sequenceDependsonReg(Const Content: TContent; seqReg, Reg: TRegister): Boolean;
  1163. { Content is the sequence of instructions that describes the contents of }
  1164. { seqReg. Reg is being overwritten by the current instruction. If the }
  1165. { content of seqReg depends on reg (ie. because of a }
  1166. { "movl (seqreg,reg), seqReg" instruction), this function returns true }
  1167. Var p: Tai;
  1168. Counter: Byte;
  1169. TmpResult: Boolean;
  1170. RegsChecked: TRegSet;
  1171. Begin
  1172. RegsChecked := [];
  1173. p := Content.StartMod;
  1174. TmpResult := False;
  1175. Counter := 1;
  1176. While Not(TmpResult) And
  1177. (Counter <= Content.NrOfMods) Do
  1178. Begin
  1179. If (p.typ = ait_instruction) and
  1180. ((Taicpu(p).opcode = A_MOV) or
  1181. (Taicpu(p).opcode = A_MOVZX) or
  1182. (Taicpu(p).opcode = A_MOVSX) or
  1183. (Taicpu(p).opcode = A_LEA)) and
  1184. (Taicpu(p).oper[0].typ = top_ref) Then
  1185. With Taicpu(p).oper[0].ref^ Do
  1186. If ((Base = procinfo^.FramePointer) or
  1187. (assigned(symbol) and (base = R_NO))) And
  1188. (Index = R_NO) Then
  1189. Begin
  1190. RegsChecked := RegsChecked + [Reg32(Taicpu(p).oper[1].reg)];
  1191. If Reg = Reg32(Taicpu(p).oper[1].reg) Then
  1192. Break;
  1193. End
  1194. Else
  1195. tmpResult :=
  1196. regReadByInstruction(reg,p) and
  1197. regModifiedByInstruction(seqReg,p)
  1198. Else
  1199. tmpResult :=
  1200. regReadByInstruction(reg,p) and
  1201. regModifiedByInstruction(seqReg,p);
  1202. Inc(Counter);
  1203. GetNextInstruction(p,p)
  1204. End;
  1205. sequenceDependsonReg := TmpResult
  1206. End;
  1207. procedure invalidateDependingRegs(p1: pTaiProp; reg: tregister);
  1208. var
  1209. counter: tregister;
  1210. begin
  1211. for counter := R_EAX to R_EDI Do
  1212. if counter <> reg then
  1213. with p1^.regs[counter] Do
  1214. if (typ in [con_ref,con_noRemoveRef]) and
  1215. sequenceDependsOnReg(p1^.Regs[counter],counter,reg) then
  1216. if typ in [con_ref,con_invalid] then
  1217. typ := con_invalid
  1218. { con_invalid and con_noRemoveRef = con_unknown }
  1219. else typ := con_unknown;
  1220. end;
  1221. Procedure DestroyReg(p1: PTaiProp; Reg: TRegister; doIncState:Boolean);
  1222. {Destroys the contents of the register Reg in the PTaiProp p1, as well as the
  1223. contents of registers are loaded with a memory location based on Reg.
  1224. doIncState is false when this register has to be destroyed not because
  1225. it's contents are directly modified/overwritten, but because of an indirect
  1226. action (e.g. this register holds the contents of a variable and the value
  1227. of the variable in memory is changed) }
  1228. Begin
  1229. Reg := Reg32(Reg);
  1230. { the following happens for fpu registers }
  1231. if (reg < low(NrOfInstrSinceLastMod)) or
  1232. (reg > high(NrOfInstrSinceLastMod)) then
  1233. exit;
  1234. NrOfInstrSinceLastMod[Reg] := 0;
  1235. if (reg >= R_EAX) and (reg <= R_EDI) then
  1236. begin
  1237. with p1^.regs[reg] do
  1238. begin
  1239. if doIncState then
  1240. begin
  1241. incState(wstate,1);
  1242. typ := con_unknown;
  1243. end
  1244. else
  1245. if typ in [con_ref,con_invalid] then
  1246. typ := con_invalid
  1247. { con_invalid and con_noRemoveRef = con_unknown }
  1248. else typ := con_unknown;
  1249. end;
  1250. invalidateDependingRegs(p1,reg);
  1251. end;
  1252. End;
  1253. {Procedure AddRegsToSet(p: Tai; Var RegSet: TRegSet);
  1254. Begin
  1255. If (p.typ = ait_instruction) Then
  1256. Begin
  1257. Case Taicpu(p).oper[0].typ Of
  1258. top_reg:
  1259. If Not(Taicpu(p).oper[0].reg in [R_NO,R_ESP,procinfo^.FramePointer]) Then
  1260. RegSet := RegSet + [Taicpu(p).oper[0].reg];
  1261. top_ref:
  1262. With TReference(Taicpu(p).oper[0]^) Do
  1263. Begin
  1264. If Not(Base in [procinfo^.FramePointer,R_NO,R_ESP])
  1265. Then RegSet := RegSet + [Base];
  1266. If Not(Index in [procinfo^.FramePointer,R_NO,R_ESP])
  1267. Then RegSet := RegSet + [Index];
  1268. End;
  1269. End;
  1270. Case Taicpu(p).oper[1].typ Of
  1271. top_reg:
  1272. If Not(Taicpu(p).oper[1].reg in [R_NO,R_ESP,procinfo^.FramePointer]) Then
  1273. If RegSet := RegSet + [TRegister(TwoWords(Taicpu(p).oper[1]).Word1];
  1274. top_ref:
  1275. With TReference(Taicpu(p).oper[1]^) Do
  1276. Begin
  1277. If Not(Base in [procinfo^.FramePointer,R_NO,R_ESP])
  1278. Then RegSet := RegSet + [Base];
  1279. If Not(Index in [procinfo^.FramePointer,R_NO,R_ESP])
  1280. Then RegSet := RegSet + [Index];
  1281. End;
  1282. End;
  1283. End;
  1284. End;}
  1285. Function OpsEquivalent(const o1, o2: toper; Var RegInfo: TRegInfo; OpAct: TopAction): Boolean;
  1286. Begin {checks whether the two ops are equivalent}
  1287. OpsEquivalent := False;
  1288. if o1.typ=o2.typ then
  1289. Case o1.typ Of
  1290. Top_Reg:
  1291. OpsEquivalent :=RegsEquivalent(o1.reg,o2.reg, RegInfo, OpAct);
  1292. Top_Ref:
  1293. OpsEquivalent := RefsEquivalent(o1.ref^, o2.ref^, RegInfo, OpAct);
  1294. Top_Const:
  1295. OpsEquivalent := o1.val = o2.val;
  1296. Top_None:
  1297. OpsEquivalent := True
  1298. End;
  1299. End;
  1300. Function OpsEqual(const o1,o2:toper): Boolean;
  1301. Begin {checks whether the two ops are equal}
  1302. OpsEqual := False;
  1303. if o1.typ=o2.typ then
  1304. Case o1.typ Of
  1305. Top_Reg :
  1306. OpsEqual:=o1.reg=o2.reg;
  1307. Top_Ref :
  1308. OpsEqual := RefsEqual(o1.ref^, o2.ref^);
  1309. Top_Const :
  1310. OpsEqual:=o1.val=o2.val;
  1311. Top_Symbol :
  1312. OpsEqual:=(o1.sym=o2.sym) and (o1.symofs=o2.symofs);
  1313. Top_None :
  1314. OpsEqual := True
  1315. End;
  1316. End;
  1317. Function InstructionsEquivalent(p1, p2: Tai; Var RegInfo: TRegInfo): Boolean;
  1318. {$ifdef csdebug}
  1319. var
  1320. hp: Tai;
  1321. {$endif csdebug}
  1322. Begin {checks whether two Taicpu instructions are equal}
  1323. If Assigned(p1) And Assigned(p2) And
  1324. (Tai(p1).typ = ait_instruction) And
  1325. (Tai(p1).typ = ait_instruction) And
  1326. (Taicpu(p1).opcode = Taicpu(p2).opcode) And
  1327. (Taicpu(p1).oper[0].typ = Taicpu(p2).oper[0].typ) And
  1328. (Taicpu(p1).oper[1].typ = Taicpu(p2).oper[1].typ) And
  1329. (Taicpu(p1).oper[2].typ = Taicpu(p2).oper[2].typ)
  1330. Then
  1331. {both instructions have the same structure:
  1332. "<operator> <operand of type1>, <operand of type 2>"}
  1333. If ((Taicpu(p1).opcode = A_MOV) or
  1334. (Taicpu(p1).opcode = A_MOVZX) or
  1335. (Taicpu(p1).opcode = A_MOVSX) or
  1336. (Taicpu(p1).opcode = A_LEA)) And
  1337. (Taicpu(p1).oper[0].typ = top_ref) {then .oper[1]t = top_reg} Then
  1338. If Not(RegInRef(Taicpu(p1).oper[1].reg, Taicpu(p1).oper[0].ref^)) Then
  1339. {the "old" instruction is a load of a register with a new value, not with
  1340. a value based on the contents of this register (so no "mov (reg), reg")}
  1341. If Not(RegInRef(Taicpu(p2).oper[1].reg, Taicpu(p2).oper[0].ref^)) And
  1342. RefsEqual(Taicpu(p1).oper[0].ref^, Taicpu(p2).oper[0].ref^)
  1343. Then
  1344. {the "new" instruction is also a load of a register with a new value, and
  1345. this value is fetched from the same memory location}
  1346. Begin
  1347. With Taicpu(p2).oper[0].ref^ Do
  1348. Begin
  1349. If Not(Base in [procinfo^.FramePointer, R_NO, R_ESP]) Then
  1350. RegInfo.RegsLoadedForRef := RegInfo.RegsLoadedForRef + [Base];
  1351. If Not(Index in [procinfo^.FramePointer, R_NO, R_ESP]) Then
  1352. RegInfo.RegsLoadedForRef := RegInfo.RegsLoadedForRef + [Index];
  1353. End;
  1354. {add the registers from the reference (.oper[0]) to the RegInfo, all registers
  1355. from the reference are the same in the old and in the new instruction
  1356. sequence}
  1357. AddOp2RegInfo(Taicpu(p1).oper[0], RegInfo);
  1358. {the registers from .oper[1] have to be equivalent, but not necessarily equal}
  1359. InstructionsEquivalent :=
  1360. RegsEquivalent(Taicpu(p1).oper[1].reg, Taicpu(p2).oper[1].reg, RegInfo, OpAct_Write);
  1361. End
  1362. {the registers are loaded with values from different memory locations. If
  1363. this was allowed, the instructions "mov -4(esi),eax" and "mov -4(ebp),eax"
  1364. would be considered equivalent}
  1365. Else InstructionsEquivalent := False
  1366. Else
  1367. {load register with a value based on the current value of this register}
  1368. Begin
  1369. With Taicpu(p2).oper[0].ref^ Do
  1370. Begin
  1371. If Not(Base in [procinfo^.FramePointer,
  1372. Reg32(Taicpu(p2).oper[1].reg),R_NO,R_ESP]) Then
  1373. {it won't do any harm if the register is already in RegsLoadedForRef}
  1374. Begin
  1375. RegInfo.RegsLoadedForRef := RegInfo.RegsLoadedForRef + [Base];
  1376. {$ifdef csdebug}
  1377. Writeln(att_reg2str[base], ' added');
  1378. {$endif csdebug}
  1379. end;
  1380. If Not(Index in [procinfo^.FramePointer,
  1381. Reg32(Taicpu(p2).oper[1].reg),R_NO,R_ESP]) Then
  1382. Begin
  1383. RegInfo.RegsLoadedForRef := RegInfo.RegsLoadedForRef + [Index];
  1384. {$ifdef csdebug}
  1385. Writeln(att_reg2str[index], ' added');
  1386. {$endif csdebug}
  1387. end;
  1388. End;
  1389. If Not(Reg32(Taicpu(p2).oper[1].reg) In [procinfo^.FramePointer,R_NO,R_ESP])
  1390. Then
  1391. Begin
  1392. RegInfo.RegsLoadedForRef := RegInfo.RegsLoadedForRef -
  1393. [Reg32(Taicpu(p2).oper[1].reg)];
  1394. {$ifdef csdebug}
  1395. Writeln(att_reg2str[Reg32(Taicpu(p2).oper[1].reg)], ' removed');
  1396. {$endif csdebug}
  1397. end;
  1398. InstructionsEquivalent :=
  1399. OpsEquivalent(Taicpu(p1).oper[0], Taicpu(p2).oper[0], RegInfo, OpAct_Read) And
  1400. OpsEquivalent(Taicpu(p1).oper[1], Taicpu(p2).oper[1], RegInfo, OpAct_Write)
  1401. End
  1402. Else
  1403. {an instruction <> mov, movzx, movsx}
  1404. begin
  1405. {$ifdef csdebug}
  1406. hp := Tai_asm_comment.Create(strpnew('checking if equivalent'));
  1407. hp.previous := p2;
  1408. hp.next := p2^.next;
  1409. p2^.next^.previous := hp;
  1410. p2^.next := hp;
  1411. {$endif csdebug}
  1412. InstructionsEquivalent :=
  1413. OpsEquivalent(Taicpu(p1).oper[0], Taicpu(p2).oper[0], RegInfo, OpAct_Unknown) And
  1414. OpsEquivalent(Taicpu(p1).oper[1], Taicpu(p2).oper[1], RegInfo, OpAct_Unknown) And
  1415. OpsEquivalent(Taicpu(p1).oper[2], Taicpu(p2).oper[2], RegInfo, OpAct_Unknown)
  1416. end
  1417. {the instructions haven't even got the same structure, so they're certainly
  1418. not equivalent}
  1419. Else
  1420. begin
  1421. {$ifdef csdebug}
  1422. hp := Tai_asm_comment.Create(strpnew('different opcodes/format'));
  1423. hp.previous := p2;
  1424. hp.next := p2^.next;
  1425. p2^.next^.previous := hp;
  1426. p2^.next := hp;
  1427. {$endif csdebug}
  1428. InstructionsEquivalent := False;
  1429. end;
  1430. {$ifdef csdebug}
  1431. hp := Tai_asm_comment.Create(strpnew('instreq: '+tostr(byte(instructionsequivalent))));
  1432. hp.previous := p2;
  1433. hp.next := p2^.next;
  1434. p2^.next^.previous := hp;
  1435. p2^.next := hp;
  1436. {$endif csdebug}
  1437. End;
  1438. (*
  1439. Function InstructionsEqual(p1, p2: Tai): Boolean;
  1440. Begin {checks whether two Taicpu instructions are equal}
  1441. InstructionsEqual :=
  1442. Assigned(p1) And Assigned(p2) And
  1443. ((Tai(p1).typ = ait_instruction) And
  1444. (Tai(p1).typ = ait_instruction) And
  1445. (Taicpu(p1).opcode = Taicpu(p2).opcode) And
  1446. (Taicpu(p1).oper[0].typ = Taicpu(p2).oper[0].typ) And
  1447. (Taicpu(p1).oper[1].typ = Taicpu(p2).oper[1].typ) And
  1448. OpsEqual(Taicpu(p1).oper[0].typ, Taicpu(p1).oper[0], Taicpu(p2).oper[0]) And
  1449. OpsEqual(Taicpu(p1).oper[1].typ, Taicpu(p1).oper[1], Taicpu(p2).oper[1]))
  1450. End;
  1451. *)
  1452. Procedure ReadReg(p: PTaiProp; Reg: TRegister);
  1453. Begin
  1454. Reg := Reg32(Reg);
  1455. If Reg in [R_EAX..R_EDI] Then
  1456. incState(p^.regs[Reg].rstate,1)
  1457. End;
  1458. Procedure ReadRef(p: PTaiProp; Ref: PReference);
  1459. Begin
  1460. If Ref^.Base <> R_NO Then
  1461. ReadReg(p, Ref^.Base);
  1462. If Ref^.Index <> R_NO Then
  1463. ReadReg(p, Ref^.Index);
  1464. End;
  1465. Procedure ReadOp(P: PTaiProp;const o:toper);
  1466. Begin
  1467. Case o.typ Of
  1468. top_reg: ReadReg(P, o.reg);
  1469. top_ref: ReadRef(P, o.ref);
  1470. top_symbol : ;
  1471. End;
  1472. End;
  1473. Function RefInInstruction(Const Ref: TReference; p: Tai;
  1474. RefsEq: TRefCompare): Boolean;
  1475. {checks whehter Ref is used in P}
  1476. Var TmpResult: Boolean;
  1477. Begin
  1478. TmpResult := False;
  1479. If (p.typ = ait_instruction) Then
  1480. Begin
  1481. If (Taicpu(p).oper[0].typ = Top_Ref) Then
  1482. TmpResult := RefsEq(Ref, Taicpu(p).oper[0].ref^);
  1483. If Not(TmpResult) And (Taicpu(p).oper[1].typ = Top_Ref) Then
  1484. TmpResult := RefsEq(Ref, Taicpu(p).oper[1].ref^);
  1485. If Not(TmpResult) And (Taicpu(p).oper[2].typ = Top_Ref) Then
  1486. TmpResult := RefsEq(Ref, Taicpu(p).oper[2].ref^);
  1487. End;
  1488. RefInInstruction := TmpResult;
  1489. End;
  1490. Function RefInSequence(Const Ref: TReference; Content: TContent;
  1491. RefsEq: TRefCompare): Boolean;
  1492. {checks the whole sequence of Content (so StartMod and and the next NrOfMods
  1493. Tai objects) to see whether Ref is used somewhere}
  1494. Var p: Tai;
  1495. Counter: Byte;
  1496. TmpResult: Boolean;
  1497. Begin
  1498. p := Content.StartMod;
  1499. TmpResult := False;
  1500. Counter := 1;
  1501. While Not(TmpResult) And
  1502. (Counter <= Content.NrOfMods) Do
  1503. Begin
  1504. If (p.typ = ait_instruction) And
  1505. RefInInstruction(Ref, p, RefsEq)
  1506. Then TmpResult := True;
  1507. Inc(Counter);
  1508. GetNextInstruction(p,p)
  1509. End;
  1510. RefInSequence := TmpResult
  1511. End;
  1512. Function ArrayRefsEq(const r1, r2: TReference): Boolean;
  1513. Begin
  1514. ArrayRefsEq := (R1.Offset+R1.OffsetFixup = R2.Offset+R2.OffsetFixup) And
  1515. (R1.Segment = R2.Segment) And
  1516. (R1.Symbol=R2.Symbol) And
  1517. (R1.Base = R2.Base)
  1518. End;
  1519. function isSimpleRef(const ref: treference): boolean;
  1520. { returns true if ref is reference to a local or global variable, to a }
  1521. { parameter or to an object field (this includes arrays). Returns false }
  1522. { otherwise. }
  1523. begin
  1524. isSimpleRef :=
  1525. assigned(ref.symbol) or
  1526. (ref.base = procinfo^.framepointer) or
  1527. (assigned(procinfo^._class) and
  1528. (ref.base = R_ESI));
  1529. end;
  1530. function containsPointerRef(p: Tai): boolean;
  1531. { checks if an instruction contains a reference which is a pointer location }
  1532. var
  1533. hp: Taicpu;
  1534. count: longint;
  1535. begin
  1536. containsPointerRef := false;
  1537. if p.typ <> ait_instruction then
  1538. exit;
  1539. hp := Taicpu(p);
  1540. for count := low(hp.oper) to high(hp.oper) do
  1541. begin
  1542. case hp.oper[count].typ of
  1543. top_ref:
  1544. if not isSimpleRef(hp.oper[count].ref^) then
  1545. begin
  1546. containsPointerRef := true;
  1547. exit;
  1548. end;
  1549. top_none:
  1550. exit;
  1551. end;
  1552. end;
  1553. end;
  1554. function containsPointerLoad(c: tcontent): boolean;
  1555. { checks whether the contents of a register contain a pointer reference }
  1556. var
  1557. p: Tai;
  1558. count: longint;
  1559. begin
  1560. containsPointerLoad := false;
  1561. p := c.startmod;
  1562. for count := c.nrOfMods downto 1 do
  1563. begin
  1564. if containsPointerRef(p) then
  1565. begin
  1566. containsPointerLoad := true;
  1567. exit;
  1568. end;
  1569. getnextinstruction(p,p);
  1570. end;
  1571. end;
  1572. function writeToMemDestroysContents(regWritten: tregister; const ref: treference;
  1573. reg: tregister; const c: tcontent): boolean;
  1574. { returns whether the contents c of reg are invalid after regWritten is }
  1575. { is written to ref }
  1576. var
  1577. refsEq: trefCompare;
  1578. begin
  1579. if not(c.typ in [con_ref,con_noRemoveRef,con_invalid]) then
  1580. begin
  1581. writeToMemDestroysContents := false;
  1582. exit;
  1583. end;
  1584. reg := reg32(reg);
  1585. regWritten := reg32(regWritten);
  1586. if isSimpleRef(ref) then
  1587. begin
  1588. if (ref.index <> R_NO) or
  1589. (assigned(ref.symbol) and
  1590. (ref.base <> R_NO)) then
  1591. { local/global variable or parameter which is an array }
  1592. refsEq := {$ifdef fpc}@{$endif}arrayRefsEq
  1593. else
  1594. { local/global variable or parameter which is not an array }
  1595. refsEq := {$ifdef fpc}@{$endif}refsEqual;
  1596. { write something to a parameter, a local or global variable, so }
  1597. { * with uncertain optimizations on: }
  1598. { - destroy the contents of registers whose contents have somewhere a }
  1599. { "mov?? (Ref), %reg". WhichReg (this is the register whose contents }
  1600. { are being written to memory) is not destroyed if it's StartMod is }
  1601. { of that form and NrOfMods = 1 (so if it holds ref, but is not a }
  1602. { expression based on Ref) }
  1603. { * with uncertain optimizations off: }
  1604. { - also destroy registers that contain any pointer }
  1605. with c do
  1606. writeToMemDestroysContents :=
  1607. (typ in [con_ref,con_noRemoveRef]) and
  1608. ((not(cs_uncertainOpts in aktglobalswitches) and
  1609. containsPointerLoad(c)
  1610. ) or
  1611. (refInSequence(ref,c,refsEq) and
  1612. ((reg <> regWritten) or
  1613. not((nrOfMods = 1) and
  1614. {StarMod is always of the type ait_instruction}
  1615. (Taicpu(StartMod).oper[0].typ = top_ref) and
  1616. refsEq(Taicpu(StartMod).oper[0].ref^, ref)
  1617. )
  1618. )
  1619. )
  1620. )
  1621. end
  1622. else
  1623. { write something to a pointer location, so }
  1624. { * with uncertain optimzations on: }
  1625. { - do not destroy registers which contain a local/global variable or }
  1626. { a parameter, except if DestroyRefs is called because of a "movsl" }
  1627. { * with uncertain optimzations off: }
  1628. { - destroy every register which contains a memory location }
  1629. with c do
  1630. writeToMemDestroysContents :=
  1631. (typ in [con_ref,con_noRemoveRef]) and
  1632. (not(cs_UncertainOpts in aktglobalswitches) or
  1633. { for movsl }
  1634. ((ref.base = R_EDI) and (ref.index = R_EDI)) or
  1635. { don't destroy if reg contains a parameter, local or global variable }
  1636. containsPointerLoad(c)
  1637. )
  1638. end;
  1639. function writeToRegDestroysContents(destReg: tregister; reg: tregister;
  1640. const c: tcontent): boolean;
  1641. { returns whether the contents c of reg are invalid after destReg is }
  1642. { modified }
  1643. begin
  1644. writeToRegDestroysContents :=
  1645. (c.typ in [con_ref,con_noRemoveRef,con_invalid]) and
  1646. sequenceDependsOnReg(c,reg,reg32(destReg));
  1647. end;
  1648. function writeDestroysContents(const op: toper; reg: tregister;
  1649. const c: tcontent): boolean;
  1650. { returns whether the contents c of reg are invalid after regWritten is }
  1651. { is written to op }
  1652. begin
  1653. reg := reg32(reg);
  1654. case op.typ of
  1655. top_reg:
  1656. writeDestroysContents :=
  1657. writeToRegDestroysContents(op.reg,reg,c);
  1658. top_ref:
  1659. writeDestroysContents :=
  1660. writeToMemDestroysContents(R_NO,op.ref^,reg,c);
  1661. else
  1662. writeDestroysContents := false;
  1663. end;
  1664. end;
  1665. procedure destroyRefs(p: Tai; const ref: treference; regWritten: tregister);
  1666. { destroys all registers which possibly contain a reference to Ref, regWritten }
  1667. { is the register whose contents are being written to memory (if this proc }
  1668. { is called because of a "mov?? %reg, (mem)" instruction) }
  1669. var
  1670. counter: TRegister;
  1671. begin
  1672. for counter := R_EAX to R_EDI Do
  1673. if writeToMemDestroysContents(regWritten,ref,counter,
  1674. pTaiProp(p.optInfo)^.regs[counter]) then
  1675. destroyReg(pTaiProp(p.optInfo), counter, false)
  1676. End;
  1677. Procedure DestroyAllRegs(p: PTaiProp);
  1678. Var Counter: TRegister;
  1679. Begin {initializes/desrtoys all registers}
  1680. For Counter := R_EAX To R_EDI Do
  1681. Begin
  1682. ReadReg(p, Counter);
  1683. DestroyReg(p, Counter, true);
  1684. End;
  1685. p^.DirFlag := F_Unknown;
  1686. End;
  1687. Procedure DestroyOp(TaiObj: Tai; const o:Toper);
  1688. {$ifdef statedebug}
  1689. var hp: Tai;
  1690. {$endif statedebug}
  1691. Begin
  1692. Case o.typ Of
  1693. top_reg:
  1694. begin
  1695. {$ifdef statedebug}
  1696. hp := Tai_asm_comment.Create(strpnew('destroying '+att_reg2str[o.reg]));
  1697. hp.next := Taiobj^.next;
  1698. hp.previous := Taiobj;
  1699. Taiobj^.next := hp;
  1700. if assigned(hp.next) then
  1701. hp.next^.previous := hp;
  1702. {$endif statedebug}
  1703. DestroyReg(PTaiProp(TaiObj.OptInfo), reg32(o.reg), true);
  1704. end;
  1705. top_ref:
  1706. Begin
  1707. ReadRef(PTaiProp(TaiObj.OptInfo), o.ref);
  1708. DestroyRefs(TaiObj, o.ref^, R_NO);
  1709. End;
  1710. top_symbol:;
  1711. End;
  1712. End;
  1713. Function DFAPass1(AsmL: TAAsmOutput; BlockStart: Tai): Tai;
  1714. {gathers the RegAlloc data... still need to think about where to store it to
  1715. avoid global vars}
  1716. Var BlockEnd: Tai;
  1717. Begin
  1718. BlockEnd := FindLoHiLabels(LoLab, HiLab, LabDif, BlockStart);
  1719. BuildLabelTableAndFixRegAlloc(AsmL, LTable, LoLab, LabDif, BlockStart, BlockEnd);
  1720. DFAPass1 := BlockEnd;
  1721. End;
  1722. Procedure AddInstr2RegContents({$ifdef statedebug} asml: TAAsmoutput; {$endif}
  1723. p: Taicpu; reg: TRegister);
  1724. {$ifdef statedebug}
  1725. var hp: Tai;
  1726. {$endif statedebug}
  1727. Begin
  1728. Reg := Reg32(Reg);
  1729. With PTaiProp(p.optinfo)^.Regs[reg] Do
  1730. if (typ in [con_ref,con_noRemoveRef])
  1731. Then
  1732. Begin
  1733. incState(wstate,1);
  1734. {also store how many instructions are part of the sequence in the first
  1735. instructions PTaiProp, so it can be easily accessed from within
  1736. CheckSequence}
  1737. Inc(NrOfMods, NrOfInstrSinceLastMod[Reg]);
  1738. PTaiProp(Tai(StartMod).OptInfo)^.Regs[Reg].NrOfMods := NrOfMods;
  1739. NrOfInstrSinceLastMod[Reg] := 0;
  1740. invalidateDependingRegs(p.optinfo,reg);
  1741. {$ifdef StateDebug}
  1742. hp := Tai_asm_comment.Create(strpnew(att_reg2str[reg]+': '+tostr(PTaiProp(p.optinfo)^.Regs[reg].WState)
  1743. + ' -- ' + tostr(PTaiProp(p.optinfo)^.Regs[reg].nrofmods))));
  1744. InsertLLItem(AsmL, p, p.next, hp);
  1745. {$endif StateDebug}
  1746. End
  1747. Else
  1748. Begin
  1749. {$ifdef statedebug}
  1750. hp := Tai_asm_comment.Create(strpnew('destroying '+att_reg2str[reg]));
  1751. insertllitem(asml,p,p.next,hp);
  1752. {$endif statedebug}
  1753. DestroyReg(PTaiProp(p.optinfo), Reg, true);
  1754. {$ifdef StateDebug}
  1755. hp := Tai_asm_comment.Create(strpnew(att_reg2str[reg]+': '+tostr(PTaiProp(p.optinfo)^.Regs[reg].WState)));
  1756. InsertLLItem(AsmL, p, p.next, hp);
  1757. {$endif StateDebug}
  1758. End
  1759. End;
  1760. Procedure AddInstr2OpContents({$ifdef statedebug} asml: TAAsmoutput; {$endif}
  1761. p: Taicpu; const oper: TOper);
  1762. Begin
  1763. If oper.typ = top_reg Then
  1764. AddInstr2RegContents({$ifdef statedebug} asml, {$endif}p, oper.reg)
  1765. Else
  1766. Begin
  1767. ReadOp(PTaiProp(p.optinfo), oper);
  1768. DestroyOp(p, oper);
  1769. End
  1770. End;
  1771. Procedure DoDFAPass2(
  1772. {$Ifdef StateDebug}
  1773. AsmL: TAAsmOutput;
  1774. {$endif statedebug}
  1775. BlockStart, BlockEnd: Tai);
  1776. {Analyzes the Data Flow of an assembler list. Starts creating the reg
  1777. contents for the instructions starting with p. Returns the last Tai which has
  1778. been processed}
  1779. Var
  1780. CurProp, LastFlagsChangeProp: PTaiProp;
  1781. Cnt, InstrCnt : Longint;
  1782. InstrProp: TInsProp;
  1783. UsedRegs: TRegSet;
  1784. prev, p, hp : Tai;
  1785. TmpRef: TReference;
  1786. TmpReg: TRegister;
  1787. {$ifdef AnalyzeLoops}
  1788. TmpState: Byte;
  1789. {$endif AnalyzeLoops}
  1790. Begin
  1791. p := BlockStart;
  1792. LastFlagsChangeProp := nil;
  1793. prev := nil;
  1794. UsedRegs := [];
  1795. UpdateUsedregs(UsedRegs, p);
  1796. SkipHead(P);
  1797. BlockStart := p;
  1798. InstrCnt := 1;
  1799. FillChar(NrOfInstrSinceLastMod, SizeOf(NrOfInstrSinceLastMod), 0);
  1800. While (P <> BlockEnd) Do
  1801. Begin
  1802. CurProp := @TaiPropBlock^[InstrCnt];
  1803. If assigned(prev)
  1804. Then
  1805. Begin
  1806. {$ifdef JumpAnal}
  1807. If (p.Typ <> ait_label) Then
  1808. {$endif JumpAnal}
  1809. Begin
  1810. CurProp^.regs := PTaiProp(prev.OptInfo)^.Regs;
  1811. CurProp^.DirFlag := PTaiProp(prev.OptInfo)^.DirFlag;
  1812. CurProp^.FlagsUsed := false;
  1813. End
  1814. End
  1815. Else
  1816. Begin
  1817. FillChar(CurProp^, SizeOf(CurProp^), 0);
  1818. { For TmpReg := R_EAX to R_EDI Do
  1819. CurProp^.regs[TmpReg].WState := 1;}
  1820. End;
  1821. CurProp^.UsedRegs := UsedRegs;
  1822. CurProp^.CanBeRemoved := False;
  1823. UpdateUsedRegs(UsedRegs, Tai(p.Next));
  1824. For TmpReg := R_EAX To R_EDI Do
  1825. if NrOfInstrSinceLastMod[TmpReg] < 255 then
  1826. Inc(NrOfInstrSinceLastMod[TmpReg])
  1827. else
  1828. begin
  1829. NrOfInstrSinceLastMod[TmpReg] := 0;
  1830. curprop^.regs[TmpReg].typ := con_unknown;
  1831. end;
  1832. Case p.typ Of
  1833. ait_marker:;
  1834. ait_label:
  1835. {$Ifndef JumpAnal}
  1836. If not labelCanBeSkipped(Tai_label(p)) Then
  1837. DestroyAllRegs(CurProp);
  1838. {$Else JumpAnal}
  1839. Begin
  1840. If not labelCanBeSkipped(Tai_label(p)) Then
  1841. With LTable^[Tai_Label(p).l^.labelnr-LoLab] Do
  1842. {$IfDef AnalyzeLoops}
  1843. If (RefsFound = Tai_Label(p).l^.RefCount)
  1844. {$Else AnalyzeLoops}
  1845. If (JmpsProcessed = Tai_Label(p).l^.RefCount)
  1846. {$EndIf AnalyzeLoops}
  1847. Then
  1848. {all jumps to this label have been found}
  1849. {$IfDef AnalyzeLoops}
  1850. If (JmpsProcessed > 0)
  1851. Then
  1852. {$EndIf AnalyzeLoops}
  1853. {we've processed at least one jump to this label}
  1854. Begin
  1855. If (GetLastInstruction(p, hp) And
  1856. Not(((hp.typ = ait_instruction)) And
  1857. (Taicpu_labeled(hp).is_jmp))
  1858. Then
  1859. {previous instruction not a JMP -> the contents of the registers after the
  1860. previous intruction has been executed have to be taken into account as well}
  1861. For TmpReg := R_EAX to R_EDI Do
  1862. Begin
  1863. If (CurProp^.regs[TmpReg].WState <>
  1864. PTaiProp(hp.OptInfo)^.Regs[TmpReg].WState)
  1865. Then DestroyReg(CurProp, TmpReg, true)
  1866. End
  1867. End
  1868. {$IfDef AnalyzeLoops}
  1869. Else
  1870. {a label from a backward jump (e.g. a loop), no jump to this label has
  1871. already been processed}
  1872. If GetLastInstruction(p, hp) And
  1873. Not(hp.typ = ait_instruction) And
  1874. (Taicpu_labeled(hp).opcode = A_JMP))
  1875. Then
  1876. {previous instruction not a jmp, so keep all the registers' contents from the
  1877. previous instruction}
  1878. Begin
  1879. CurProp^.regs := PTaiProp(hp.OptInfo)^.Regs;
  1880. CurProp.DirFlag := PTaiProp(hp.OptInfo)^.DirFlag;
  1881. End
  1882. Else
  1883. {previous instruction a jmp and no jump to this label processed yet}
  1884. Begin
  1885. hp := p;
  1886. Cnt := InstrCnt;
  1887. {continue until we find a jump to the label or a label which has already
  1888. been processed}
  1889. While GetNextInstruction(hp, hp) And
  1890. Not((hp.typ = ait_instruction) And
  1891. (Taicpu(hp).is_jmp) and
  1892. (tasmlabel(Taicpu(hp).oper[0].sym).labelnr = Tai_Label(p).l^.labelnr)) And
  1893. Not((hp.typ = ait_label) And
  1894. (LTable^[Tai_Label(hp).l^.labelnr-LoLab].RefsFound
  1895. = Tai_Label(hp).l^.RefCount) And
  1896. (LTable^[Tai_Label(hp).l^.labelnr-LoLab].JmpsProcessed > 0)) Do
  1897. Inc(Cnt);
  1898. If (hp.typ = ait_label)
  1899. Then
  1900. {there's a processed label after the current one}
  1901. Begin
  1902. CurProp^.regs := TaiPropBlock^[Cnt].Regs;
  1903. CurProp.DirFlag := TaiPropBlock^[Cnt].DirFlag;
  1904. End
  1905. Else
  1906. {there's no label anymore after the current one, or they haven't been
  1907. processed yet}
  1908. Begin
  1909. GetLastInstruction(p, hp);
  1910. CurProp^.regs := PTaiProp(hp.OptInfo)^.Regs;
  1911. CurProp.DirFlag := PTaiProp(hp.OptInfo)^.DirFlag;
  1912. DestroyAllRegs(PTaiProp(hp.OptInfo))
  1913. End
  1914. End
  1915. {$EndIf AnalyzeLoops}
  1916. Else
  1917. {not all references to this label have been found, so destroy all registers}
  1918. Begin
  1919. GetLastInstruction(p, hp);
  1920. CurProp^.regs := PTaiProp(hp.OptInfo)^.Regs;
  1921. CurProp.DirFlag := PTaiProp(hp.OptInfo)^.DirFlag;
  1922. DestroyAllRegs(CurProp)
  1923. End;
  1924. End;
  1925. {$EndIf JumpAnal}
  1926. {$ifdef GDB}
  1927. ait_stabs, ait_stabn, ait_stab_function_name:;
  1928. {$endif GDB}
  1929. ait_align: ; { may destroy flags !!! }
  1930. ait_instruction:
  1931. Begin
  1932. if Taicpu(p).is_jmp then
  1933. begin
  1934. {$IfNDef JumpAnal}
  1935. for tmpReg := R_EAX to R_EDI do
  1936. with curProp^.regs[tmpReg] do
  1937. case typ of
  1938. con_ref: typ := con_noRemoveRef;
  1939. con_const: typ := con_noRemoveConst;
  1940. con_invalid: typ := con_unknown;
  1941. end;
  1942. {$Else JumpAnal}
  1943. With LTable^[tasmlabel(Taicpu(p).oper[0].sym).labelnr-LoLab] Do
  1944. If (RefsFound = tasmlabel(Taicpu(p).oper[0].sym).RefCount) Then
  1945. Begin
  1946. If (InstrCnt < InstrNr)
  1947. Then
  1948. {forward jump}
  1949. If (JmpsProcessed = 0) Then
  1950. {no jump to this label has been processed yet}
  1951. Begin
  1952. TaiPropBlock^[InstrNr].Regs := CurProp^.regs;
  1953. TaiPropBlock^[InstrNr].DirFlag := CurProp.DirFlag;
  1954. Inc(JmpsProcessed);
  1955. End
  1956. Else
  1957. Begin
  1958. For TmpReg := R_EAX to R_EDI Do
  1959. If (TaiPropBlock^[InstrNr].Regs[TmpReg].WState <>
  1960. CurProp^.regs[TmpReg].WState) Then
  1961. DestroyReg(@TaiPropBlock^[InstrNr], TmpReg, true);
  1962. Inc(JmpsProcessed);
  1963. End
  1964. {$ifdef AnalyzeLoops}
  1965. Else
  1966. { backward jump, a loop for example}
  1967. { If (JmpsProcessed > 0) Or
  1968. Not(GetLastInstruction(TaiObj, hp) And
  1969. (hp.typ = ait_labeled_instruction) And
  1970. (Taicpu_labeled(hp).opcode = A_JMP))
  1971. Then}
  1972. {instruction prior to label is not a jmp, or at least one jump to the label
  1973. has yet been processed}
  1974. Begin
  1975. Inc(JmpsProcessed);
  1976. For TmpReg := R_EAX to R_EDI Do
  1977. If (TaiPropBlock^[InstrNr].Regs[TmpReg].WState <>
  1978. CurProp^.regs[TmpReg].WState)
  1979. Then
  1980. Begin
  1981. TmpState := TaiPropBlock^[InstrNr].Regs[TmpReg].WState;
  1982. Cnt := InstrNr;
  1983. While (TmpState = TaiPropBlock^[Cnt].Regs[TmpReg].WState) Do
  1984. Begin
  1985. DestroyReg(@TaiPropBlock^[Cnt], TmpReg, true);
  1986. Inc(Cnt);
  1987. End;
  1988. While (Cnt <= InstrCnt) Do
  1989. Begin
  1990. Inc(TaiPropBlock^[Cnt].Regs[TmpReg].WState);
  1991. Inc(Cnt)
  1992. End
  1993. End;
  1994. End
  1995. { Else }
  1996. {instruction prior to label is a jmp and no jumps to the label have yet been
  1997. processed}
  1998. { Begin
  1999. Inc(JmpsProcessed);
  2000. For TmpReg := R_EAX to R_EDI Do
  2001. Begin
  2002. TmpState := TaiPropBlock^[InstrNr].Regs[TmpReg].WState;
  2003. Cnt := InstrNr;
  2004. While (TmpState = TaiPropBlock^[Cnt].Regs[TmpReg].WState) Do
  2005. Begin
  2006. TaiPropBlock^[Cnt].Regs[TmpReg] := CurProp^.regs[TmpReg];
  2007. Inc(Cnt);
  2008. End;
  2009. TmpState := TaiPropBlock^[InstrNr].Regs[TmpReg].WState;
  2010. While (TmpState = TaiPropBlock^[Cnt].Regs[TmpReg].WState) Do
  2011. Begin
  2012. DestroyReg(@TaiPropBlock^[Cnt], TmpReg, true);
  2013. Inc(Cnt);
  2014. End;
  2015. While (Cnt <= InstrCnt) Do
  2016. Begin
  2017. Inc(TaiPropBlock^[Cnt].Regs[TmpReg].WState);
  2018. Inc(Cnt)
  2019. End
  2020. End
  2021. End}
  2022. {$endif AnalyzeLoops}
  2023. End;
  2024. {$EndIf JumpAnal}
  2025. end
  2026. else
  2027. begin
  2028. InstrProp := InsProp[Taicpu(p).opcode];
  2029. Case Taicpu(p).opcode Of
  2030. A_MOV, A_MOVZX, A_MOVSX:
  2031. Begin
  2032. Case Taicpu(p).oper[0].typ Of
  2033. top_ref, top_reg:
  2034. case Taicpu(p).oper[1].typ Of
  2035. top_reg:
  2036. Begin
  2037. {$ifdef statedebug}
  2038. hp := Tai_asm_comment.Create(strpnew('destroying '+
  2039. att_reg2str[Taicpu(p).oper[1].reg])));
  2040. insertllitem(asml,p,p.next,hp);
  2041. {$endif statedebug}
  2042. readOp(curprop, Taicpu(p).oper[0]);
  2043. tmpreg := reg32(Taicpu(p).oper[1].reg);
  2044. if regInOp(tmpreg, Taicpu(p).oper[0]) and
  2045. (curProp^.regs[tmpReg].typ in [con_ref,con_noRemoveRef]) then
  2046. begin
  2047. with curprop^.regs[tmpreg] Do
  2048. begin
  2049. incState(wstate,1);
  2050. { also store how many instructions are part of the sequence in the first }
  2051. { instruction's PTaiProp, so it can be easily accessed from within }
  2052. { CheckSequence }
  2053. inc(nrOfMods, nrOfInstrSinceLastMod[tmpreg]);
  2054. pTaiprop(startmod.optinfo)^.regs[tmpreg].nrOfMods := nrOfMods;
  2055. nrOfInstrSinceLastMod[tmpreg] := 0;
  2056. { Destroy the contents of the registers }
  2057. { that depended on the previous value of }
  2058. { this register }
  2059. invalidateDependingRegs(curprop,tmpreg);
  2060. end;
  2061. end
  2062. else
  2063. begin
  2064. {$ifdef statedebug}
  2065. hp := Tai_asm_comment.Create(strpnew('destroying & initing '+att_reg2str[tmpreg]));
  2066. insertllitem(asml,p,p.next,hp);
  2067. {$endif statedebug}
  2068. destroyReg(curprop, tmpreg, true);
  2069. if not(reginop(tmpreg, Taicpu(p).oper[0])) then
  2070. with curprop^.regs[tmpreg] Do
  2071. begin
  2072. typ := con_ref;
  2073. startmod := p;
  2074. nrOfMods := 1;
  2075. end
  2076. end;
  2077. {$ifdef StateDebug}
  2078. hp := Tai_asm_comment.Create(strpnew(att_reg2str[TmpReg]+': '+tostr(CurProp^.regs[TmpReg].WState)));
  2079. InsertLLItem(AsmL, p, p.next, hp);
  2080. {$endif StateDebug}
  2081. End;
  2082. Top_Ref:
  2083. { can only be if oper[0] = top_reg }
  2084. Begin
  2085. ReadReg(CurProp, Taicpu(p).oper[0].reg);
  2086. ReadRef(CurProp, Taicpu(p).oper[1].ref);
  2087. DestroyRefs(p, Taicpu(p).oper[1].ref^, Taicpu(p).oper[0].reg);
  2088. End;
  2089. End;
  2090. top_symbol,Top_Const:
  2091. Begin
  2092. Case Taicpu(p).oper[1].typ Of
  2093. Top_Reg:
  2094. Begin
  2095. TmpReg := Reg32(Taicpu(p).oper[1].reg);
  2096. {$ifdef statedebug}
  2097. hp := Tai_asm_comment.Create(strpnew('destroying '+att_reg2str[tmpreg]));
  2098. insertllitem(asml,p,p.next,hp);
  2099. {$endif statedebug}
  2100. With CurProp^.regs[TmpReg] Do
  2101. Begin
  2102. DestroyReg(CurProp, TmpReg, true);
  2103. typ := Con_Const;
  2104. StartMod := p;
  2105. End
  2106. End;
  2107. Top_Ref:
  2108. Begin
  2109. ReadRef(CurProp, Taicpu(p).oper[1].ref);
  2110. DestroyRefs(P, Taicpu(p).oper[1].ref^, R_NO);
  2111. End;
  2112. End;
  2113. End;
  2114. End;
  2115. End;
  2116. A_DIV, A_IDIV, A_MUL:
  2117. Begin
  2118. ReadOp(Curprop, Taicpu(p).oper[0]);
  2119. ReadReg(CurProp,R_EAX);
  2120. If (Taicpu(p).OpCode = A_IDIV) or
  2121. (Taicpu(p).OpCode = A_DIV) Then
  2122. ReadReg(CurProp,R_EDX);
  2123. {$ifdef statedebug}
  2124. hp := Tai_asm_comment.Create(strpnew('destroying eax and edx'));
  2125. insertllitem(asml,p,p.next,hp);
  2126. {$endif statedebug}
  2127. { DestroyReg(CurProp, R_EAX, true);}
  2128. AddInstr2RegContents({$ifdef statedebug}asml,{$endif}
  2129. Taicpu(p), R_EAX);
  2130. DestroyReg(CurProp, R_EDX, true)
  2131. End;
  2132. A_IMUL:
  2133. Begin
  2134. ReadOp(CurProp,Taicpu(p).oper[0]);
  2135. ReadOp(CurProp,Taicpu(p).oper[1]);
  2136. If (Taicpu(p).oper[2].typ = top_none) Then
  2137. If (Taicpu(p).oper[1].typ = top_none) Then
  2138. Begin
  2139. ReadReg(CurProp,R_EAX);
  2140. {$ifdef statedebug}
  2141. hp := Tai_asm_comment.Create(strpnew('destroying eax and edx'));
  2142. insertllitem(asml,p,p.next,hp);
  2143. {$endif statedebug}
  2144. { DestroyReg(CurProp, R_EAX, true); }
  2145. AddInstr2RegContents({$ifdef statedebug}asml,{$endif}
  2146. Taicpu(p), R_EAX);
  2147. DestroyReg(CurProp, R_EDX, true)
  2148. End
  2149. Else
  2150. AddInstr2OpContents(
  2151. {$ifdef statedebug}asml,{$endif}
  2152. Taicpu(p), Taicpu(p).oper[1])
  2153. Else
  2154. AddInstr2OpContents({$ifdef statedebug}asml,{$endif}
  2155. Taicpu(p), Taicpu(p).oper[2]);
  2156. End;
  2157. A_LEA:
  2158. begin
  2159. readop(curprop,Taicpu(p).oper[0]);
  2160. if reginref(Taicpu(p).oper[1].reg,Taicpu(p).oper[0].ref^) then
  2161. AddInstr2RegContents({$ifdef statedebug}asml,{$endif}
  2162. Taicpu(p), Taicpu(p).oper[1].reg)
  2163. else
  2164. begin
  2165. {$ifdef statedebug}
  2166. hp := Tai_asm_comment.Create(strpnew('destroying & initing'+
  2167. att_reg2str[Taicpu(p).oper[1].reg])));
  2168. insertllitem(asml,p,p.next,hp);
  2169. {$endif statedebug}
  2170. destroyreg(curprop,Taicpu(p).oper[1].reg,true);
  2171. with curprop^.regs[Taicpu(p).oper[1].reg] Do
  2172. begin
  2173. typ := con_ref;
  2174. startmod := p;
  2175. nrOfMods := 1;
  2176. end
  2177. end;
  2178. end;
  2179. Else
  2180. Begin
  2181. Cnt := 1;
  2182. While (Cnt <= MaxCh) And
  2183. (InstrProp.Ch[Cnt] <> Ch_None) Do
  2184. Begin
  2185. Case InstrProp.Ch[Cnt] Of
  2186. Ch_REAX..Ch_REDI: ReadReg(CurProp,TCh2Reg(InstrProp.Ch[Cnt]));
  2187. Ch_WEAX..Ch_RWEDI:
  2188. Begin
  2189. If (InstrProp.Ch[Cnt] >= Ch_RWEAX) Then
  2190. ReadReg(CurProp, TCh2Reg(InstrProp.Ch[Cnt]));
  2191. {$ifdef statedebug}
  2192. hp := Tai_asm_comment.Create(strpnew('destroying '+
  2193. att_reg2str[TCh2Reg(InstrProp.Ch[Cnt])])));
  2194. insertllitem(asml,p,p.next,hp);
  2195. {$endif statedebug}
  2196. DestroyReg(CurProp, TCh2Reg(InstrProp.Ch[Cnt]), true);
  2197. End;
  2198. Ch_MEAX..Ch_MEDI:
  2199. AddInstr2RegContents({$ifdef statedebug} asml,{$endif}
  2200. Taicpu(p),TCh2Reg(InstrProp.Ch[Cnt]));
  2201. Ch_CDirFlag: CurProp^.DirFlag := F_NotSet;
  2202. Ch_SDirFlag: CurProp^.DirFlag := F_Set;
  2203. Ch_Rop1: ReadOp(CurProp, Taicpu(p).oper[0]);
  2204. Ch_Rop2: ReadOp(CurProp, Taicpu(p).oper[1]);
  2205. Ch_ROp3: ReadOp(CurProp, Taicpu(p).oper[2]);
  2206. Ch_Wop1..Ch_RWop1:
  2207. Begin
  2208. If (InstrProp.Ch[Cnt] in [Ch_RWop1]) Then
  2209. ReadOp(CurProp, Taicpu(p).oper[0]);
  2210. DestroyOp(p, Taicpu(p).oper[0]);
  2211. End;
  2212. Ch_Mop1:
  2213. AddInstr2OpContents({$ifdef statedebug} asml, {$endif}
  2214. Taicpu(p), Taicpu(p).oper[0]);
  2215. Ch_Wop2..Ch_RWop2:
  2216. Begin
  2217. If (InstrProp.Ch[Cnt] = Ch_RWop2) Then
  2218. ReadOp(CurProp, Taicpu(p).oper[1]);
  2219. DestroyOp(p, Taicpu(p).oper[1]);
  2220. End;
  2221. Ch_Mop2:
  2222. AddInstr2OpContents({$ifdef statedebug} asml, {$endif}
  2223. Taicpu(p), Taicpu(p).oper[1]);
  2224. Ch_WOp3..Ch_RWOp3:
  2225. Begin
  2226. If (InstrProp.Ch[Cnt] = Ch_RWOp3) Then
  2227. ReadOp(CurProp, Taicpu(p).oper[2]);
  2228. DestroyOp(p, Taicpu(p).oper[2]);
  2229. End;
  2230. Ch_Mop3:
  2231. AddInstr2OpContents({$ifdef statedebug} asml, {$endif}
  2232. Taicpu(p), Taicpu(p).oper[2]);
  2233. Ch_WMemEDI:
  2234. Begin
  2235. ReadReg(CurProp, R_EDI);
  2236. FillChar(TmpRef, SizeOf(TmpRef), 0);
  2237. TmpRef.Base := R_EDI;
  2238. tmpRef.index := R_EDI;
  2239. DestroyRefs(p, TmpRef, R_NO)
  2240. End;
  2241. Ch_RFlags:
  2242. if assigned(LastFlagsChangeProp) then
  2243. LastFlagsChangeProp^.FlagsUsed := true;
  2244. Ch_WFlags:
  2245. LastFlagsChangeProp := CurProp;
  2246. Ch_RWFlags:
  2247. begin
  2248. if assigned(LastFlagsChangeProp) then
  2249. LastFlagsChangeProp^.FlagsUsed := true;
  2250. LastFlagsChangeProp := CurProp;
  2251. end;
  2252. Ch_FPU:;
  2253. Else
  2254. Begin
  2255. {$ifdef statedebug}
  2256. hp := Tai_asm_comment.Create(strpnew(
  2257. 'destroying all regs for prev instruction')));
  2258. insertllitem(asml,p, p.next,hp);
  2259. {$endif statedebug}
  2260. DestroyAllRegs(CurProp);
  2261. LastFlagsChangeProp := CurProp;
  2262. End;
  2263. End;
  2264. Inc(Cnt);
  2265. End
  2266. End;
  2267. end;
  2268. End;
  2269. End
  2270. Else
  2271. Begin
  2272. {$ifdef statedebug}
  2273. hp := Tai_asm_comment.Create(strpnew(
  2274. 'destroying all regs: unknown Tai: '+tostr(ord(p.typ)))));
  2275. insertllitem(asml,p, p.next,hp);
  2276. {$endif statedebug}
  2277. DestroyAllRegs(CurProp);
  2278. End;
  2279. End;
  2280. Inc(InstrCnt);
  2281. prev := p;
  2282. GetNextInstruction(p, p);
  2283. End;
  2284. End;
  2285. Function InitDFAPass2(BlockStart, BlockEnd: Tai): Boolean;
  2286. {reserves memory for the PTaiProps in one big memory block when not using
  2287. TP, returns False if not enough memory is available for the optimizer in all
  2288. cases}
  2289. Var p: Tai;
  2290. Count: Longint;
  2291. { TmpStr: String; }
  2292. Begin
  2293. P := BlockStart;
  2294. SkipHead(P);
  2295. NrOfTaiObjs := 0;
  2296. While (P <> BlockEnd) Do
  2297. Begin
  2298. {$IfDef JumpAnal}
  2299. Case p.Typ Of
  2300. ait_label:
  2301. Begin
  2302. If not labelCanBeSkipped(Tai_label(p)) Then
  2303. LTable^[Tai_Label(p).l^.labelnr-LoLab].InstrNr := NrOfTaiObjs
  2304. End;
  2305. ait_instruction:
  2306. begin
  2307. if Taicpu(p).is_jmp then
  2308. begin
  2309. If (tasmlabel(Taicpu(p).oper[0].sym).labelnr >= LoLab) And
  2310. (tasmlabel(Taicpu(p).oper[0].sym).labelnr <= HiLab) Then
  2311. Inc(LTable^[tasmlabel(Taicpu(p).oper[0].sym).labelnr-LoLab].RefsFound);
  2312. end;
  2313. end;
  2314. { ait_instruction:
  2315. Begin
  2316. If (Taicpu(p).opcode = A_PUSH) And
  2317. (Taicpu(p).oper[0].typ = top_symbol) And
  2318. (PCSymbol(Taicpu(p).oper[0])^.offset = 0) Then
  2319. Begin
  2320. TmpStr := StrPas(PCSymbol(Taicpu(p).oper[0])^.symbol);
  2321. If}
  2322. End;
  2323. {$EndIf JumpAnal}
  2324. Inc(NrOfTaiObjs);
  2325. GetNextInstruction(p, p);
  2326. End;
  2327. {Uncomment the next line to see how much memory the reloading optimizer needs}
  2328. { Writeln(NrOfTaiObjs*SizeOf(TTaiProp));}
  2329. {no need to check mem/maxavail, we've got as much virtual memory as we want}
  2330. If NrOfTaiObjs <> 0 Then
  2331. Begin
  2332. InitDFAPass2 := True;
  2333. GetMem(TaiPropBlock, NrOfTaiObjs*SizeOf(TTaiProp));
  2334. fillchar(TaiPropBlock^,NrOfTaiObjs*SizeOf(TTaiProp),0);
  2335. p := BlockStart;
  2336. SkipHead(p);
  2337. For Count := 1 To NrOfTaiObjs Do
  2338. Begin
  2339. PTaiProp(p.OptInfo) := @TaiPropBlock^[Count];
  2340. GetNextInstruction(p, p);
  2341. End;
  2342. End
  2343. Else InitDFAPass2 := False;
  2344. End;
  2345. Function DFAPass2(
  2346. {$ifdef statedebug}
  2347. AsmL: TAAsmOutPut;
  2348. {$endif statedebug}
  2349. BlockStart, BlockEnd: Tai): Boolean;
  2350. Begin
  2351. If InitDFAPass2(BlockStart, BlockEnd) Then
  2352. Begin
  2353. DoDFAPass2(
  2354. {$ifdef statedebug}
  2355. asml,
  2356. {$endif statedebug}
  2357. BlockStart, BlockEnd);
  2358. DFAPass2 := True
  2359. End
  2360. Else DFAPass2 := False;
  2361. End;
  2362. Procedure ShutDownDFA;
  2363. Begin
  2364. If LabDif <> 0 Then
  2365. FreeMem(LTable, LabDif*SizeOf(TLabelTableItem));
  2366. End;
  2367. End.
  2368. {
  2369. $Log$
  2370. Revision 1.21 2001-09-04 14:01:04 jonas
  2371. * commented out some inactive code in csopt386
  2372. + small improvement: lea is now handled the same as mov/zx/sx
  2373. Revision 1.20 2001/08/29 14:07:43 jonas
  2374. * the optimizer now keeps track of flags register usage. This fixes some
  2375. optimizer bugs with int64 calculations (because of the carry flag usage)
  2376. * fixed another bug which caused wrong optimizations with complex
  2377. array expressions
  2378. Revision 1.19 2001/08/26 13:36:55 florian
  2379. * some cg reorganisation
  2380. * some PPC updates
  2381. Revision 1.18 2001/08/06 21:40:50 peter
  2382. * funcret moved from tprocinfo to tprocdef
  2383. Revision 1.17 2001/04/13 01:22:18 peter
  2384. * symtable change to classes
  2385. * range check generation and errors fixed, make cycle DEBUG=1 works
  2386. * memory leaks fixed
  2387. Revision 1.16 2001/04/02 21:20:36 peter
  2388. * resulttype rewrite
  2389. Revision 1.15 2000/12/31 11:00:31 jonas
  2390. * fixed potential bug in writeToMemDestroysContents
  2391. Revision 1.14 2000/12/25 00:07:32 peter
  2392. + new tlinkedlist class (merge of old tstringqueue,tcontainer and
  2393. tlinkedlist objects)
  2394. Revision 1.13 2000/12/21 12:22:53 jonas
  2395. * fixed range error
  2396. Revision 1.12 2000/12/04 17:00:09 jonas
  2397. * invalidate regs that depend on a modified register
  2398. Revision 1.11 2000/11/29 00:30:44 florian
  2399. * unused units removed from uses clause
  2400. * some changes for widestrings
  2401. Revision 1.10 2000/11/28 16:32:11 jonas
  2402. + support for optimizing simple sequences with div/idiv/mul opcodes
  2403. Revision 1.9 2000/11/23 14:20:18 jonas
  2404. * fixed stupid bug in previous commit
  2405. Revision 1.8 2000/11/23 13:26:33 jonas
  2406. * fix for webbug 1066/1126
  2407. Revision 1.7 2000/11/17 15:22:04 jonas
  2408. * fixed another bug in allocregbetween (introduced by the previous fix)
  2409. ("merged")
  2410. Revision 1.6 2000/11/14 13:26:10 jonas
  2411. * fixed bug in allocregbetween
  2412. Revision 1.5 2000/11/08 16:04:34 sg
  2413. * Fix for containsPointerRef: Loop now runs in the correct range
  2414. Revision 1.4 2000/11/03 18:06:26 jonas
  2415. * fixed bug in arrayRefsEq
  2416. * object/class fields are now handled the same as local/global vars and
  2417. parameters (ie. a write to a local var can now never destroy a class
  2418. field)
  2419. Revision 1.3 2000/10/24 10:40:53 jonas
  2420. + register renaming ("fixes" bug1088)
  2421. * changed command line options meanings for optimizer:
  2422. O2 now means peepholopts, CSE and register renaming in 1 pass
  2423. O3 is the same, but repeated until no further optimizations are
  2424. possible or until 5 passes have been done (to avoid endless loops)
  2425. * changed aopt386 so it does this looping
  2426. * added some procedures from csopt386 to the interface because they're
  2427. used by rropt386 as well
  2428. * some changes to csopt386 and daopt386 so that newly added instructions
  2429. by the CSE get optimizer info (they were simply skipped previously),
  2430. this fixes some bugs
  2431. Revision 1.2 2000/10/19 15:59:40 jonas
  2432. * fixed bug in allocregbetween (the register wasn't added to the
  2433. usedregs set of the last instruction of the chain) ("merged")
  2434. Revision 1.1 2000/10/15 09:47:43 peter
  2435. * moved to i386/
  2436. Revision 1.16 2000/10/14 10:14:47 peter
  2437. * moehrendorf oct 2000 rewrite
  2438. Revision 1.15 2000/09/30 13:07:23 jonas
  2439. * fixed support for -Or with new features of CSE
  2440. Revision 1.14 2000/09/29 23:14:11 jonas
  2441. + writeToMemDestroysContents() and writeDestroysContents() to support the
  2442. new features of the CSE
  2443. Revision 1.13 2000/09/25 09:50:30 jonas
  2444. - removed TP conditional code
  2445. Revision 1.12 2000/09/24 21:19:50 peter
  2446. * delphi compile fixes
  2447. Revision 1.11 2000/09/24 15:06:15 peter
  2448. * use defines.inc
  2449. Revision 1.10 2000/09/22 15:00:20 jonas
  2450. * fixed bug in regsEquivalent (in some rare cases, registers with
  2451. completely unrelated content were considered equivalent) (merged
  2452. from fixes branch)
  2453. Revision 1.9 2000/09/20 15:00:58 jonas
  2454. + much improved CSE: the CSE now searches further back for sequences it
  2455. can reuse. After I've also implemented register renaming, the effect
  2456. should be even better (afaik web bug 1088 will then even be optimized
  2457. properly). I don't know about the slow down factor this adds. Maybe
  2458. a new optimization level should be introduced?
  2459. Revision 1.8 2000/08/25 19:39:18 jonas
  2460. * bugfix to FindRegAlloc function (caused wrong regalloc info in
  2461. some cases) (merged from fixes branch)
  2462. Revision 1.7 2000/08/23 12:55:10 jonas
  2463. * fix for web bug 1112 and a bit of clean up in csopt386 (merged from
  2464. fixes branch)
  2465. Revision 1.6 2000/08/19 17:53:29 jonas
  2466. * fixed a potential bug in destroyregs regarding the removal of
  2467. unused loads
  2468. * added destroyDependingRegs() procedure and use it for the fix in
  2469. the previous commit (safer/more complete than what was done before)
  2470. Revision 1.5 2000/08/19 09:08:59 jonas
  2471. * fixed bug where the contents of a register would not be destroyed
  2472. if another register on which these contents depend is modified
  2473. (not really merged, but same idea as fix in fixes branch,
  2474. LAST_MERGE tag is updated)
  2475. Revision 1.4 2000/07/21 15:19:54 jonas
  2476. * daopt386: changes to getnextinstruction/getlastinstruction so they
  2477. ignore labels who have is_addr set
  2478. + daopt386/csopt386: remove loads of registers which are overwritten
  2479. before their contents are used (especially usefull for removing superfluous
  2480. maybe_loadself outputs and push/pops transformed by below optimization
  2481. + popt386: transform pop/pop/pop/.../push/push/push to sequences of
  2482. 'movl x(%esp),%reg' (only active when compiling a go32v2 compiler
  2483. currently because I don't know whether it's safe to do this under Win32/
  2484. Linux (because of problems we had when using esp as frame pointer on
  2485. those os'es)
  2486. Revision 1.3 2000/07/14 05:11:48 michael
  2487. + Patch to 1.1
  2488. Revision 1.2 2000/07/13 11:32:40 michael
  2489. + removed logs
  2490. }