daopt386.pas 71 KB

12345678910111213141516171819202122232425262728293031323334353637383940414243444546474849505152535455565758596061626364656667686970717273747576777879808182838485868788899091929394959697989910010110210310410510610710810911011111211311411511611711811912012112212312412512612712812913013113213313413513613713813914014114214314414514614714814915015115215315415515615715815916016116216316416516616716816917017117217317417517617717817918018118218318418518618718818919019119219319419519619719819920020120220320420520620720820921021121221321421521621721821922022122222322422522622722822923023123223323423523623723823924024124224324424524624724824925025125225325425525625725825926026126226326426526626726826927027127227327427527627727827928028128228328428528628728828929029129229329429529629729829930030130230330430530630730830931031131231331431531631731831932032132232332432532632732832933033133233333433533633733833934034134234334434534634734834935035135235335435535635735835936036136236336436536636736836937037137237337437537637737837938038138238338438538638738838939039139239339439539639739839940040140240340440540640740840941041141241341441541641741841942042142242342442542642742842943043143243343443543643743843944044144244344444544644744844945045145245345445545645745845946046146246346446546646746846947047147247347447547647747847948048148248348448548648748848949049149249349449549649749849950050150250350450550650750850951051151251351451551651751851952052152252352452552652752852953053153253353453553653753853954054154254354454554654754854955055155255355455555655755855956056156256356456556656756856957057157257357457557657757857958058158258358458558658758858959059159259359459559659759859960060160260360460560660760860961061161261361461561661761861962062162262362462562662762862963063163263363463563663763863964064164264364464564664764864965065165265365465565665765865966066166266366466566666766866967067167267367467567667767867968068168268368468568668768868969069169269369469569669769869970070170270370470570670770870971071171271371471571671771871972072172272372472572672772872973073173273373473573673773873974074174274374474574674774874975075175275375475575675775875976076176276376476576676776876977077177277377477577677777877978078178278378478578678778878979079179279379479579679779879980080180280380480580680780880981081181281381481581681781881982082182282382482582682782882983083183283383483583683783883984084184284384484584684784884985085185285385485585685785885986086186286386486586686786886987087187287387487587687787887988088188288388488588688788888989089189289389489589689789889990090190290390490590690790890991091191291391491591691791891992092192292392492592692792892993093193293393493593693793893994094194294394494594694794894995095195295395495595695795895996096196296396496596696796896997097197297397497597697797897998098198298398498598698798898999099199299399499599699799899910001001100210031004100510061007100810091010101110121013101410151016101710181019102010211022102310241025102610271028102910301031103210331034103510361037103810391040104110421043104410451046104710481049105010511052105310541055105610571058105910601061106210631064106510661067106810691070107110721073107410751076107710781079108010811082108310841085108610871088108910901091109210931094109510961097109810991100110111021103110411051106110711081109111011111112111311141115111611171118111911201121112211231124112511261127112811291130113111321133113411351136113711381139114011411142114311441145114611471148114911501151115211531154115511561157115811591160116111621163116411651166116711681169117011711172117311741175117611771178117911801181118211831184118511861187118811891190119111921193119411951196119711981199120012011202120312041205120612071208120912101211121212131214121512161217121812191220122112221223122412251226122712281229123012311232123312341235123612371238123912401241124212431244124512461247124812491250125112521253125412551256125712581259126012611262126312641265126612671268126912701271127212731274127512761277127812791280128112821283128412851286128712881289129012911292129312941295129612971298129913001301130213031304130513061307130813091310131113121313131413151316131713181319132013211322132313241325132613271328132913301331133213331334133513361337133813391340134113421343134413451346134713481349135013511352135313541355135613571358135913601361136213631364136513661367136813691370137113721373137413751376137713781379138013811382138313841385138613871388138913901391139213931394139513961397139813991400140114021403140414051406140714081409141014111412141314141415141614171418141914201421142214231424142514261427142814291430143114321433143414351436143714381439144014411442144314441445144614471448144914501451145214531454145514561457145814591460146114621463146414651466146714681469147014711472147314741475147614771478147914801481148214831484148514861487148814891490149114921493149414951496149714981499150015011502150315041505150615071508150915101511151215131514151515161517151815191520152115221523152415251526152715281529153015311532153315341535153615371538153915401541154215431544154515461547154815491550155115521553155415551556155715581559156015611562156315641565156615671568156915701571157215731574157515761577157815791580158115821583158415851586158715881589159015911592159315941595159615971598159916001601160216031604160516061607160816091610161116121613161416151616161716181619162016211622162316241625162616271628162916301631163216331634163516361637163816391640164116421643164416451646164716481649165016511652165316541655165616571658165916601661166216631664166516661667166816691670167116721673167416751676167716781679168016811682168316841685168616871688168916901691169216931694169516961697169816991700170117021703170417051706170717081709171017111712171317141715171617171718171917201721172217231724172517261727172817291730173117321733173417351736173717381739174017411742174317441745174617471748174917501751175217531754175517561757175817591760176117621763176417651766176717681769177017711772177317741775177617771778177917801781178217831784178517861787178817891790179117921793179417951796179717981799180018011802180318041805180618071808180918101811181218131814181518161817181818191820182118221823182418251826182718281829183018311832183318341835183618371838183918401841184218431844184518461847184818491850185118521853185418551856185718581859186018611862186318641865186618671868186918701871187218731874187518761877187818791880188118821883188418851886188718881889189018911892189318941895189618971898189919001901190219031904190519061907190819091910191119121913191419151916191719181919192019211922192319241925192619271928192919301931193219331934193519361937193819391940194119421943194419451946194719481949195019511952195319541955195619571958195919601961196219631964196519661967196819691970197119721973197419751976197719781979198019811982198319841985198619871988198919901991199219931994199519961997199819992000200120022003200420052006200720082009201020112012201320142015201620172018201920202021202220232024202520262027202820292030
  1. {
  2. $Id$
  3. Copyright (c) 1998-2000 by Jonas Maebe
  4. This unit contains the data flow analyzer and several helper procedures
  5. and functions.
  6. This program is free software; you can redistribute it and/or modify
  7. it under the terms of the GNU General Public License as published by
  8. the Free Software Foundation; either version 2 of the License, or
  9. (at your option) any later version.
  10. This program is distributed in the hope that it will be useful,
  11. but WITHOUT ANY WARRANTY; without even the implied warranty of
  12. MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
  13. GNU General Public License for more details.
  14. You should have received a copy of the GNU General Public License
  15. along with this program; if not, write to the Free Software
  16. Foundation, Inc., 675 Mass Ave, Cambridge, MA 02139, USA.
  17. ****************************************************************************
  18. }
  19. {$ifDef TP}
  20. {$UnDef JumpAnal}
  21. {$Endif TP}
  22. Unit DAOpt386;
  23. {$ifdef newOptimizations}
  24. {$define foropt}
  25. {$define replacereg}
  26. {$define arithopt}
  27. {$define foldarithops}
  28. {$endif newOptimizations}
  29. Interface
  30. Uses
  31. GlobType,
  32. CObjects,Aasm,
  33. cpubase,cpuasm;
  34. Type
  35. TRegArray = Array[R_EAX..R_BL] of TRegister;
  36. TRegSet = Set of R_EAX..R_BL;
  37. TRegInfo = Record
  38. NewRegsEncountered, OldRegsEncountered: TRegSet;
  39. RegsLoadedForRef: TRegSet;
  40. New2OldReg: TRegArray;
  41. End;
  42. {possible actions on an operand: read, write or modify (= read & write)}
  43. TOpAction = (OpAct_Read, OpAct_Write, OpAct_Modify, OpAct_Unknown);
  44. {*********************** Procedures and Functions ************************}
  45. Procedure InsertLLItem(AsmL: PAasmOutput; prev, foll, new_one: PLinkedList_Item);
  46. Function Reg32(Reg: TRegister): TRegister;
  47. Function RefsEquivalent(Const R1, R2: TReference; Var RegInfo: TRegInfo; OpAct: TOpAction): Boolean;
  48. Function RefsEqual(Const R1, R2: TReference): Boolean;
  49. Function IsGP32Reg(Reg: TRegister): Boolean;
  50. Function RegInRef(Reg: TRegister; Const Ref: TReference): Boolean;
  51. Function RegInInstruction(Reg: TRegister; p1: Pai): Boolean;
  52. Function RegModifiedByInstruction(Reg: TRegister; p1: Pai): Boolean;
  53. Function GetNextInstruction(Current: Pai; Var Next: Pai): Boolean;
  54. Function GetLastInstruction(Current: Pai; Var Last: Pai): Boolean;
  55. Procedure SkipHead(var P: Pai);
  56. Procedure UpdateUsedRegs(Var UsedRegs: TRegSet; p: Pai);
  57. Function RegsEquivalent(OldReg, NewReg: TRegister; Var RegInfo: TRegInfo; OpAct: TopAction): Boolean;
  58. Function InstructionsEquivalent(p1, p2: Pai; Var RegInfo: TRegInfo): Boolean;
  59. Function OpsEqual(const o1,o2:toper): Boolean;
  60. Function DFAPass1(AsmL: PAasmOutput; BlockStart: Pai): Pai;
  61. Function DFAPass2(
  62. {$ifdef statedebug}
  63. AsmL: PAasmOutPut;
  64. {$endif statedebug}
  65. BlockStart, BlockEnd: Pai): Boolean;
  66. Procedure ShutDownDFA;
  67. Function FindLabel(L: PasmLabel; Var hp: Pai): Boolean;
  68. {******************************* Constants *******************************}
  69. Const
  70. {ait_* types which don't result in executable code or which don't influence
  71. the way the program runs/behaves}
  72. SkipInstr = [ait_comment, ait_symbol
  73. {$ifdef GDB}
  74. ,ait_stabs, ait_stabn, ait_stab_function_name
  75. {$endif GDB}
  76. {$ifndef alignreg}
  77. ,ait_align
  78. {$endif alignreg}
  79. ,ait_regalloc, ait_tempalloc
  80. ];
  81. {Possible register content types}
  82. con_Unknown = 0;
  83. con_ref = 1;
  84. con_const = 2;
  85. {********************************* Types *********************************}
  86. type
  87. {the possible states of a flag}
  88. TFlagContents = (F_Unknown, F_NotSet, F_Set);
  89. TContent = Packed Record
  90. {start and end of block instructions that defines the
  91. content of this register.}
  92. StartMod: pai;
  93. {starts at 0, gets increased everytime the register is written to}
  94. WState: Byte;
  95. {starts at 0, gets increased everytime the register is read from}
  96. RState: Byte;
  97. {how many instructions starting with StarMod does the block consist of}
  98. NrOfMods: Byte;
  99. {the type of the content of the register: unknown, memory, constant}
  100. Typ: Byte;
  101. End;
  102. {Contents of the integer registers}
  103. TRegContent = Array[R_EAX..R_EDI] Of TContent;
  104. {contents of the FPU registers}
  105. TRegFPUContent = Array[R_ST..R_ST7] Of TContent;
  106. {information record with the contents of every register. Every Pai object
  107. gets one of these assigned: a pointer to it is stored in the OptInfo field}
  108. TPaiProp = Record
  109. Regs: TRegContent;
  110. { FPURegs: TRegFPUContent;} {currently not yet used}
  111. {allocated Registers}
  112. UsedRegs: TRegSet;
  113. {status of the direction flag}
  114. DirFlag: TFlagContents;
  115. {can this instruction be removed?}
  116. CanBeRemoved: Boolean;
  117. End;
  118. PPaiProp = ^TPaiProp;
  119. {$IfNDef TP}
  120. TPaiPropBlock = Array[1..250000] Of TPaiProp;
  121. PPaiPropBlock = ^TPaiPropBlock;
  122. {$EndIf TP}
  123. TInstrSinceLastMod = Array[R_EAX..R_EDI] Of Byte;
  124. TLabelTableItem = Record
  125. PaiObj: Pai;
  126. {$IfDef JumpAnal}
  127. InstrNr: Longint;
  128. RefsFound: Word;
  129. JmpsProcessed: Word
  130. {$EndIf JumpAnal}
  131. End;
  132. {$IfDef tp}
  133. TLabelTable = Array[0..10000] Of TLabelTableItem;
  134. {$Else tp}
  135. TLabelTable = Array[0..2500000] Of TLabelTableItem;
  136. {$Endif tp}
  137. PLabelTable = ^TLabelTable;
  138. {******************************* Variables *******************************}
  139. Var
  140. {the amount of PaiObjects in the current assembler list}
  141. NrOfPaiObjs: Longint;
  142. {$IfNDef TP}
  143. {Array which holds all TPaiProps}
  144. PaiPropBlock: PPaiPropBlock;
  145. {$EndIf TP}
  146. LoLab, HiLab, LabDif: Longint;
  147. LTable: PLabelTable;
  148. {*********************** End of Interface section ************************}
  149. Implementation
  150. Uses
  151. globals, systems, strings, verbose, hcodegen;
  152. Type
  153. TRefCompare = function(const r1, r2: TReference): Boolean;
  154. Var
  155. {How many instructions are between the current instruction and the last one
  156. that modified the register}
  157. NrOfInstrSinceLastMod: TInstrSinceLastMod;
  158. {************************ Create the Label table ************************}
  159. Function FindLoHiLabels(Var LowLabel, HighLabel, LabelDif: Longint; BlockStart: Pai): Pai;
  160. {Walks through the paasmlist to find the lowest and highest label number}
  161. Var LabelFound: Boolean;
  162. P: Pai;
  163. Begin
  164. LabelFound := False;
  165. LowLabel := MaxLongint;
  166. HighLabel := 0;
  167. P := BlockStart;
  168. While Assigned(P) And
  169. ((P^.typ <> Ait_Marker) Or
  170. (Pai_Marker(P)^.Kind <> AsmBlockStart)) Do
  171. Begin
  172. If (Pai(p)^.typ = ait_label) Then
  173. If (Pai_Label(p)^.l^.is_used)
  174. Then
  175. Begin
  176. LabelFound := True;
  177. If (Pai_Label(p)^.l^.labelnr < LowLabel) Then
  178. LowLabel := Pai_Label(p)^.l^.labelnr;
  179. If (Pai_Label(p)^.l^.labelnr > HighLabel) Then
  180. HighLabel := Pai_Label(p)^.l^.labelnr;
  181. End;
  182. GetNextInstruction(p, p);
  183. End;
  184. FindLoHiLabels := p;
  185. If LabelFound
  186. Then LabelDif := HighLabel+1-LowLabel
  187. Else LabelDif := 0;
  188. End;
  189. Function FindRegAlloc(Reg: TRegister; StartPai: Pai): Boolean;
  190. {Returns true if a ait_alloc object for Reg is found in the block of Pai's
  191. starting with StartPai and ending with the next "real" instruction}
  192. Begin
  193. FindRegAlloc:=False;
  194. Repeat
  195. While Assigned(StartPai) And
  196. ((StartPai^.typ in (SkipInstr - [ait_regAlloc])) Or
  197. ((StartPai^.typ = ait_label) and
  198. Not(Pai_Label(StartPai)^.l^.Is_Used))) Do
  199. StartPai := Pai(StartPai^.Next);
  200. If Assigned(StartPai) And
  201. (StartPai^.typ = ait_regAlloc) and (PairegAlloc(StartPai)^.allocation) Then
  202. Begin
  203. if PairegAlloc(StartPai)^.Reg = Reg then
  204. begin
  205. FindRegAlloc:=true;
  206. exit;
  207. end;
  208. StartPai := Pai(StartPai^.Next);
  209. End
  210. else
  211. exit;
  212. Until false;
  213. End;
  214. Procedure AddRegDeallocFor(asmL: paasmOutput; reg: TRegister; p: pai);
  215. var hp1: pai;
  216. begin
  217. hp1 := p;
  218. While GetLastInstruction(p, p) And
  219. Not(RegInInstruction(reg, p)) Do
  220. hp1 := p;
  221. p := New(PaiRegAlloc, DeAlloc(reg));
  222. InsertLLItem(AsmL, hp1^.previous, hp1, p);
  223. end;
  224. Procedure BuildLabelTableAndFixRegAlloc(asmL: PAasmOutput; Var LabelTable: PLabelTable; LowLabel: Longint;
  225. Var LabelDif: Longint; BlockStart, BlockEnd: Pai);
  226. {Builds a table with the locations of the labels in the paasmoutput.
  227. Also fixes some RegDeallocs like "# %eax released; push (%eax)"}
  228. Var p, hp1, hp2, lastP: Pai;
  229. regCounter: TRegister;
  230. UsedRegs: TRegSet;
  231. Begin
  232. UsedRegs := [];
  233. If (LabelDif <> 0) Then
  234. Begin
  235. {$IfDef TP}
  236. If (MaxAvail >= LabelDif*SizeOf(Pai))
  237. Then
  238. Begin
  239. {$EndIf TP}
  240. GetMem(LabelTable, LabelDif*SizeOf(TLabelTableItem));
  241. FillChar(LabelTable^, LabelDif*SizeOf(TLabelTableItem), 0);
  242. {$IfDef TP}
  243. End
  244. Else LabelDif := 0;
  245. {$EndIf TP}
  246. End;
  247. p := BlockStart;
  248. lastP := p;
  249. While (P <> BlockEnd) Do
  250. Begin
  251. Case p^.typ Of
  252. ait_Label:
  253. If Pai_Label(p)^.l^.is_used Then
  254. LabelTable^[Pai_Label(p)^.l^.labelnr-LowLabel].PaiObj := p;
  255. ait_regAlloc:
  256. begin
  257. if PairegAlloc(p)^.Allocation then
  258. Begin
  259. If Not(paiRegAlloc(p)^.Reg in UsedRegs) Then
  260. UsedRegs := UsedRegs + [paiRegAlloc(p)^.Reg]
  261. Else
  262. addRegDeallocFor(asmL, paiRegAlloc(p)^.reg, p);
  263. End
  264. else
  265. Begin
  266. UsedRegs := UsedRegs - [paiRegAlloc(p)^.Reg];
  267. hp1 := p;
  268. hp2 := nil;
  269. While Not(FindRegAlloc(paiRegAlloc(p)^.Reg, Pai(hp1^.Next))) And
  270. GetNextInstruction(hp1, hp1) And
  271. RegInInstruction(paiRegAlloc(p)^.Reg, hp1) Do
  272. hp2 := hp1;
  273. If hp2 <> nil Then
  274. Begin
  275. hp1 := Pai(p^.previous);
  276. AsmL^.Remove(p);
  277. InsertLLItem(AsmL, hp2, Pai(hp2^.Next), p);
  278. p := hp1;
  279. End;
  280. End;
  281. end;
  282. End;
  283. repeat
  284. lastP := p;
  285. P := Pai(P^.Next);
  286. until not(Assigned(p) And
  287. (p^.typ in (SkipInstr - [ait_regalloc])));
  288. End;
  289. for regCounter := R_EAX to R_EDI do
  290. if regCounter in usedRegs then
  291. addRegDeallocFor(asmL,regCounter,lastP);
  292. End;
  293. {************************ Search the Label table ************************}
  294. Function FindLabel(L: PasmLabel; Var hp: Pai): Boolean;
  295. {searches for the specified label starting from hp as long as the
  296. encountered instructions are labels, to be able to optimize constructs like
  297. jne l2 jmp l2
  298. jmp l3 and l1:
  299. l1: l2:
  300. l2:}
  301. Var TempP: Pai;
  302. Begin
  303. TempP := hp;
  304. While Assigned(TempP) and
  305. (TempP^.typ In SkipInstr + [ait_label]) Do
  306. If (TempP^.typ <> ait_Label) Or
  307. (pai_label(TempP)^.l <> L)
  308. Then GetNextInstruction(TempP, TempP)
  309. Else
  310. Begin
  311. hp := TempP;
  312. FindLabel := True;
  313. exit
  314. End;
  315. FindLabel := False;
  316. End;
  317. {************************ Some general functions ************************}
  318. Function TCh2Reg(Ch: TInsChange): TRegister;
  319. {converts a TChange variable to a TRegister}
  320. Begin
  321. If (Ch <= Ch_REDI) Then
  322. TCh2Reg := TRegister(Byte(Ch))
  323. Else
  324. If (Ch <= Ch_WEDI) Then
  325. TCh2Reg := TRegister(Byte(Ch) - Byte(Ch_REDI))
  326. Else
  327. If (Ch <= Ch_RWEDI) Then
  328. TCh2Reg := TRegister(Byte(Ch) - Byte(Ch_WEDI))
  329. Else
  330. If (Ch <= Ch_MEDI) Then
  331. TCh2Reg := TRegister(Byte(Ch) - Byte(Ch_RWEDI))
  332. Else InternalError($db)
  333. End;
  334. Function Reg32(Reg: TRegister): TRegister;
  335. {Returns the 32 bit component of Reg if it exists, otherwise Reg is returned}
  336. Begin
  337. Reg32 := Reg;
  338. If (Reg >= R_AX)
  339. Then
  340. If (Reg <= R_DI)
  341. Then Reg32 := Reg16ToReg32(Reg)
  342. Else
  343. If (Reg <= R_BL)
  344. Then Reg32 := Reg8toReg32(Reg);
  345. End;
  346. { inserts new_one between prev and foll }
  347. Procedure InsertLLItem(AsmL: PAasmOutput; prev, foll, new_one: PLinkedList_Item);
  348. Begin
  349. If Assigned(prev) Then
  350. If Assigned(foll) Then
  351. Begin
  352. If Assigned(new_one) Then
  353. Begin
  354. new_one^.previous := prev;
  355. new_one^.next := foll;
  356. prev^.next := new_one;
  357. foll^.previous := new_one;
  358. Pai(new_one)^.fileinfo := Pai(foll)^.fileinfo;
  359. End;
  360. End
  361. Else AsmL^.Concat(new_one)
  362. Else If Assigned(Foll) Then AsmL^.Insert(new_one)
  363. End;
  364. {********************* Compare parts of Pai objects *********************}
  365. Function RegsSameSize(Reg1, Reg2: TRegister): Boolean;
  366. {returns true if Reg1 and Reg2 are of the same size (so if they're both
  367. 8bit, 16bit or 32bit)}
  368. Begin
  369. If (Reg1 <= R_EDI)
  370. Then RegsSameSize := (Reg2 <= R_EDI)
  371. Else
  372. If (Reg1 <= R_DI)
  373. Then RegsSameSize := (Reg2 in [R_AX..R_DI])
  374. Else
  375. If (Reg1 <= R_BL)
  376. Then RegsSameSize := (Reg2 in [R_AL..R_BL])
  377. Else RegsSameSize := False
  378. End;
  379. Procedure AddReg2RegInfo(OldReg, NewReg: TRegister; Var RegInfo: TRegInfo);
  380. {updates the ???RegsEncountered and ???2???Reg fields of RegInfo. Assumes that
  381. OldReg and NewReg have the same size (has to be chcked in advance with
  382. RegsSameSize) and that neither equals R_NO}
  383. Begin
  384. With RegInfo Do
  385. Begin
  386. NewRegsEncountered := NewRegsEncountered + [NewReg];
  387. OldRegsEncountered := OldRegsEncountered + [OldReg];
  388. New2OldReg[NewReg] := OldReg;
  389. Case OldReg Of
  390. R_EAX..R_EDI:
  391. Begin
  392. NewRegsEncountered := NewRegsEncountered + [Reg32toReg16(NewReg)];
  393. OldRegsEncountered := OldRegsEncountered + [Reg32toReg16(OldReg)];
  394. New2OldReg[Reg32toReg16(NewReg)] := Reg32toReg16(OldReg);
  395. If (NewReg in [R_EAX..R_EBX]) And
  396. (OldReg in [R_EAX..R_EBX]) Then
  397. Begin
  398. NewRegsEncountered := NewRegsEncountered + [Reg32toReg8(NewReg)];
  399. OldRegsEncountered := OldRegsEncountered + [Reg32toReg8(OldReg)];
  400. New2OldReg[Reg32toReg8(NewReg)] := Reg32toReg8(OldReg);
  401. End;
  402. End;
  403. R_AX..R_DI:
  404. Begin
  405. NewRegsEncountered := NewRegsEncountered + [Reg16toReg32(NewReg)];
  406. OldRegsEncountered := OldRegsEncountered + [Reg16toReg32(OldReg)];
  407. New2OldReg[Reg16toReg32(NewReg)] := Reg16toReg32(OldReg);
  408. If (NewReg in [R_AX..R_BX]) And
  409. (OldReg in [R_AX..R_BX]) Then
  410. Begin
  411. NewRegsEncountered := NewRegsEncountered + [Reg16toReg8(NewReg)];
  412. OldRegsEncountered := OldRegsEncountered + [Reg16toReg8(OldReg)];
  413. New2OldReg[Reg16toReg8(NewReg)] := Reg16toReg8(OldReg);
  414. End;
  415. End;
  416. R_AL..R_BL:
  417. Begin
  418. NewRegsEncountered := NewRegsEncountered + [Reg8toReg32(NewReg)]
  419. + [Reg8toReg16(NewReg)];
  420. OldRegsEncountered := OldRegsEncountered + [Reg8toReg32(OldReg)]
  421. + [Reg8toReg16(OldReg)];
  422. New2OldReg[Reg8toReg32(NewReg)] := Reg8toReg32(OldReg);
  423. End;
  424. End;
  425. End;
  426. End;
  427. Procedure AddOp2RegInfo(const o:Toper; Var RegInfo: TRegInfo);
  428. Begin
  429. Case o.typ Of
  430. Top_Reg:
  431. If (o.reg <> R_NO) Then
  432. AddReg2RegInfo(o.reg, o.reg, RegInfo);
  433. Top_Ref:
  434. Begin
  435. If o.ref^.base <> R_NO Then
  436. AddReg2RegInfo(o.ref^.base, o.ref^.base, RegInfo);
  437. If o.ref^.index <> R_NO Then
  438. AddReg2RegInfo(o.ref^.index, o.ref^.index, RegInfo);
  439. End;
  440. End;
  441. End;
  442. Function RegsEquivalent(OldReg, NewReg: TRegister; Var RegInfo: TRegInfo; OPAct: TOpAction): Boolean;
  443. Begin
  444. If Not((OldReg = R_NO) Or (NewReg = R_NO)) Then
  445. If RegsSameSize(OldReg, NewReg) Then
  446. With RegInfo Do
  447. {here we always check for the 32 bit component, because it is possible that
  448. the 8 bit component has not been set, event though NewReg already has been
  449. processed. This happens if it has been compared with a register that doesn't
  450. have an 8 bit component (such as EDI). In that case the 8 bit component is
  451. still set to R_NO and the comparison in the Else-part will fail}
  452. If (Reg32(OldReg) in OldRegsEncountered) Then
  453. If (Reg32(NewReg) in NewRegsEncountered) Then
  454. RegsEquivalent := (OldReg = New2OldReg[NewReg])
  455. { If we haven't encountered the new register yet, but we have encountered the
  456. old one already, the new one can only be correct if it's being written to
  457. (and consequently the old one is also being written to), otherwise
  458. movl -8(%ebp), %eax and movl -8(%ebp), %eax
  459. movl (%eax), %eax movl (%edx), %edx
  460. are considered equivalent}
  461. Else
  462. If (OpAct = OpAct_Write) Then
  463. Begin
  464. AddReg2RegInfo(OldReg, NewReg, RegInfo);
  465. RegsEquivalent := True
  466. End
  467. Else Regsequivalent := False
  468. Else
  469. If Not(Reg32(NewReg) in NewRegsEncountered) Then
  470. Begin
  471. AddReg2RegInfo(OldReg, NewReg, RegInfo);
  472. RegsEquivalent := True
  473. End
  474. Else RegsEquivalent := False
  475. Else RegsEquivalent := False
  476. Else RegsEquivalent := OldReg = NewReg
  477. End;
  478. Function RefsEquivalent(Const R1, R2: TReference; var RegInfo: TRegInfo; OpAct: TOpAction): Boolean;
  479. Begin
  480. If R1.is_immediate Then
  481. RefsEquivalent := R2.is_immediate and (R1.Offset = R2.Offset)
  482. Else
  483. RefsEquivalent := (R1.Offset+R1.OffsetFixup = R2.Offset+R2.OffsetFixup) And
  484. RegsEquivalent(R1.Base, R2.Base, RegInfo, OpAct) And
  485. RegsEquivalent(R1.Index, R2.Index, RegInfo, OpAct) And
  486. (R1.Segment = R2.Segment) And (R1.ScaleFactor = R2.ScaleFactor) And
  487. (R1.Symbol = R2.Symbol);
  488. End;
  489. Function RefsEqual(Const R1, R2: TReference): Boolean;
  490. Begin
  491. If R1.is_immediate Then
  492. RefsEqual := R2.is_immediate and (R1.Offset = R2.Offset)
  493. Else
  494. RefsEqual := (R1.Offset+R1.OffsetFixup = R2.Offset+R2.OffsetFixup) And
  495. (R1.Segment = R2.Segment) And (R1.Base = R2.Base) And
  496. (R1.Index = R2.Index) And (R1.ScaleFactor = R2.ScaleFactor) And
  497. (R1.Symbol=R2.Symbol);
  498. End;
  499. Function IsGP32Reg(Reg: TRegister): Boolean;
  500. {Checks if the register is a 32 bit general purpose register}
  501. Begin
  502. If (Reg >= R_EAX) and (Reg <= R_EBX)
  503. Then IsGP32Reg := True
  504. Else IsGP32reg := False
  505. End;
  506. Function RegInRef(Reg: TRegister; Const Ref: TReference): Boolean;
  507. Begin {checks whether Ref contains a reference to Reg}
  508. Reg := Reg32(Reg);
  509. RegInRef := (Ref.Base = Reg) Or (Ref.Index = Reg)
  510. End;
  511. Function RegInInstruction(Reg: TRegister; p1: Pai): Boolean;
  512. {checks if Reg is used by the instruction p1}
  513. Var Counter: Longint;
  514. TmpResult: Boolean;
  515. Begin
  516. TmpResult := False;
  517. If (Pai(p1)^.typ = ait_instruction) Then
  518. Begin
  519. Reg := Reg32(Reg);
  520. Counter := 0;
  521. Repeat
  522. Case Paicpu(p1)^.oper[Counter].typ Of
  523. Top_Reg: TmpResult := Reg = Reg32(Paicpu(p1)^.oper[Counter].reg);
  524. Top_Ref: TmpResult := RegInRef(Reg, Paicpu(p1)^.oper[Counter].ref^);
  525. End;
  526. Inc(Counter)
  527. Until (Counter = 3) or TmpResult;
  528. End;
  529. RegInInstruction := TmpResult
  530. End;
  531. {Function RegInOp(Reg: TRegister; const o:toper): Boolean;
  532. Begin
  533. RegInOp := False;
  534. Case opt Of
  535. top_reg: RegInOp := Reg = o.reg;
  536. top_ref: RegInOp := (Reg = o.ref^.Base) Or
  537. (Reg = o.ref^.Index);
  538. End;
  539. End;}
  540. (*
  541. Function RegModifiedByInstruction(Reg: TRegister; p1: Pai): Boolean;
  542. {returns true if Reg is modified by the instruction p1. P1 is assumed to be
  543. of the type ait_instruction}
  544. Var hp: Pai;
  545. Begin
  546. If GetLastInstruction(p1, hp)
  547. Then
  548. RegModifiedByInstruction :=
  549. PPAiProp(p1^.OptInfo)^.Regs[Reg].WState <>
  550. PPAiProp(hp^.OptInfo)^.Regs[Reg].WState
  551. Else RegModifiedByInstruction := True;
  552. End;
  553. *)
  554. Function RegModifiedByInstruction(Reg: TRegister; p1: Pai): Boolean;
  555. Var InstrProp: TInsProp;
  556. TmpResult: Boolean;
  557. Cnt: Byte;
  558. Begin
  559. TmpResult := False;
  560. Reg := Reg32(Reg);
  561. If (p1^.typ = ait_instruction) Then
  562. Case paicpu(p1)^.opcode of
  563. A_IMUL:
  564. With paicpu(p1)^ Do
  565. TmpResult :=
  566. ((ops = 1) and (reg = R_EAX)) or
  567. ((ops = 2) and (Reg32(oper[1].reg) = reg)) or
  568. ((ops = 3) and (Reg32(oper[2].reg) = reg));
  569. A_DIV, A_IDIV, A_MUL:
  570. With paicpu(p1)^ Do
  571. TmpResult :=
  572. (Reg = R_EAX) or
  573. (Reg = R_EDX);
  574. Else
  575. Begin
  576. Cnt := 1;
  577. InstrProp := InsProp[paicpu(p1)^.OpCode];
  578. While (Cnt <= MaxCh) And
  579. (InstrProp.Ch[Cnt] <> Ch_None) And
  580. Not(TmpResult) Do
  581. Begin
  582. Case InstrProp.Ch[Cnt] Of
  583. Ch_WEAX..Ch_MEDI:
  584. TmpResult := Reg = TCh2Reg(InstrProp.Ch[Cnt]);
  585. Ch_RWOp1,Ch_WOp1{$ifdef arithopt},Ch_Mop1{$endif arithopt}:
  586. TmpResult := (paicpu(p1)^.oper[0].typ = top_reg) and
  587. (Reg32(paicpu(p1)^.oper[0].reg) = reg);
  588. Ch_RWOp2,Ch_WOp2{$ifdef arithopt},Ch_Mop2{$endif arithopt}:
  589. TmpResult := (paicpu(p1)^.oper[1].typ = top_reg) and
  590. (Reg32(paicpu(p1)^.oper[1].reg) = reg);
  591. Ch_RWOp3,Ch_WOp3{$ifdef arithopt},Ch_Mop3{$endif arithopt}:
  592. TmpResult := (paicpu(p1)^.oper[2].typ = top_reg) and
  593. (Reg32(paicpu(p1)^.oper[2].reg) = reg);
  594. Ch_FPU: TmpResult := Reg in [R_ST..R_ST7,R_MM0..R_MM7];
  595. Ch_ALL: TmpResult := true;
  596. End;
  597. Inc(Cnt)
  598. End
  599. End
  600. End;
  601. RegModifiedByInstruction := TmpResult
  602. End;
  603. {********************* GetNext and GetLastInstruction *********************}
  604. Function GetNextInstruction(Current: Pai; Var Next: Pai): Boolean;
  605. {skips ait_regalloc, ait_regdealloc and ait_stab* objects and puts the
  606. next pai object in Next. Returns false if there isn't any}
  607. Begin
  608. Repeat
  609. If (Current^.typ = ait_marker) And
  610. (Pai_Marker(Current)^.Kind = AsmBlockStart) Then
  611. Begin
  612. GetNextInstruction := False;
  613. Next := Nil;
  614. Exit
  615. End;
  616. Current := Pai(Current^.Next);
  617. While Assigned(Current) And
  618. ((Current^.typ In SkipInstr) or
  619. ((Current^.typ = ait_label) And
  620. Not(Pai_Label(Current)^.l^.is_used))) Do
  621. Current := Pai(Current^.Next);
  622. If Assigned(Current) And
  623. (Current^.typ = ait_Marker) And
  624. (Pai_Marker(Current)^.Kind = NoPropInfoStart) Then
  625. Begin
  626. While Assigned(Current) And
  627. ((Current^.typ <> ait_Marker) Or
  628. (Pai_Marker(Current)^.Kind <> NoPropInfoEnd)) Do
  629. Current := Pai(Current^.Next);
  630. End;
  631. Until Not(Assigned(Current)) Or
  632. (Current^.typ <> ait_Marker) Or
  633. (Pai_Marker(Current)^.Kind <> NoPropInfoEnd);
  634. Next := Current;
  635. If Assigned(Current) And
  636. Not((Current^.typ In SkipInstr) or
  637. ((Current^.typ = ait_label) And
  638. Not(Pai_Label(Current)^.l^.is_used)))
  639. Then GetNextInstruction := True
  640. Else
  641. Begin
  642. GetNextInstruction := False;
  643. Next := nil;
  644. End;
  645. End;
  646. Function GetLastInstruction(Current: Pai; Var Last: Pai): Boolean;
  647. {skips the ait-types in SkipInstr puts the previous pai object in
  648. Last. Returns false if there isn't any}
  649. Begin
  650. Repeat
  651. Current := Pai(Current^.previous);
  652. While Assigned(Current) And
  653. (((Current^.typ = ait_Marker) And
  654. Not(Pai_Marker(Current)^.Kind in [AsmBlockEnd,NoPropInfoEnd])) or
  655. (Current^.typ In SkipInstr) or
  656. ((Current^.typ = ait_label) And
  657. Not(Pai_Label(Current)^.l^.is_used))) Do
  658. Current := Pai(Current^.previous);
  659. If Assigned(Current) And
  660. (Current^.typ = ait_Marker) And
  661. (Pai_Marker(Current)^.Kind = NoPropInfoEnd) Then
  662. Begin
  663. While Assigned(Current) And
  664. ((Current^.typ <> ait_Marker) Or
  665. (Pai_Marker(Current)^.Kind <> NoPropInfoStart)) Do
  666. Current := Pai(Current^.previous);
  667. End;
  668. Until Not(Assigned(Current)) Or
  669. (Current^.typ <> ait_Marker) Or
  670. (Pai_Marker(Current)^.Kind <> NoPropInfoStart);
  671. If Not(Assigned(Current)) or
  672. (Current^.typ In SkipInstr) or
  673. ((Current^.typ = ait_label) And
  674. Not(Pai_Label(Current)^.l^.is_used)) or
  675. ((Current^.typ = ait_Marker) And
  676. (Pai_Marker(Current)^.Kind = AsmBlockEnd))
  677. Then
  678. Begin
  679. Last := nil;
  680. GetLastInstruction := False
  681. End
  682. Else
  683. Begin
  684. Last := Current;
  685. GetLastInstruction := True;
  686. End;
  687. End;
  688. Procedure SkipHead(var P: Pai);
  689. Var OldP: Pai;
  690. Begin
  691. Repeat
  692. OldP := P;
  693. If (P^.typ in SkipInstr) Or
  694. ((P^.typ = ait_marker) And
  695. (Pai_Marker(P)^.Kind = AsmBlockEnd)) Then
  696. GetNextInstruction(P, P)
  697. Else If ((P^.Typ = Ait_Marker) And
  698. (Pai_Marker(P)^.Kind = NoPropInfoStart)) Then
  699. {a marker of the NoPropInfoStart can't be the first instruction of a
  700. paasmoutput list}
  701. GetNextInstruction(Pai(P^.Previous),P);
  702. If (P^.Typ = Ait_Marker) And
  703. (Pai_Marker(P)^.Kind = AsmBlockStart) Then
  704. Begin
  705. P := Pai(P^.Next);
  706. While (P^.typ <> Ait_Marker) Or
  707. (Pai_Marker(P)^.Kind <> AsmBlockEnd) Do
  708. P := Pai(P^.Next)
  709. End;
  710. Until P = OldP
  711. End;
  712. {******************* The Data Flow Analyzer functions ********************}
  713. Procedure UpdateUsedRegs(Var UsedRegs: TRegSet; p: Pai);
  714. {updates UsedRegs with the RegAlloc Information coming after P}
  715. Begin
  716. Repeat
  717. While Assigned(p) And
  718. ((p^.typ in (SkipInstr - [ait_RegAlloc])) or
  719. ((p^.typ = ait_label) And
  720. Not(Pai_Label(p)^.l^.is_used))) Do
  721. p := Pai(p^.next);
  722. While Assigned(p) And
  723. (p^.typ=ait_RegAlloc) Do
  724. Begin
  725. if pairegalloc(p)^.allocation then
  726. UsedRegs := UsedRegs + [PaiRegAlloc(p)^.Reg]
  727. else
  728. UsedRegs := UsedRegs - [PaiRegAlloc(p)^.Reg];
  729. p := pai(p^.next);
  730. End;
  731. Until Not(Assigned(p)) Or
  732. (Not(p^.typ in SkipInstr) And
  733. Not((p^.typ = ait_label) And
  734. Not(Pai_Label(p)^.l^.is_used)));
  735. End;
  736. Procedure IncState(Var S: Byte);
  737. {Increases S by 1, wraps around at $ffff to 0 (so we won't get overflow
  738. errors}
  739. Begin
  740. If (s <> $ff)
  741. Then Inc(s)
  742. Else s := 0
  743. End;
  744. Function RegInSequence(Reg: TRegister; Const Content: TContent): Boolean;
  745. {checks the whole sequence of Content (so StartMod and and the next NrOfMods
  746. Pai objects) to see whether Reg is used somewhere, without it being loaded
  747. with something else first}
  748. Var p: Pai;
  749. Counter: Byte;
  750. TmpResult: Boolean;
  751. RegsChecked: TRegSet;
  752. Begin
  753. RegsChecked := [];
  754. p := Content.StartMod;
  755. TmpResult := False;
  756. Counter := 1;
  757. While Not(TmpResult) And
  758. (Counter <= Content.NrOfMods) Do
  759. Begin
  760. If (p^.typ = ait_instruction) and
  761. ((Paicpu(p)^.opcode = A_MOV) or
  762. (Paicpu(p)^.opcode = A_MOVZX) or
  763. (Paicpu(p)^.opcode = A_MOVSX))
  764. Then
  765. Begin
  766. If (Paicpu(p)^.oper[0].typ = top_ref) Then
  767. With Paicpu(p)^.oper[0].ref^ Do
  768. If (Base = procinfo^.FramePointer) And
  769. (Index = R_NO)
  770. Then
  771. Begin
  772. RegsChecked := RegsChecked + [Reg32(Paicpu(p)^.oper[1].reg)];
  773. If Reg = Reg32(Paicpu(p)^.oper[1].reg) Then
  774. Break;
  775. End
  776. Else
  777. Begin
  778. If (Base = Reg) And
  779. Not(Base In RegsChecked)
  780. Then TmpResult := True;
  781. If Not(TmpResult) And
  782. (Index = Reg) And
  783. Not(Index In RegsChecked)
  784. Then TmpResult := True;
  785. End
  786. End
  787. Else TmpResult := RegInInstruction(Reg, p);
  788. Inc(Counter);
  789. GetNextInstruction(p,p)
  790. End;
  791. RegInSequence := TmpResult
  792. End;
  793. Procedure DestroyReg(p1: PPaiProp; Reg: TRegister; doIncState:Boolean);
  794. {Destroys the contents of the register Reg in the PPaiProp p1, as well as the
  795. contents of registers are loaded with a memory location based on Reg.
  796. doIncState is false when this register has to be destroyed not because
  797. it's contents are directly modified/overwritten, but because of an indirect
  798. action (ie. this register holds the contents of a variable and the value
  799. of the variable in memory is changed }
  800. Var TmpWState, TmpRState: Byte;
  801. Counter: TRegister;
  802. Begin
  803. Reg := Reg32(Reg);
  804. NrOfInstrSinceLastMod[Reg] := 0;
  805. If (Reg >= R_EAX) And (Reg <= R_EDI)
  806. Then
  807. Begin
  808. With p1^.Regs[Reg] Do
  809. Begin
  810. if doIncState then
  811. IncState(WState);
  812. TmpWState := WState;
  813. TmpRState := RState;
  814. FillChar(p1^.Regs[Reg], SizeOf(TContent), 0);
  815. WState := TmpWState;
  816. RState := TmpRState;
  817. End;
  818. For Counter := R_EAX to R_EDI Do
  819. With p1^.Regs[Counter] Do
  820. If (Typ = Con_Ref) And
  821. RegInSequence(Reg, p1^.Regs[Counter])
  822. Then
  823. Begin
  824. if doIncState then
  825. IncState(WState);
  826. TmpWState := WState;
  827. TmpRState := RState;
  828. FillChar(p1^.Regs[Counter], SizeOf(TContent), 0);
  829. WState := TmpWState;
  830. RState := TmpRState;
  831. End;
  832. End;
  833. End;
  834. {Procedure AddRegsToSet(p: Pai; Var RegSet: TRegSet);
  835. Begin
  836. If (p^.typ = ait_instruction) Then
  837. Begin
  838. Case Paicpu(p)^.oper[0].typ Of
  839. top_reg:
  840. If Not(Paicpu(p)^.oper[0].reg in [R_NO,R_ESP,procinfo^.FramePointer]) Then
  841. RegSet := RegSet + [Paicpu(p)^.oper[0].reg];
  842. top_ref:
  843. With TReference(Paicpu(p)^.oper[0]^) Do
  844. Begin
  845. If Not(Base in [procinfo^.FramePointer,R_NO,R_ESP])
  846. Then RegSet := RegSet + [Base];
  847. If Not(Index in [procinfo^.FramePointer,R_NO,R_ESP])
  848. Then RegSet := RegSet + [Index];
  849. End;
  850. End;
  851. Case Paicpu(p)^.oper[1].typ Of
  852. top_reg:
  853. If Not(Paicpu(p)^.oper[1].reg in [R_NO,R_ESP,procinfo^.FramePointer]) Then
  854. If RegSet := RegSet + [TRegister(TwoWords(Paicpu(p)^.oper[1]).Word1];
  855. top_ref:
  856. With TReference(Paicpu(p)^.oper[1]^) Do
  857. Begin
  858. If Not(Base in [procinfo^.FramePointer,R_NO,R_ESP])
  859. Then RegSet := RegSet + [Base];
  860. If Not(Index in [procinfo^.FramePointer,R_NO,R_ESP])
  861. Then RegSet := RegSet + [Index];
  862. End;
  863. End;
  864. End;
  865. End;}
  866. Function OpsEquivalent(const o1, o2: toper; Var RegInfo: TRegInfo; OpAct: TopAction): Boolean;
  867. Begin {checks whether the two ops are equivalent}
  868. OpsEquivalent := False;
  869. if o1.typ=o2.typ then
  870. Case o1.typ Of
  871. Top_Reg:
  872. OpsEquivalent :=RegsEquivalent(o1.reg,o2.reg, RegInfo, OpAct);
  873. Top_Ref:
  874. OpsEquivalent := RefsEquivalent(o1.ref^, o2.ref^, RegInfo, OpAct);
  875. Top_Const:
  876. OpsEquivalent := o1.val = o2.val;
  877. Top_None:
  878. OpsEquivalent := True
  879. End;
  880. End;
  881. Function OpsEqual(const o1,o2:toper): Boolean;
  882. Begin {checks whether the two ops are equal}
  883. OpsEqual := False;
  884. if o1.typ=o2.typ then
  885. Case o1.typ Of
  886. Top_Reg :
  887. OpsEqual:=o1.reg=o2.reg;
  888. Top_Ref :
  889. OpsEqual := RefsEqual(o1.ref^, o2.ref^);
  890. Top_Const :
  891. OpsEqual:=o1.val=o2.val;
  892. Top_Symbol :
  893. OpsEqual:=(o1.sym=o2.sym) and (o1.symofs=o2.symofs);
  894. Top_None :
  895. OpsEqual := True
  896. End;
  897. End;
  898. Function InstructionsEquivalent(p1, p2: Pai; Var RegInfo: TRegInfo): Boolean;
  899. {$ifdef csdebug}
  900. var hp: pai;
  901. {$endif csdebug}
  902. Begin {checks whether two Paicpu instructions are equal}
  903. If Assigned(p1) And Assigned(p2) And
  904. (Pai(p1)^.typ = ait_instruction) And
  905. (Pai(p1)^.typ = ait_instruction) And
  906. (Paicpu(p1)^.opcode = Paicpu(p2)^.opcode) And
  907. (Paicpu(p1)^.oper[0].typ = Paicpu(p2)^.oper[0].typ) And
  908. (Paicpu(p1)^.oper[1].typ = Paicpu(p2)^.oper[1].typ) And
  909. (Paicpu(p1)^.oper[2].typ = Paicpu(p2)^.oper[2].typ)
  910. Then
  911. {both instructions have the same structure:
  912. "<operator> <operand of type1>, <operand of type 2>"}
  913. If ((Paicpu(p1)^.opcode = A_MOV) or
  914. (Paicpu(p1)^.opcode = A_MOVZX) or
  915. (Paicpu(p1)^.opcode = A_MOVSX)) And
  916. (Paicpu(p1)^.oper[0].typ = top_ref) {then .oper[1]t = top_reg} Then
  917. If Not(RegInRef(Paicpu(p1)^.oper[1].reg, Paicpu(p1)^.oper[0].ref^)) Then
  918. {the "old" instruction is a load of a register with a new value, not with
  919. a value based on the contents of this register (so no "mov (reg), reg")}
  920. If Not(RegInRef(Paicpu(p2)^.oper[1].reg, Paicpu(p2)^.oper[0].ref^)) And
  921. RefsEqual(Paicpu(p1)^.oper[0].ref^, Paicpu(p2)^.oper[0].ref^)
  922. Then
  923. {the "new" instruction is also a load of a register with a new value, and
  924. this value is fetched from the same memory location}
  925. Begin
  926. With Paicpu(p2)^.oper[0].ref^ Do
  927. Begin
  928. If Not(Base in [procinfo^.FramePointer, R_NO, R_ESP])
  929. {it won't do any harm if the register is already in RegsLoadedForRef}
  930. Then RegInfo.RegsLoadedForRef := RegInfo.RegsLoadedForRef + [Base];
  931. If Not(Index in [procinfo^.FramePointer, R_NO, R_ESP])
  932. Then RegInfo.RegsLoadedForRef := RegInfo.RegsLoadedForRef + [Index];
  933. End;
  934. {add the registers from the reference (.oper[0]) to the RegInfo, all registers
  935. from the reference are the same in the old and in the new instruction
  936. sequence}
  937. AddOp2RegInfo(Paicpu(p1)^.oper[0], RegInfo);
  938. {the registers from .oper[1] have to be equivalent, but not necessarily equal}
  939. InstructionsEquivalent :=
  940. RegsEquivalent(Paicpu(p1)^.oper[1].reg, Paicpu(p2)^.oper[1].reg, RegInfo, OpAct_Write);
  941. End
  942. {the registers are loaded with values from different memory locations. If
  943. this was allowed, the instructions "mov -4(esi),eax" and "mov -4(ebp),eax"
  944. would be considered equivalent}
  945. Else InstructionsEquivalent := False
  946. Else
  947. {load register with a value based on the current value of this register}
  948. Begin
  949. With Paicpu(p2)^.oper[0].ref^ Do
  950. Begin
  951. If Not(Base in [procinfo^.FramePointer,
  952. Reg32(Paicpu(p2)^.oper[1].reg),R_NO,R_ESP])
  953. {it won't do any harm if the register is already in RegsLoadedForRef}
  954. Then
  955. Begin
  956. RegInfo.RegsLoadedForRef := RegInfo.RegsLoadedForRef + [Base];
  957. {$ifdef csdebug}
  958. Writeln(att_reg2str[base], ' added');
  959. {$endif csdebug}
  960. end;
  961. If Not(Index in [procinfo^.FramePointer,
  962. Reg32(Paicpu(p2)^.oper[1].reg),R_NO,R_ESP])
  963. Then
  964. Begin
  965. RegInfo.RegsLoadedForRef := RegInfo.RegsLoadedForRef + [Index];
  966. {$ifdef csdebug}
  967. Writeln(att_reg2str[index], ' added');
  968. {$endif csdebug}
  969. end;
  970. End;
  971. If Not(Reg32(Paicpu(p2)^.oper[1].reg) In [procinfo^.FramePointer,R_NO,R_ESP])
  972. Then
  973. Begin
  974. RegInfo.RegsLoadedForRef := RegInfo.RegsLoadedForRef -
  975. [Reg32(Paicpu(p2)^.oper[1].reg)];
  976. {$ifdef csdebug}
  977. Writeln(att_reg2str[Reg32(Paicpu(p2)^.oper[1].reg)], ' removed');
  978. {$endif csdebug}
  979. end;
  980. InstructionsEquivalent :=
  981. OpsEquivalent(Paicpu(p1)^.oper[0], Paicpu(p2)^.oper[0], RegInfo, OpAct_Read) And
  982. OpsEquivalent(Paicpu(p1)^.oper[1], Paicpu(p2)^.oper[1], RegInfo, OpAct_Write)
  983. End
  984. Else
  985. {an instruction <> mov, movzx, movsx}
  986. begin
  987. {$ifdef csdebug}
  988. hp := new(pai_asm_comment,init(strpnew('checking if equivalent')));
  989. hp^.previous := p2;
  990. hp^.next := p2^.next;
  991. p2^.next^.previous := hp;
  992. p2^.next := hp;
  993. {$endif csdebug}
  994. InstructionsEquivalent :=
  995. OpsEquivalent(Paicpu(p1)^.oper[0], Paicpu(p2)^.oper[0], RegInfo, OpAct_Unknown) And
  996. OpsEquivalent(Paicpu(p1)^.oper[1], Paicpu(p2)^.oper[1], RegInfo, OpAct_Unknown) And
  997. OpsEquivalent(Paicpu(p1)^.oper[2], Paicpu(p2)^.oper[2], RegInfo, OpAct_Unknown)
  998. end
  999. {the instructions haven't even got the same structure, so they're certainly
  1000. not equivalent}
  1001. Else
  1002. begin
  1003. {$ifdef csdebug}
  1004. hp := new(pai_asm_comment,init(strpnew('different opcodes/format')));
  1005. hp^.previous := p2;
  1006. hp^.next := p2^.next;
  1007. p2^.next^.previous := hp;
  1008. p2^.next := hp;
  1009. {$endif csdebug}
  1010. InstructionsEquivalent := False;
  1011. end;
  1012. {$ifdef csdebug}
  1013. hp := new(pai_asm_comment,init(strpnew('instreq: '+tostr(byte(instructionsequivalent)))));
  1014. hp^.previous := p2;
  1015. hp^.next := p2^.next;
  1016. p2^.next^.previous := hp;
  1017. p2^.next := hp;
  1018. {$endif csdebug}
  1019. End;
  1020. (*
  1021. Function InstructionsEqual(p1, p2: Pai): Boolean;
  1022. Begin {checks whether two Paicpu instructions are equal}
  1023. InstructionsEqual :=
  1024. Assigned(p1) And Assigned(p2) And
  1025. ((Pai(p1)^.typ = ait_instruction) And
  1026. (Pai(p1)^.typ = ait_instruction) And
  1027. (Paicpu(p1)^.opcode = Paicpu(p2)^.opcode) And
  1028. (Paicpu(p1)^.oper[0].typ = Paicpu(p2)^.oper[0].typ) And
  1029. (Paicpu(p1)^.oper[1].typ = Paicpu(p2)^.oper[1].typ) And
  1030. OpsEqual(Paicpu(p1)^.oper[0].typ, Paicpu(p1)^.oper[0], Paicpu(p2)^.oper[0]) And
  1031. OpsEqual(Paicpu(p1)^.oper[1].typ, Paicpu(p1)^.oper[1], Paicpu(p2)^.oper[1]))
  1032. End;
  1033. *)
  1034. Procedure ReadReg(p: PPaiProp; Reg: TRegister);
  1035. Begin
  1036. Reg := Reg32(Reg);
  1037. If Reg in [R_EAX..R_EDI] Then
  1038. IncState(p^.Regs[Reg].RState)
  1039. End;
  1040. Procedure ReadRef(p: PPaiProp; Ref: PReference);
  1041. Begin
  1042. If Ref^.Base <> R_NO Then
  1043. ReadReg(p, Ref^.Base);
  1044. If Ref^.Index <> R_NO Then
  1045. ReadReg(p, Ref^.Index);
  1046. End;
  1047. Procedure ReadOp(P: PPaiProp;const o:toper);
  1048. Begin
  1049. Case o.typ Of
  1050. top_reg: ReadReg(P, o.reg);
  1051. top_ref: ReadRef(P, o.ref);
  1052. top_symbol : ;
  1053. End;
  1054. End;
  1055. Function RefInInstruction(Const Ref: TReference; p: Pai;
  1056. RefsEq: TRefCompare): Boolean;
  1057. {checks whehter Ref is used in P}
  1058. Var TmpResult: Boolean;
  1059. Begin
  1060. TmpResult := False;
  1061. If (p^.typ = ait_instruction) Then
  1062. Begin
  1063. If (Paicpu(p)^.oper[0].typ = Top_Ref) Then
  1064. TmpResult := RefsEq(Ref, Paicpu(p)^.oper[0].ref^);
  1065. If Not(TmpResult) And (Paicpu(p)^.oper[1].typ = Top_Ref) Then
  1066. TmpResult := RefsEq(Ref, Paicpu(p)^.oper[1].ref^);
  1067. If Not(TmpResult) And (Paicpu(p)^.oper[2].typ = Top_Ref) Then
  1068. TmpResult := RefsEq(Ref, Paicpu(p)^.oper[2].ref^);
  1069. End;
  1070. RefInInstruction := TmpResult;
  1071. End;
  1072. Function RefInSequence(Const Ref: TReference; Content: TContent;
  1073. RefsEq: TRefCompare): Boolean;
  1074. {checks the whole sequence of Content (so StartMod and and the next NrOfMods
  1075. Pai objects) to see whether Ref is used somewhere}
  1076. Var p: Pai;
  1077. Counter: Byte;
  1078. TmpResult: Boolean;
  1079. Begin
  1080. p := Content.StartMod;
  1081. TmpResult := False;
  1082. Counter := 1;
  1083. While Not(TmpResult) And
  1084. (Counter <= Content.NrOfMods) Do
  1085. Begin
  1086. If (p^.typ = ait_instruction) And
  1087. RefInInstruction(Ref, p, RefsEq)
  1088. Then TmpResult := True;
  1089. Inc(Counter);
  1090. GetNextInstruction(p,p)
  1091. End;
  1092. RefInSequence := TmpResult
  1093. End;
  1094. Function ArrayRefsEq(const r1, r2: TReference): Boolean;{$ifdef tp}far;{$endif}
  1095. Begin
  1096. ArrayRefsEq := (R1.Offset+R1.OffsetFixup = R2.Offset+R2.OffsetFixup) And
  1097. (R1.Segment = R2.Segment) And
  1098. (R1.Symbol=R2.Symbol) And
  1099. ((Assigned(R1.Symbol)) Or
  1100. (R1.Base = R2.Base))
  1101. End;
  1102. Procedure DestroyRefs(p: pai; Const Ref: TReference; WhichReg: TRegister);
  1103. {destroys all registers which possibly contain a reference to Ref, WhichReg
  1104. is the register whose contents are being written to memory (if this proc
  1105. is called because of a "mov?? %reg, (mem)" instruction)}
  1106. Var RefsEq: TRefCompare;
  1107. Counter: TRegister;
  1108. Begin
  1109. WhichReg := Reg32(WhichReg);
  1110. If (Ref.base = procinfo^.FramePointer) or
  1111. Assigned(Ref.Symbol) Then
  1112. Begin
  1113. If (Ref.Index = R_NO) And
  1114. (Not(Assigned(Ref.Symbol)) or
  1115. (Ref.base = R_NO)) Then
  1116. { local variable which is not an array }
  1117. RefsEq := {$ifdef fpc}@{$endif}RefsEqual
  1118. Else
  1119. { local variable which is an array }
  1120. RefsEq := {$ifdef fpc}@{$endif}ArrayRefsEq;
  1121. {write something to a parameter, a local or global variable, so
  1122. * with uncertain optimizations on:
  1123. - destroy the contents of registers whose contents have somewhere a
  1124. "mov?? (Ref), %reg". WhichReg (this is the register whose contents
  1125. are being written to memory) is not destroyed if it's StartMod is
  1126. of that form and NrOfMods = 1 (so if it holds ref, but is not a
  1127. pointer based on Ref)
  1128. * with uncertain optimizations off:
  1129. - also destroy registers that contain any pointer}
  1130. For Counter := R_EAX to R_EDI Do
  1131. With PPaiProp(p^.OptInfo)^.Regs[Counter] Do
  1132. Begin
  1133. If (typ = Con_Ref) And
  1134. ((Not(cs_UncertainOpts in aktglobalswitches) And
  1135. (NrOfMods <> 1)
  1136. ) Or
  1137. (RefInSequence(Ref,PPaiProp(p^.OptInfo)^.Regs[Counter],RefsEq) And
  1138. ((Counter <> WhichReg) Or
  1139. ((NrOfMods <> 1) And
  1140. {StarMod is always of the type ait_instruction}
  1141. (Paicpu(StartMod)^.oper[0].typ = top_ref) And
  1142. RefsEq(Paicpu(StartMod)^.oper[0].ref^, Ref)
  1143. )
  1144. )
  1145. )
  1146. )
  1147. Then
  1148. DestroyReg(PPaiProp(p^.OptInfo), Counter, false)
  1149. End
  1150. End
  1151. Else
  1152. {write something to a pointer location, so
  1153. * with uncertain optimzations on:
  1154. - do not destroy registers which contain a local/global variable or a
  1155. parameter, except if DestroyRefs is called because of a "movsl"
  1156. * with uncertain optimzations off:
  1157. - destroy every register which contains a memory location
  1158. }
  1159. For Counter := R_EAX to R_EDI Do
  1160. With PPaiProp(p^.OptInfo)^.Regs[Counter] Do
  1161. If (typ = Con_Ref) And
  1162. (Not(cs_UncertainOpts in aktglobalswitches) Or
  1163. {for movsl}
  1164. (Ref.Base = R_EDI) Or
  1165. {don't destroy if reg contains a parameter, local or global variable}
  1166. Not((NrOfMods = 1) And
  1167. (Paicpu(StartMod)^.oper[0].typ = top_ref) And
  1168. ((Paicpu(StartMod)^.oper[0].ref^.base = procinfo^.FramePointer) Or
  1169. Assigned(Paicpu(StartMod)^.oper[0].ref^.Symbol)
  1170. )
  1171. )
  1172. )
  1173. Then DestroyReg(PPaiProp(p^.OptInfo), Counter, false)
  1174. End;
  1175. Procedure DestroyAllRegs(p: PPaiProp);
  1176. Var Counter: TRegister;
  1177. Begin {initializes/desrtoys all registers}
  1178. For Counter := R_EAX To R_EDI Do
  1179. Begin
  1180. ReadReg(p, Counter);
  1181. DestroyReg(p, Counter, true);
  1182. End;
  1183. p^.DirFlag := F_Unknown;
  1184. End;
  1185. Procedure DestroyOp(PaiObj: Pai; const o:Toper);
  1186. Begin
  1187. Case o.typ Of
  1188. top_reg: DestroyReg(PPaiProp(PaiObj^.OptInfo), o.reg, true);
  1189. top_ref:
  1190. Begin
  1191. ReadRef(PPaiProp(PaiObj^.OptInfo), o.ref);
  1192. DestroyRefs(PaiObj, o.ref^, R_NO);
  1193. End;
  1194. top_symbol:;
  1195. End;
  1196. End;
  1197. Function DFAPass1(AsmL: PAasmOutput; BlockStart: Pai): Pai;
  1198. {gathers the RegAlloc data... still need to think about where to store it to
  1199. avoid global vars}
  1200. Var BlockEnd: Pai;
  1201. Begin
  1202. BlockEnd := FindLoHiLabels(LoLab, HiLab, LabDif, BlockStart);
  1203. BuildLabelTableAndFixRegAlloc(AsmL, LTable, LoLab, LabDif, BlockStart, BlockEnd);
  1204. DFAPass1 := BlockEnd;
  1205. End;
  1206. {$ifdef arithopt}
  1207. Procedure AddInstr2RegContents({$ifdef statedebug} asml: paasmoutput; {$endif}
  1208. p: paicpu; reg: TRegister);
  1209. {$ifdef statedebug}
  1210. var hp: pai;
  1211. {$endif statedebug}
  1212. Begin
  1213. Reg := Reg32(Reg);
  1214. With PPaiProp(p^.optinfo)^.Regs[reg] Do
  1215. If (Typ = Con_Ref)
  1216. Then
  1217. Begin
  1218. IncState(WState);
  1219. {also store how many instructions are part of the sequence in the first
  1220. instructions PPaiProp, so it can be easily accessed from within
  1221. CheckSequence}
  1222. Inc(NrOfMods, NrOfInstrSinceLastMod[Reg]);
  1223. PPaiProp(Pai(StartMod)^.OptInfo)^.Regs[Reg].NrOfMods := NrOfMods;
  1224. NrOfInstrSinceLastMod[Reg] := 0;
  1225. {$ifdef StateDebug}
  1226. hp := new(pai_asm_comment,init(strpnew(att_reg2str[reg]+': '+tostr(PPaiProp(p^.optinfo)^.Regs[reg].WState)
  1227. + ' -- ' + tostr(PPaiProp(p^.optinfo)^.Regs[reg].nrofmods))));
  1228. InsertLLItem(AsmL, p, p^.next, hp);
  1229. {$endif StateDebug}
  1230. End
  1231. Else
  1232. Begin
  1233. DestroyReg(PPaiProp(p^.optinfo), Reg, true);
  1234. {$ifdef StateDebug}
  1235. hp := new(pai_asm_comment,init(strpnew(att_reg2str[reg]+': '+tostr(PPaiProp(p^.optinfo)^.Regs[reg].WState))));
  1236. InsertLLItem(AsmL, p, p^.next, hp);
  1237. {$endif StateDebug}
  1238. End
  1239. End;
  1240. Procedure AddInstr2OpContents({$ifdef statedebug} asml: paasmoutput; {$endif}
  1241. p: paicpu; const oper: TOper);
  1242. Begin
  1243. If oper.typ = top_reg Then
  1244. AddInstr2RegContents({$ifdef statedebug} asml, {$endif}p, oper.reg)
  1245. Else
  1246. Begin
  1247. ReadOp(PPaiProp(p^.optinfo), oper);
  1248. DestroyOp(p, oper);
  1249. End
  1250. End;
  1251. {$endif arithopt}
  1252. Procedure DoDFAPass2(
  1253. {$Ifdef StateDebug}
  1254. AsmL: PAasmOutput;
  1255. {$endif statedebug}
  1256. BlockStart, BlockEnd: Pai);
  1257. {Analyzes the Data Flow of an assembler list. Starts creating the reg
  1258. contents for the instructions starting with p. Returns the last pai which has
  1259. been processed}
  1260. Var
  1261. CurProp: PPaiProp;
  1262. {$ifdef AnalyzeLoops}
  1263. TmpState: Byte;
  1264. {$endif AnalyzeLoops}
  1265. Cnt, InstrCnt : Longint;
  1266. InstrProp: TInsProp;
  1267. UsedRegs: TRegSet;
  1268. p, hp : Pai;
  1269. TmpRef: TReference;
  1270. TmpReg: TRegister;
  1271. Begin
  1272. p := BlockStart;
  1273. UsedRegs := [];
  1274. UpdateUsedregs(UsedRegs, p);
  1275. SkipHead(P);
  1276. BlockStart := p;
  1277. InstrCnt := 1;
  1278. FillChar(NrOfInstrSinceLastMod, SizeOf(NrOfInstrSinceLastMod), 0);
  1279. While (P <> BlockEnd) Do
  1280. Begin
  1281. {$IfDef TP}
  1282. New(CurProp);
  1283. {$Else TP}
  1284. CurProp := @PaiPropBlock^[InstrCnt];
  1285. {$EndIf TP}
  1286. If (p <> BlockStart)
  1287. Then
  1288. Begin
  1289. {$ifdef JumpAnal}
  1290. If (p^.Typ <> ait_label) Then
  1291. {$endif JumpAnal}
  1292. Begin
  1293. GetLastInstruction(p, hp);
  1294. CurProp^.Regs := PPaiProp(hp^.OptInfo)^.Regs;
  1295. CurProp^.DirFlag := PPaiProp(hp^.OptInfo)^.DirFlag;
  1296. End
  1297. End
  1298. Else
  1299. Begin
  1300. FillChar(CurProp^, SizeOf(CurProp^), 0);
  1301. { For TmpReg := R_EAX to R_EDI Do
  1302. CurProp^.Regs[TmpReg].WState := 1;}
  1303. End;
  1304. CurProp^.UsedRegs := UsedRegs;
  1305. CurProp^.CanBeRemoved := False;
  1306. UpdateUsedRegs(UsedRegs, Pai(p^.Next));
  1307. {$ifdef TP}
  1308. PPaiProp(p^.OptInfo) := CurProp;
  1309. {$Endif TP}
  1310. For TmpReg := R_EAX To R_EDI Do
  1311. Inc(NrOfInstrSinceLastMod[TmpReg]);
  1312. Case p^.typ Of
  1313. ait_label:
  1314. {$Ifndef JumpAnal}
  1315. If (Pai_label(p)^.l^.is_used) Then
  1316. DestroyAllRegs(CurProp);
  1317. {$Else JumpAnal}
  1318. Begin
  1319. If (Pai_Label(p)^.is_used) Then
  1320. With LTable^[Pai_Label(p)^.l^.labelnr-LoLab] Do
  1321. {$IfDef AnalyzeLoops}
  1322. If (RefsFound = Pai_Label(p)^.l^.RefCount)
  1323. {$Else AnalyzeLoops}
  1324. If (JmpsProcessed = Pai_Label(p)^.l^.RefCount)
  1325. {$EndIf AnalyzeLoops}
  1326. Then
  1327. {all jumps to this label have been found}
  1328. {$IfDef AnalyzeLoops}
  1329. If (JmpsProcessed > 0)
  1330. Then
  1331. {$EndIf AnalyzeLoops}
  1332. {we've processed at least one jump to this label}
  1333. Begin
  1334. If (GetLastInstruction(p, hp) And
  1335. Not(((hp^.typ = ait_instruction)) And
  1336. (paicpu_labeled(hp)^.is_jmp))
  1337. Then
  1338. {previous instruction not a JMP -> the contents of the registers after the
  1339. previous intruction has been executed have to be taken into account as well}
  1340. For TmpReg := R_EAX to R_EDI Do
  1341. Begin
  1342. If (CurProp^.Regs[TmpReg].WState <>
  1343. PPaiProp(hp^.OptInfo)^.Regs[TmpReg].WState)
  1344. Then DestroyReg(CurProp, TmpReg, true)
  1345. End
  1346. End
  1347. {$IfDef AnalyzeLoops}
  1348. Else
  1349. {a label from a backward jump (e.g. a loop), no jump to this label has
  1350. already been processed}
  1351. If GetLastInstruction(p, hp) And
  1352. Not(hp^.typ = ait_instruction) And
  1353. (paicpu_labeled(hp)^.opcode = A_JMP))
  1354. Then
  1355. {previous instruction not a jmp, so keep all the registers' contents from the
  1356. previous instruction}
  1357. Begin
  1358. CurProp^.Regs := PPaiProp(hp^.OptInfo)^.Regs;
  1359. CurProp^.DirFlag := PPaiProp(hp^.OptInfo)^.DirFlag;
  1360. End
  1361. Else
  1362. {previous instruction a jmp and no jump to this label processed yet}
  1363. Begin
  1364. hp := p;
  1365. Cnt := InstrCnt;
  1366. {continue until we find a jump to the label or a label which has already
  1367. been processed}
  1368. While GetNextInstruction(hp, hp) And
  1369. Not((hp^.typ = ait_instruction) And
  1370. (paicpu(hp)^.is_jmp) and
  1371. (pasmlabel(paicpu(hp)^.oper[0].sym)^.labelnr = Pai_Label(p)^.l^.labelnr)) And
  1372. Not((hp^.typ = ait_label) And
  1373. (LTable^[Pai_Label(hp)^.l^.labelnr-LoLab].RefsFound
  1374. = Pai_Label(hp)^.l^.RefCount) And
  1375. (LTable^[Pai_Label(hp)^.l^.labelnr-LoLab].JmpsProcessed > 0)) Do
  1376. Inc(Cnt);
  1377. If (hp^.typ = ait_label)
  1378. Then
  1379. {there's a processed label after the current one}
  1380. Begin
  1381. CurProp^.Regs := PaiPropBlock^[Cnt].Regs;
  1382. CurProp^.DirFlag := PaiPropBlock^[Cnt].DirFlag;
  1383. End
  1384. Else
  1385. {there's no label anymore after the current one, or they haven't been
  1386. processed yet}
  1387. Begin
  1388. GetLastInstruction(p, hp);
  1389. CurProp^.Regs := PPaiProp(hp^.OptInfo)^.Regs;
  1390. CurProp^.DirFlag := PPaiProp(hp^.OptInfo)^.DirFlag;
  1391. DestroyAllRegs(PPaiProp(hp^.OptInfo))
  1392. End
  1393. End
  1394. {$EndIf AnalyzeLoops}
  1395. Else
  1396. {not all references to this label have been found, so destroy all registers}
  1397. Begin
  1398. GetLastInstruction(p, hp);
  1399. CurProp^.Regs := PPaiProp(hp^.OptInfo)^.Regs;
  1400. CurProp^.DirFlag := PPaiProp(hp^.OptInfo)^.DirFlag;
  1401. DestroyAllRegs(CurProp)
  1402. End;
  1403. End;
  1404. {$EndIf JumpAnal}
  1405. {$ifdef GDB}
  1406. ait_stabs, ait_stabn, ait_stab_function_name:;
  1407. {$endif GDB}
  1408. ait_align: ; { may destroy flags !!! }
  1409. ait_instruction:
  1410. Begin
  1411. if paicpu(p)^.is_jmp then
  1412. begin
  1413. {$IfNDef JumpAnal}
  1414. ;
  1415. {$Else JumpAnal}
  1416. With LTable^[pasmlabel(paicpu(p)^.oper[0].sym)^.labelnr-LoLab] Do
  1417. If (RefsFound = pasmlabel(paicpu(p)^.oper[0].sym)^.RefCount) Then
  1418. Begin
  1419. If (InstrCnt < InstrNr)
  1420. Then
  1421. {forward jump}
  1422. If (JmpsProcessed = 0) Then
  1423. {no jump to this label has been processed yet}
  1424. Begin
  1425. PaiPropBlock^[InstrNr].Regs := CurProp^.Regs;
  1426. PaiPropBlock^[InstrNr].DirFlag := CurProp^.DirFlag;
  1427. Inc(JmpsProcessed);
  1428. End
  1429. Else
  1430. Begin
  1431. For TmpReg := R_EAX to R_EDI Do
  1432. If (PaiPropBlock^[InstrNr].Regs[TmpReg].WState <>
  1433. CurProp^.Regs[TmpReg].WState) Then
  1434. DestroyReg(@PaiPropBlock^[InstrNr], TmpReg, true);
  1435. Inc(JmpsProcessed);
  1436. End
  1437. {$ifdef AnalyzeLoops}
  1438. Else
  1439. { backward jump, a loop for example}
  1440. { If (JmpsProcessed > 0) Or
  1441. Not(GetLastInstruction(PaiObj, hp) And
  1442. (hp^.typ = ait_labeled_instruction) And
  1443. (paicpu_labeled(hp)^.opcode = A_JMP))
  1444. Then}
  1445. {instruction prior to label is not a jmp, or at least one jump to the label
  1446. has yet been processed}
  1447. Begin
  1448. Inc(JmpsProcessed);
  1449. For TmpReg := R_EAX to R_EDI Do
  1450. If (PaiPropBlock^[InstrNr].Regs[TmpReg].WState <>
  1451. CurProp^.Regs[TmpReg].WState)
  1452. Then
  1453. Begin
  1454. TmpState := PaiPropBlock^[InstrNr].Regs[TmpReg].WState;
  1455. Cnt := InstrNr;
  1456. While (TmpState = PaiPropBlock^[Cnt].Regs[TmpReg].WState) Do
  1457. Begin
  1458. DestroyReg(@PaiPropBlock^[Cnt], TmpReg, true);
  1459. Inc(Cnt);
  1460. End;
  1461. While (Cnt <= InstrCnt) Do
  1462. Begin
  1463. Inc(PaiPropBlock^[Cnt].Regs[TmpReg].WState);
  1464. Inc(Cnt)
  1465. End
  1466. End;
  1467. End
  1468. { Else }
  1469. {instruction prior to label is a jmp and no jumps to the label have yet been
  1470. processed}
  1471. { Begin
  1472. Inc(JmpsProcessed);
  1473. For TmpReg := R_EAX to R_EDI Do
  1474. Begin
  1475. TmpState := PaiPropBlock^[InstrNr].Regs[TmpReg].WState;
  1476. Cnt := InstrNr;
  1477. While (TmpState = PaiPropBlock^[Cnt].Regs[TmpReg].WState) Do
  1478. Begin
  1479. PaiPropBlock^[Cnt].Regs[TmpReg] := CurProp^.Regs[TmpReg];
  1480. Inc(Cnt);
  1481. End;
  1482. TmpState := PaiPropBlock^[InstrNr].Regs[TmpReg].WState;
  1483. While (TmpState = PaiPropBlock^[Cnt].Regs[TmpReg].WState) Do
  1484. Begin
  1485. DestroyReg(@PaiPropBlock^[Cnt], TmpReg, true);
  1486. Inc(Cnt);
  1487. End;
  1488. While (Cnt <= InstrCnt) Do
  1489. Begin
  1490. Inc(PaiPropBlock^[Cnt].Regs[TmpReg].WState);
  1491. Inc(Cnt)
  1492. End
  1493. End
  1494. End}
  1495. {$endif AnalyzeLoops}
  1496. End;
  1497. {$EndIf JumpAnal}
  1498. end
  1499. else
  1500. begin
  1501. InstrProp := InsProp[Paicpu(p)^.opcode];
  1502. Case Paicpu(p)^.opcode Of
  1503. A_MOV, A_MOVZX, A_MOVSX:
  1504. Begin
  1505. Case Paicpu(p)^.oper[0].typ Of
  1506. Top_Reg:
  1507. Case Paicpu(p)^.oper[1].typ Of
  1508. Top_Reg:
  1509. Begin
  1510. DestroyReg(CurProp, Paicpu(p)^.oper[1].reg, true);
  1511. ReadReg(CurProp, Paicpu(p)^.oper[0].reg);
  1512. { CurProp^.Regs[Paicpu(p)^.oper[1].reg] :=
  1513. CurProp^.Regs[Paicpu(p)^.oper[0].reg];
  1514. If (CurProp^.Regs[Paicpu(p)^.oper[1].reg].ModReg = R_NO) Then
  1515. CurProp^.Regs[Paicpu(p)^.oper[1].reg].ModReg :=
  1516. Paicpu(p)^.oper[0].reg;}
  1517. End;
  1518. Top_Ref:
  1519. Begin
  1520. ReadReg(CurProp, Paicpu(p)^.oper[0].reg);
  1521. ReadRef(CurProp, Paicpu(p)^.oper[1].ref);
  1522. DestroyRefs(p, Paicpu(p)^.oper[1].ref^, Paicpu(p)^.oper[0].reg);
  1523. End;
  1524. End;
  1525. Top_Ref:
  1526. Begin {destination is always a register in this case}
  1527. ReadRef(CurProp, Paicpu(p)^.oper[0].ref);
  1528. ReadReg(CurProp, Paicpu(p)^.oper[1].reg);
  1529. TmpReg := Reg32(Paicpu(p)^.oper[1].reg);
  1530. If RegInRef(TmpReg, Paicpu(p)^.oper[0].ref^) And
  1531. (CurProp^.Regs[TmpReg].Typ = Con_Ref)
  1532. Then
  1533. Begin
  1534. With CurProp^.Regs[TmpReg] Do
  1535. Begin
  1536. IncState(WState);
  1537. {also store how many instructions are part of the sequence in the first
  1538. instructions PPaiProp, so it can be easily accessed from within
  1539. CheckSequence}
  1540. Inc(NrOfMods, NrOfInstrSinceLastMod[TmpReg]);
  1541. PPaiProp(Pai(StartMod)^.OptInfo)^.Regs[TmpReg].NrOfMods := NrOfMods;
  1542. NrOfInstrSinceLastMod[TmpReg] := 0;
  1543. End;
  1544. End
  1545. Else
  1546. Begin
  1547. DestroyReg(CurProp, TmpReg, true);
  1548. If Not(RegInRef(TmpReg, Paicpu(p)^.oper[0].ref^)) Then
  1549. With CurProp^.Regs[TmpReg] Do
  1550. Begin
  1551. Typ := Con_Ref;
  1552. StartMod := p;
  1553. NrOfMods := 1;
  1554. End
  1555. End;
  1556. {$ifdef StateDebug}
  1557. hp := new(pai_asm_comment,init(strpnew(att_reg2str[TmpReg]+': '+tostr(CurProp^.Regs[TmpReg].WState))));
  1558. InsertLLItem(AsmL, p, p^.next, hp);
  1559. {$endif StateDebug}
  1560. End;
  1561. Top_Const:
  1562. Begin
  1563. Case Paicpu(p)^.oper[1].typ Of
  1564. Top_Reg:
  1565. Begin
  1566. TmpReg := Reg32(Paicpu(p)^.oper[1].reg);
  1567. With CurProp^.Regs[TmpReg] Do
  1568. Begin
  1569. DestroyReg(CurProp, TmpReg, true);
  1570. typ := Con_Const;
  1571. StartMod := p;
  1572. End
  1573. End;
  1574. Top_Ref:
  1575. Begin
  1576. ReadRef(CurProp, Paicpu(p)^.oper[1].ref);
  1577. DestroyRefs(P, Paicpu(p)^.oper[1].ref^, R_NO);
  1578. End;
  1579. End;
  1580. End;
  1581. End;
  1582. End;
  1583. A_DIV, A_IDIV, A_MUL:
  1584. Begin
  1585. ReadOp(Curprop, Paicpu(p)^.oper[0]);
  1586. ReadReg(CurProp,R_EAX);
  1587. If (Paicpu(p)^.OpCode = A_IDIV) or
  1588. (Paicpu(p)^.OpCode = A_DIV) Then
  1589. ReadReg(CurProp,R_EDX);
  1590. DestroyReg(CurProp, R_EAX, true);
  1591. DestroyReg(CurProp, R_EDX, true)
  1592. End;
  1593. A_IMUL:
  1594. Begin
  1595. ReadOp(CurProp,Paicpu(p)^.oper[0]);
  1596. ReadOp(CurProp,Paicpu(p)^.oper[1]);
  1597. If (Paicpu(p)^.oper[2].typ = top_none) Then
  1598. If (Paicpu(p)^.oper[1].typ = top_none) Then
  1599. Begin
  1600. ReadReg(CurProp,R_EAX);
  1601. DestroyReg(CurProp, R_EAX, true);
  1602. DestroyReg(CurProp, R_EDX, true)
  1603. End
  1604. Else
  1605. {$ifdef arithopt}
  1606. AddInstr2OpContents(Paicpu(p), Paicpu(p)^.oper[1])
  1607. {$else arithopt}
  1608. DestroyOp(p, Paicpu(p)^.oper[1])
  1609. {$endif arithopt}
  1610. Else
  1611. {$ifdef arithopt}
  1612. AddInstr2OpContents(Paicpu(p), Paicpu(p)^.oper[2]);
  1613. {$else arithopt}
  1614. DestroyOp(p, Paicpu(p)^.oper[2]);
  1615. {$endif arithopt}
  1616. End;
  1617. {$ifdef arithopt}
  1618. A_LEA:
  1619. begin
  1620. readop(curprop,paicpu(p)^.oper[0]);
  1621. if reginref(paicpu(p)^.oper[1].reg,paicpu(p)^.oper[0].ref^) then
  1622. AddInstr2RegContents(paicpu(p), paicpu(p)^.oper[1].reg)
  1623. else destroyreg(curprop,paicpu(p)^.oper[1].reg,true);
  1624. end;
  1625. {$endif arithopt}
  1626. Else
  1627. Begin
  1628. Cnt := 1;
  1629. While (Cnt <= MaxCh) And
  1630. (InstrProp.Ch[Cnt] <> Ch_None) Do
  1631. Begin
  1632. Case InstrProp.Ch[Cnt] Of
  1633. Ch_REAX..Ch_REDI: ReadReg(CurProp,TCh2Reg(InstrProp.Ch[Cnt]));
  1634. Ch_WEAX..Ch_RWEDI:
  1635. Begin
  1636. If (InstrProp.Ch[Cnt] >= Ch_RWEAX) Then
  1637. ReadReg(CurProp, TCh2Reg(InstrProp.Ch[Cnt]));
  1638. DestroyReg(CurProp, TCh2Reg(InstrProp.Ch[Cnt]), true);
  1639. End;
  1640. {$ifdef arithopt}
  1641. Ch_MEAX..Ch_MEDI:
  1642. AddInstr2RegContents({$ifdef statedebug} asml, {$endif}
  1643. Paicpu(p),
  1644. TCh2Reg(InstrProp.Ch[Cnt]));
  1645. {$endif arithopt}
  1646. Ch_CDirFlag: CurProp^.DirFlag := F_NotSet;
  1647. Ch_SDirFlag: CurProp^.DirFlag := F_Set;
  1648. Ch_Rop1: ReadOp(CurProp, Paicpu(p)^.oper[0]);
  1649. Ch_Rop2: ReadOp(CurProp, Paicpu(p)^.oper[1]);
  1650. Ch_ROp3: ReadOp(CurProp, Paicpu(p)^.oper[2]);
  1651. Ch_Wop1..Ch_RWop1:
  1652. Begin
  1653. If (InstrProp.Ch[Cnt] in [Ch_RWop1]) Then
  1654. ReadOp(CurProp, Paicpu(p)^.oper[0]);
  1655. DestroyOp(p, Paicpu(p)^.oper[0]);
  1656. End;
  1657. {$ifdef arithopt}
  1658. Ch_Mop1:
  1659. AddInstr2OpContents({$ifdef statedebug} asml, {$endif}
  1660. Paicpu(p), Paicpu(p)^.oper[0]);
  1661. {$endif arithopt}
  1662. Ch_Wop2..Ch_RWop2:
  1663. Begin
  1664. If (InstrProp.Ch[Cnt] = Ch_RWop2) Then
  1665. ReadOp(CurProp, Paicpu(p)^.oper[1]);
  1666. DestroyOp(p, Paicpu(p)^.oper[1]);
  1667. End;
  1668. {$ifdef arithopt}
  1669. Ch_Mop2:
  1670. AddInstr2OpContents({$ifdef statedebug} asml, {$endif}
  1671. Paicpu(p), Paicpu(p)^.oper[1]);
  1672. {$endif arithopt}
  1673. Ch_WOp3..Ch_RWOp3:
  1674. Begin
  1675. If (InstrProp.Ch[Cnt] = Ch_RWOp3) Then
  1676. ReadOp(CurProp, Paicpu(p)^.oper[2]);
  1677. DestroyOp(p, Paicpu(p)^.oper[2]);
  1678. End;
  1679. {$ifdef arithopt}
  1680. Ch_Mop3:
  1681. AddInstr2OpContents({$ifdef statedebug} asml, {$endif}
  1682. Paicpu(p), Paicpu(p)^.oper[2]);
  1683. {$endif arithopt}
  1684. Ch_WMemEDI:
  1685. Begin
  1686. ReadReg(CurProp, R_EDI);
  1687. FillChar(TmpRef, SizeOf(TmpRef), 0);
  1688. TmpRef.Base := R_EDI;
  1689. DestroyRefs(p, TmpRef, R_NO)
  1690. End;
  1691. Ch_RFlags, Ch_WFlags, Ch_RWFlags, Ch_FPU:
  1692. Else
  1693. Begin
  1694. DestroyAllRegs(CurProp);
  1695. End;
  1696. End;
  1697. Inc(Cnt);
  1698. End
  1699. End;
  1700. end;
  1701. End;
  1702. End
  1703. Else
  1704. Begin
  1705. DestroyAllRegs(CurProp);
  1706. End;
  1707. End;
  1708. Inc(InstrCnt);
  1709. GetNextInstruction(p, p);
  1710. End;
  1711. End;
  1712. Function InitDFAPass2(BlockStart, BlockEnd: Pai): Boolean;
  1713. {reserves memory for the PPaiProps in one big memory block when not using
  1714. TP, returns False if not enough memory is available for the optimizer in all
  1715. cases}
  1716. Var p: Pai;
  1717. Count: Longint;
  1718. { TmpStr: String; }
  1719. Begin
  1720. P := BlockStart;
  1721. SkipHead(P);
  1722. NrOfPaiObjs := 0;
  1723. While (P <> BlockEnd) Do
  1724. Begin
  1725. {$IfDef JumpAnal}
  1726. Case P^.Typ Of
  1727. ait_label:
  1728. Begin
  1729. If (Pai_Label(p)^.l^.is_used) Then
  1730. LTable^[Pai_Label(P)^.l^.labelnr-LoLab].InstrNr := NrOfPaiObjs
  1731. End;
  1732. ait_instruction:
  1733. begin
  1734. if paicpu(p)^.is_jmp then
  1735. begin
  1736. If (pasmlabel(paicpu(P)^.oper[0].sym)^.labelnr >= LoLab) And
  1737. (pasmlabel(paicpu(P)^.oper[0].sym)^.labelnr <= HiLab) Then
  1738. Inc(LTable^[pasmlabel(paicpu(P)^.oper[0].sym)^.labelnr-LoLab].RefsFound);
  1739. end;
  1740. end;
  1741. { ait_instruction:
  1742. Begin
  1743. If (Paicpu(p)^.opcode = A_PUSH) And
  1744. (Paicpu(p)^.oper[0].typ = top_symbol) And
  1745. (PCSymbol(Paicpu(p)^.oper[0])^.offset = 0) Then
  1746. Begin
  1747. TmpStr := StrPas(PCSymbol(Paicpu(p)^.oper[0])^.symbol);
  1748. If}
  1749. End;
  1750. {$EndIf JumpAnal}
  1751. Inc(NrOfPaiObjs);
  1752. GetNextInstruction(p, p);
  1753. End;
  1754. {$IfDef TP}
  1755. If (MemAvail < (SizeOf(TPaiProp)*NrOfPaiObjs))
  1756. Or (NrOfPaiObjs = 0)
  1757. {this doesn't have to be one contiguous block}
  1758. Then InitDFAPass2 := False
  1759. Else InitDFAPass2 := True;
  1760. {$Else}
  1761. {Uncomment the next line to see how much memory the reloading optimizer needs}
  1762. { Writeln((NrOfPaiObjs*(((SizeOf(TPaiProp)+3)div 4)*4)));}
  1763. {no need to check mem/maxavail, we've got as much virtual memory as we want}
  1764. If NrOfPaiObjs <> 0 Then
  1765. Begin
  1766. InitDFAPass2 := True;
  1767. GetMem(PaiPropBlock, NrOfPaiObjs*(((SizeOf(TPaiProp)+3)div 4)*4));
  1768. p := BlockStart;
  1769. SkipHead(p);
  1770. For Count := 1 To NrOfPaiObjs Do
  1771. Begin
  1772. PPaiProp(p^.OptInfo) := @PaiPropBlock^[Count];
  1773. GetNextInstruction(p, p);
  1774. End;
  1775. End
  1776. Else InitDFAPass2 := False;
  1777. {$EndIf TP}
  1778. End;
  1779. Function DFAPass2(
  1780. {$ifdef statedebug}
  1781. AsmL: PAasmOutPut;
  1782. {$endif statedebug}
  1783. BlockStart, BlockEnd: Pai): Boolean;
  1784. Begin
  1785. If InitDFAPass2(BlockStart, BlockEnd) Then
  1786. Begin
  1787. DoDFAPass2(
  1788. {$ifdef statedebug}
  1789. asml,
  1790. {$endif statedebug}
  1791. BlockStart, BlockEnd);
  1792. DFAPass2 := True
  1793. End
  1794. Else DFAPass2 := False;
  1795. End;
  1796. Procedure ShutDownDFA;
  1797. Begin
  1798. If LabDif <> 0 Then
  1799. FreeMem(LTable, LabDif*SizeOf(TLabelTableItem));
  1800. End;
  1801. End.
  1802. {
  1803. $Log$
  1804. Revision 1.76 2000-01-07 01:14:23 peter
  1805. * updated copyright to 2000
  1806. Revision 1.75 1999/12/05 16:48:43 jonas
  1807. * CSE of constant loading in regs works properly again
  1808. + if a constant is stored into memory using "mov const, ref" and
  1809. there is a reg that contains this const, it is changed into
  1810. "mov reg, ref"
  1811. Revision 1.74 1999/12/02 11:26:41 peter
  1812. * newoptimizations define added
  1813. Revision 1.73 1999/11/27 23:45:43 jonas
  1814. * even more missing register deallocations are added!
  1815. Revision 1.72 1999/11/21 13:06:30 jonas
  1816. * improved fixing of missing regallocs (they're almost all correct
  1817. now!)
  1818. Revision 1.71 1999/11/20 12:50:32 jonas
  1819. * fixed small typo (C_M* -> Ch_M*) so -darithopt compiles again
  1820. Revision 1.70 1999/11/14 11:25:38 jonas
  1821. * fixed stupid typo in previous commit :(
  1822. Revision 1.69 1999/11/13 19:01:51 jonas
  1823. * div, idiv and mul destroy edx!!
  1824. Revision 1.68 1999/11/07 14:57:09 jonas
  1825. * much more complete/waterproof RegModifiedByInstruction()
  1826. Revision 1.67 1999/11/06 14:34:20 peter
  1827. * truncated log to 20 revs
  1828. Revision 1.66 1999/11/05 16:01:46 jonas
  1829. + first implementation of choosing least used register for alignment code
  1830. (not yet working, between ifdef alignreg)
  1831. Revision 1.65 1999/10/27 16:11:28 peter
  1832. * insns.dat is used to generate all i386*.inc files
  1833. Revision 1.64 1999/10/23 14:44:24 jonas
  1834. * finally got around making GetNextInstruction return false when
  1835. the current pai object is a AsmBlockStart marker
  1836. * changed a loop in aopt386 which was incompatible with this change
  1837. Revision 1.63 1999/10/14 14:57:52 florian
  1838. - removed the hcodegen use in the new cg, use cgbase instead
  1839. Revision 1.62 1999/10/07 16:07:35 jonas
  1840. * small bugfix in ArrayRefsEq
  1841. Revision 1.61 1999/09/29 13:49:53 jonas
  1842. * writing to a position in an array now only destroys registers
  1843. containing a reference pointing somewhere in that array (since my last
  1844. fix, it behaved like a write to a pointer location)
  1845. Revision 1.60 1999/09/27 23:44:50 peter
  1846. * procinfo is now a pointer
  1847. * support for result setting in sub procedure
  1848. Revision 1.59 1999/09/21 15:46:58 jonas
  1849. * fixed bug in destroyrefs (indexes are now handled as pointers)
  1850. Revision 1.58 1999/09/05 12:37:50 jonas
  1851. * fixed typo's in -darithopt
  1852. Revision 1.57 1999/08/25 12:00:00 jonas
  1853. * changed pai386, paippc and paiapha (same for tai*) to paicpu (taicpu)
  1854. Revision 1.56 1999/08/18 13:25:54 jonas
  1855. * minor fixes regarding the reading of operands
  1856. Revision 1.55 1999/08/12 14:36:03 peter
  1857. + KNI instructions
  1858. Revision 1.54 1999/08/05 15:01:52 jonas
  1859. * fix in -darithopt code (sometimes crashed on 8/16bit regs)
  1860. Revision 1.53 1999/08/04 00:22:59 florian
  1861. * renamed i386asm and i386base to cpuasm and cpubase
  1862. Revision 1.52 1999/08/02 14:35:21 jonas
  1863. * bugfix in DestroyRefs
  1864. Revision 1.51 1999/08/02 12:12:53 jonas
  1865. * also add arithmetic operations to instruction sequences contained in registers
  1866. (compile with -darithopt, very nice!)
  1867. Revision 1.50 1999/07/30 18:18:51 jonas
  1868. * small bugfix in instructionsequal
  1869. * small bugfix in reginsequence
  1870. * made regininstruction a bit more logical
  1871. Revision 1.48 1999/07/01 18:21:21 jonas
  1872. * removed unused AsmL parameter from FindLoHiLabels
  1873. Revision 1.47 1999/05/27 19:44:24 peter
  1874. * removed oldasm
  1875. * plabel -> pasmlabel
  1876. * -a switches to source writing automaticly
  1877. * assembler readers OOPed
  1878. * asmsymbol automaticly external
  1879. * jumptables and other label fixes for asm readers
  1880. Revision 1.46 1999/05/08 20:40:02 jonas
  1881. * seperate OPTimizer INFO pointer field in tai object
  1882. * fix to GetLastInstruction that sometimes caused a crash
  1883. }