daopt386.pas 90 KB

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