daopt386.pas 83 KB

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