daopt386.pas 86 KB

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