daopt386.pas 72 KB

1234567891011121314151617181920212223242526272829303132333435363738394041424344454647484950515253545556575859606162636465666768697071727374757677787980818283848586878889909192939495969798991001011021031041051061071081091101111121131141151161171181191201211221231241251261271281291301311321331341351361371381391401411421431441451461471481491501511521531541551561571581591601611621631641651661671681691701711721731741751761771781791801811821831841851861871881891901911921931941951961971981992002012022032042052062072082092102112122132142152162172182192202212222232242252262272282292302312322332342352362372382392402412422432442452462472482492502512522532542552562572582592602612622632642652662672682692702712722732742752762772782792802812822832842852862872882892902912922932942952962972982993003013023033043053063073083093103113123133143153163173183193203213223233243253263273283293303313323333343353363373383393403413423433443453463473483493503513523533543553563573583593603613623633643653663673683693703713723733743753763773783793803813823833843853863873883893903913923933943953963973983994004014024034044054064074084094104114124134144154164174184194204214224234244254264274284294304314324334344354364374384394404414424434444454464474484494504514524534544554564574584594604614624634644654664674684694704714724734744754764774784794804814824834844854864874884894904914924934944954964974984995005015025035045055065075085095105115125135145155165175185195205215225235245255265275285295305315325335345355365375385395405415425435445455465475485495505515525535545555565575585595605615625635645655665675685695705715725735745755765775785795805815825835845855865875885895905915925935945955965975985996006016026036046056066076086096106116126136146156166176186196206216226236246256266276286296306316326336346356366376386396406416426436446456466476486496506516526536546556566576586596606616626636646656666676686696706716726736746756766776786796806816826836846856866876886896906916926936946956966976986997007017027037047057067077087097107117127137147157167177187197207217227237247257267277287297307317327337347357367377387397407417427437447457467477487497507517527537547557567577587597607617627637647657667677687697707717727737747757767777787797807817827837847857867877887897907917927937947957967977987998008018028038048058068078088098108118128138148158168178188198208218228238248258268278288298308318328338348358368378388398408418428438448458468478488498508518528538548558568578588598608618628638648658668678688698708718728738748758768778788798808818828838848858868878888898908918928938948958968978988999009019029039049059069079089099109119129139149159169179189199209219229239249259269279289299309319329339349359369379389399409419429439449459469479489499509519529539549559569579589599609619629639649659669679689699709719729739749759769779789799809819829839849859869879889899909919929939949959969979989991000100110021003100410051006100710081009101010111012101310141015101610171018101910201021102210231024102510261027102810291030103110321033103410351036103710381039104010411042104310441045104610471048104910501051105210531054105510561057105810591060106110621063106410651066106710681069107010711072107310741075107610771078107910801081108210831084108510861087108810891090109110921093109410951096109710981099110011011102110311041105110611071108110911101111111211131114111511161117111811191120112111221123112411251126112711281129113011311132113311341135113611371138113911401141114211431144114511461147114811491150115111521153115411551156115711581159116011611162116311641165116611671168116911701171117211731174117511761177117811791180118111821183118411851186118711881189119011911192119311941195119611971198119912001201120212031204120512061207120812091210121112121213121412151216121712181219122012211222122312241225122612271228122912301231123212331234123512361237123812391240124112421243124412451246124712481249125012511252125312541255125612571258125912601261126212631264126512661267126812691270127112721273127412751276127712781279128012811282128312841285128612871288128912901291129212931294129512961297129812991300130113021303130413051306130713081309131013111312131313141315131613171318131913201321132213231324132513261327132813291330133113321333133413351336133713381339134013411342134313441345134613471348134913501351135213531354135513561357135813591360136113621363136413651366136713681369137013711372137313741375137613771378137913801381138213831384138513861387138813891390139113921393139413951396139713981399140014011402140314041405140614071408140914101411141214131414141514161417141814191420142114221423142414251426142714281429143014311432143314341435143614371438143914401441144214431444144514461447144814491450145114521453145414551456145714581459146014611462146314641465146614671468146914701471147214731474147514761477147814791480148114821483148414851486148714881489149014911492149314941495149614971498149915001501150215031504150515061507150815091510151115121513151415151516151715181519152015211522152315241525152615271528152915301531153215331534153515361537153815391540154115421543154415451546154715481549155015511552155315541555155615571558155915601561156215631564156515661567156815691570157115721573157415751576157715781579158015811582158315841585158615871588158915901591159215931594159515961597159815991600160116021603160416051606160716081609161016111612161316141615161616171618161916201621162216231624162516261627162816291630163116321633163416351636163716381639164016411642164316441645164616471648164916501651165216531654165516561657165816591660166116621663166416651666166716681669167016711672167316741675167616771678167916801681168216831684168516861687168816891690169116921693169416951696169716981699170017011702170317041705170617071708170917101711171217131714171517161717171817191720172117221723172417251726172717281729173017311732173317341735173617371738173917401741174217431744174517461747174817491750175117521753175417551756175717581759176017611762176317641765176617671768176917701771177217731774177517761777177817791780178117821783178417851786178717881789179017911792179317941795179617971798179918001801180218031804180518061807180818091810181118121813181418151816181718181819182018211822182318241825182618271828182918301831183218331834183518361837183818391840184118421843184418451846184718481849185018511852185318541855185618571858185918601861186218631864186518661867186818691870187118721873187418751876187718781879188018811882188318841885188618871888188918901891189218931894189518961897189818991900190119021903190419051906190719081909191019111912191319141915191619171918191919201921192219231924192519261927192819291930193119321933193419351936193719381939194019411942194319441945194619471948194919501951195219531954195519561957195819591960196119621963196419651966196719681969197019711972197319741975197619771978197919801981198219831984198519861987198819891990199119921993199419951996199719981999200020012002200320042005200620072008200920102011201220132014201520162017201820192020202120222023202420252026202720282029203020312032203320342035203620372038
  1. {
  2. $Id$
  3. Copyright (c) 1997-98 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. Interface
  24. Uses
  25. GlobType,
  26. CObjects,Aasm,
  27. cpubase,cpuasm;
  28. Type
  29. TRegArray = Array[R_EAX..R_BL] of TRegister;
  30. TRegSet = Set of R_EAX..R_BL;
  31. TRegInfo = Record
  32. NewRegsEncountered, OldRegsEncountered: TRegSet;
  33. RegsLoadedForRef: TRegSet;
  34. New2OldReg: TRegArray;
  35. End;
  36. {possible actions on an operand: read, write or modify (= read & write)}
  37. TOpAction = (OpAct_Read, OpAct_Write, OpAct_Modify, OpAct_Unknown);
  38. {*********************** Procedures and Functions ************************}
  39. Procedure InsertLLItem(AsmL: PAasmOutput; prev, foll, new_one: PLinkedList_Item);
  40. Function Reg32(Reg: TRegister): TRegister;
  41. Function RefsEquivalent(Const R1, R2: TReference; Var RegInfo: TRegInfo; OpAct: TOpAction): Boolean;
  42. Function RefsEqual(Const R1, R2: TReference): Boolean;
  43. Function IsGP32Reg(Reg: TRegister): Boolean;
  44. Function RegInRef(Reg: TRegister; Const Ref: TReference): Boolean;
  45. Function RegInInstruction(Reg: TRegister; p1: Pai): Boolean;
  46. Function RegModifiedByInstruction(Reg: TRegister; p1: Pai): Boolean;
  47. Function GetNextInstruction(Current: Pai; Var Next: Pai): Boolean;
  48. Function GetLastInstruction(Current: Pai; Var Last: Pai): Boolean;
  49. Procedure SkipHead(var P: Pai);
  50. Procedure UpdateUsedRegs(Var UsedRegs: TRegSet; p: Pai);
  51. Function RegsEquivalent(OldReg, NewReg: TRegister; Var RegInfo: TRegInfo; OpAct: TopAction): Boolean;
  52. Function InstructionsEquivalent(p1, p2: Pai; Var RegInfo: TRegInfo): Boolean;
  53. Function OpsEqual(const o1,o2:toper): Boolean;
  54. Function DFAPass1(AsmL: PAasmOutput; BlockStart: Pai): Pai;
  55. Function DFAPass2(
  56. {$ifdef statedebug}
  57. AsmL: PAasmOutPut;
  58. {$endif statedebug}
  59. BlockStart, BlockEnd: Pai): Boolean;
  60. Procedure ShutDownDFA;
  61. Function FindLabel(L: PasmLabel; Var hp: Pai): Boolean;
  62. {******************************* Constants *******************************}
  63. Const
  64. {ait_* types which don't result in executable code or which don't influence
  65. the way the program runs/behaves}
  66. SkipInstr = [ait_comment, ait_symbol
  67. {$ifdef GDB}
  68. ,ait_stabs, ait_stabn, ait_stab_function_name
  69. {$endif GDB}
  70. {$ifndef alignreg}
  71. ,ait_align
  72. {$endif alignreg}
  73. ,ait_regalloc, ait_tempalloc
  74. ];
  75. {Possible register content types}
  76. con_Unknown = 0;
  77. con_ref = 1;
  78. con_const = 2;
  79. {********************************* Types *********************************}
  80. type
  81. {the possible states of a flag}
  82. TFlagContents = (F_Unknown, F_NotSet, F_Set);
  83. TContent = Packed Record
  84. {start and end of block instructions that defines the
  85. content of this register. If Typ = con_const, then
  86. Longint(StartMod) = value of the constant)}
  87. StartMod: pai;
  88. {starts at 0, gets increased everytime the register is written to}
  89. WState: Byte;
  90. {starts at 0, gets increased everytime the register is read from}
  91. RState: Byte;
  92. {how many instructions starting with StarMod does the block consist of}
  93. NrOfMods: Byte;
  94. {the type of the content of the register: unknown, memory, constant}
  95. Typ: Byte;
  96. End;
  97. {Contents of the integer registers}
  98. TRegContent = Array[R_EAX..R_EDI] Of TContent;
  99. {contents of the FPU registers}
  100. TRegFPUContent = Array[R_ST..R_ST7] Of TContent;
  101. {information record with the contents of every register. Every Pai object
  102. gets one of these assigned: a pointer to it is stored in the OptInfo field}
  103. TPaiProp = Record
  104. Regs: TRegContent;
  105. { FPURegs: TRegFPUContent;} {currently not yet used}
  106. {allocated Registers}
  107. UsedRegs: TRegSet;
  108. {status of the direction flag}
  109. DirFlag: TFlagContents;
  110. {can this instruction be removed?}
  111. CanBeRemoved: Boolean;
  112. End;
  113. PPaiProp = ^TPaiProp;
  114. {$IfNDef TP}
  115. TPaiPropBlock = Array[1..250000] Of TPaiProp;
  116. PPaiPropBlock = ^TPaiPropBlock;
  117. {$EndIf TP}
  118. TInstrSinceLastMod = Array[R_EAX..R_EDI] Of Byte;
  119. TLabelTableItem = Record
  120. PaiObj: Pai;
  121. {$IfDef JumpAnal}
  122. InstrNr: Longint;
  123. RefsFound: Word;
  124. JmpsProcessed: Word
  125. {$EndIf JumpAnal}
  126. End;
  127. {$IfDef tp}
  128. TLabelTable = Array[0..10000] Of TLabelTableItem;
  129. {$Else tp}
  130. TLabelTable = Array[0..2500000] Of TLabelTableItem;
  131. {$Endif tp}
  132. PLabelTable = ^TLabelTable;
  133. {******************************* Variables *******************************}
  134. Var
  135. {the amount of PaiObjects in the current assembler list}
  136. NrOfPaiObjs: Longint;
  137. {$IfNDef TP}
  138. {Array which holds all TPaiProps}
  139. PaiPropBlock: PPaiPropBlock;
  140. {$EndIf TP}
  141. LoLab, HiLab, LabDif: Longint;
  142. LTable: PLabelTable;
  143. {*********************** End of Interface section ************************}
  144. Implementation
  145. Uses
  146. globals, systems, strings, verbose, hcodegen;
  147. Type
  148. TRefCompare = function(const r1, r2: TReference): Boolean;
  149. Var
  150. {How many instructions are between the current instruction and the last one
  151. that modified the register}
  152. NrOfInstrSinceLastMod: TInstrSinceLastMod;
  153. {************************ Create the Label table ************************}
  154. Function FindLoHiLabels(Var LowLabel, HighLabel, LabelDif: Longint; BlockStart: Pai): Pai;
  155. {Walks through the paasmlist to find the lowest and highest label number}
  156. Var LabelFound: Boolean;
  157. P: Pai;
  158. Begin
  159. LabelFound := False;
  160. LowLabel := MaxLongint;
  161. HighLabel := 0;
  162. P := BlockStart;
  163. While Assigned(P) And
  164. ((P^.typ <> Ait_Marker) Or
  165. (Pai_Marker(P)^.Kind <> AsmBlockStart)) Do
  166. Begin
  167. If (Pai(p)^.typ = ait_label) Then
  168. If (Pai_Label(p)^.l^.is_used)
  169. Then
  170. Begin
  171. LabelFound := True;
  172. If (Pai_Label(p)^.l^.labelnr < LowLabel) Then
  173. LowLabel := Pai_Label(p)^.l^.labelnr;
  174. If (Pai_Label(p)^.l^.labelnr > HighLabel) Then
  175. HighLabel := Pai_Label(p)^.l^.labelnr;
  176. End;
  177. GetNextInstruction(p, p);
  178. End;
  179. FindLoHiLabels := p;
  180. If LabelFound
  181. Then LabelDif := HighLabel+1-LowLabel
  182. Else LabelDif := 0;
  183. End;
  184. Function FindRegAlloc(Reg: TRegister; StartPai: Pai): Boolean;
  185. {Returns true if a ait_alloc object for Reg is found in the block of Pai's
  186. starting with StartPai and ending with the next "real" instruction}
  187. Begin
  188. FindRegAlloc:=False;
  189. Repeat
  190. While Assigned(StartPai) And
  191. ((StartPai^.typ in (SkipInstr - [ait_regAlloc])) Or
  192. ((StartPai^.typ = ait_label) and
  193. Not(Pai_Label(StartPai)^.l^.Is_Used))) Do
  194. StartPai := Pai(StartPai^.Next);
  195. If Assigned(StartPai) And
  196. (StartPai^.typ = ait_regAlloc) and (PairegAlloc(StartPai)^.allocation) Then
  197. Begin
  198. if PairegAlloc(StartPai)^.Reg = Reg then
  199. begin
  200. FindRegAlloc:=true;
  201. exit;
  202. end;
  203. StartPai := Pai(StartPai^.Next);
  204. End
  205. else
  206. exit;
  207. Until false;
  208. End;
  209. Procedure AddRegDeallocFor(asmL: paasmOutput; reg: TRegister; p: pai);
  210. var hp1: pai;
  211. begin
  212. hp1 := nil;
  213. While GetLastInstruction(p, p) And
  214. Not(RegInInstruction(reg, p)) Do
  215. hp1 := p;
  216. If hp1 <> nil Then
  217. Begin
  218. p := New(PaiRegAlloc, DeAlloc(reg));
  219. InsertLLItem(AsmL, hp1, hp1^.next, p);
  220. End;
  221. end;
  222. Procedure BuildLabelTableAndFixRegAlloc(asmL: PAasmOutput; Var LabelTable: PLabelTable; LowLabel: Longint;
  223. Var LabelDif: Longint; BlockStart, BlockEnd: Pai);
  224. {Builds a table with the locations of the labels in the paasmoutput.
  225. Also fixes some RegDeallocs like "# %eax released; push (%eax)"}
  226. Var p, hp1, hp2, lastP: Pai;
  227. regCounter: TRegister;
  228. UsedRegs: TRegSet;
  229. Begin
  230. UsedRegs := [];
  231. If (LabelDif <> 0) Then
  232. Begin
  233. {$IfDef TP}
  234. If (MaxAvail >= LabelDif*SizeOf(Pai))
  235. Then
  236. Begin
  237. {$EndIf TP}
  238. GetMem(LabelTable, LabelDif*SizeOf(TLabelTableItem));
  239. FillChar(LabelTable^, LabelDif*SizeOf(TLabelTableItem), 0);
  240. {$IfDef TP}
  241. End
  242. Else LabelDif := 0;
  243. {$EndIf TP}
  244. End;
  245. p := BlockStart;
  246. lastP := p;
  247. While (P <> BlockEnd) Do
  248. Begin
  249. Case p^.typ Of
  250. ait_Label:
  251. If Pai_Label(p)^.l^.is_used Then
  252. LabelTable^[Pai_Label(p)^.l^.labelnr-LowLabel].PaiObj := p;
  253. ait_regAlloc:
  254. begin
  255. if PairegAlloc(p)^.Allocation then
  256. Begin
  257. If Not(paiRegAlloc(p)^.Reg in UsedRegs) Then
  258. UsedRegs := UsedRegs + [paiRegAlloc(p)^.Reg]
  259. Else
  260. addRegDeallocFor(asmL, paiRegAlloc(p)^.reg, p);
  261. End
  262. else
  263. Begin
  264. UsedRegs := UsedRegs - [paiRegAlloc(p)^.Reg];
  265. hp1 := p;
  266. hp2 := nil;
  267. While Not(FindRegAlloc(paiRegAlloc(p)^.Reg, Pai(hp1^.Next))) And
  268. GetNextInstruction(hp1, hp1) And
  269. RegInInstruction(paiRegAlloc(p)^.Reg, hp1) Do
  270. hp2 := hp1;
  271. If hp2 <> nil Then
  272. Begin
  273. hp1 := Pai(p^.previous);
  274. AsmL^.Remove(p);
  275. InsertLLItem(AsmL, hp2, Pai(hp2^.Next), p);
  276. p := hp1;
  277. End;
  278. End;
  279. end;
  280. End;
  281. P := Pai(p^.Next);
  282. While Assigned(p) And
  283. (p^.typ in (SkipInstr - [ait_regalloc])) Do
  284. begin
  285. lastP := p;
  286. P := Pai(P^.Next);
  287. end;
  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. (*Function FindZeroreg(p: Pai; Var Result: TRegister): Boolean;
  737. {Finds a register which contains the constant zero}
  738. Var Counter: TRegister;
  739. Begin
  740. Counter := R_EAX;
  741. FindZeroReg := True;
  742. While (Counter <= R_EDI) And
  743. ((PPaiProp(p^.OptInfo)^.Regs[Counter].Typ <> Con_Const) or
  744. (PPaiProp(p^.OptInfo)^.Regs[Counter].StartMod <> Pointer(0))) Do
  745. Inc(Byte(Counter));
  746. If (PPaiProp(p^.OptInfo)^.Regs[Counter].Typ = Con_Const) And
  747. (PPaiProp(p^.OptInfo)^.Regs[Counter].StartMod = Pointer(0))
  748. Then Result := Counter
  749. Else FindZeroReg := False;
  750. End;*)
  751. Procedure IncState(Var S: Byte);
  752. {Increases S by 1, wraps around at $ffff to 0 (so we won't get overflow
  753. errors}
  754. Begin
  755. If (s <> $ff)
  756. Then Inc(s)
  757. Else s := 0
  758. End;
  759. Function RegInSequence(Reg: TRegister; Const Content: TContent): Boolean;
  760. {checks the whole sequence of Content (so StartMod and and the next NrOfMods
  761. Pai objects) to see whether Reg is used somewhere, without it being loaded
  762. with something else first}
  763. Var p: Pai;
  764. Counter: Byte;
  765. TmpResult: Boolean;
  766. RegsChecked: TRegSet;
  767. Begin
  768. RegsChecked := [];
  769. p := Content.StartMod;
  770. TmpResult := False;
  771. Counter := 1;
  772. While Not(TmpResult) And
  773. (Counter <= Content.NrOfMods) Do
  774. Begin
  775. If (p^.typ = ait_instruction) and
  776. ((Paicpu(p)^.opcode = A_MOV) or
  777. (Paicpu(p)^.opcode = A_MOVZX) or
  778. (Paicpu(p)^.opcode = A_MOVSX))
  779. Then
  780. Begin
  781. If (Paicpu(p)^.oper[0].typ = top_ref) Then
  782. With Paicpu(p)^.oper[0].ref^ Do
  783. If (Base = procinfo^.FramePointer) And
  784. (Index = R_NO)
  785. Then
  786. Begin
  787. RegsChecked := RegsChecked + [Reg32(Paicpu(p)^.oper[1].reg)];
  788. If Reg = Reg32(Paicpu(p)^.oper[1].reg) Then
  789. Break;
  790. End
  791. Else
  792. Begin
  793. If (Base = Reg) And
  794. Not(Base In RegsChecked)
  795. Then TmpResult := True;
  796. If Not(TmpResult) And
  797. (Index = Reg) And
  798. Not(Index In RegsChecked)
  799. Then TmpResult := True;
  800. End
  801. End
  802. Else TmpResult := RegInInstruction(Reg, p);
  803. Inc(Counter);
  804. GetNextInstruction(p,p)
  805. End;
  806. RegInSequence := TmpResult
  807. End;
  808. Procedure DestroyReg(p1: PPaiProp; Reg: TRegister; doIncState:Boolean);
  809. {Destroys the contents of the register Reg in the PPaiProp p1, as well as the
  810. contents of registers are loaded with a memory location based on Reg.
  811. doIncState is false when this register has to be destroyed not because
  812. it's contents are directly modified/overwritten, but because of an indirect
  813. action (ie. this register holds the contents of a variable and the value
  814. of the variable in memory is changed }
  815. Var TmpWState, TmpRState: Byte;
  816. Counter: TRegister;
  817. Begin
  818. Reg := Reg32(Reg);
  819. NrOfInstrSinceLastMod[Reg] := 0;
  820. If (Reg >= R_EAX) And (Reg <= R_EDI)
  821. Then
  822. Begin
  823. With p1^.Regs[Reg] Do
  824. Begin
  825. if doIncState then
  826. IncState(WState);
  827. TmpWState := WState;
  828. TmpRState := RState;
  829. FillChar(p1^.Regs[Reg], SizeOf(TContent), 0);
  830. WState := TmpWState;
  831. RState := TmpRState;
  832. End;
  833. For Counter := R_EAX to R_EDI Do
  834. With p1^.Regs[Counter] Do
  835. If (Typ = Con_Ref) And
  836. RegInSequence(Reg, p1^.Regs[Counter])
  837. Then
  838. Begin
  839. if doIncState then
  840. IncState(WState);
  841. TmpWState := WState;
  842. TmpRState := RState;
  843. FillChar(p1^.Regs[Counter], SizeOf(TContent), 0);
  844. WState := TmpWState;
  845. RState := TmpRState;
  846. End;
  847. End;
  848. End;
  849. {Procedure AddRegsToSet(p: Pai; Var RegSet: TRegSet);
  850. Begin
  851. If (p^.typ = ait_instruction) Then
  852. Begin
  853. Case Paicpu(p)^.oper[0].typ Of
  854. top_reg:
  855. If Not(Paicpu(p)^.oper[0].reg in [R_NO,R_ESP,procinfo^.FramePointer]) Then
  856. RegSet := RegSet + [Paicpu(p)^.oper[0].reg];
  857. top_ref:
  858. With TReference(Paicpu(p)^.oper[0]^) Do
  859. Begin
  860. If Not(Base in [procinfo^.FramePointer,R_NO,R_ESP])
  861. Then RegSet := RegSet + [Base];
  862. If Not(Index in [procinfo^.FramePointer,R_NO,R_ESP])
  863. Then RegSet := RegSet + [Index];
  864. End;
  865. End;
  866. Case Paicpu(p)^.oper[1].typ Of
  867. top_reg:
  868. If Not(Paicpu(p)^.oper[1].reg in [R_NO,R_ESP,procinfo^.FramePointer]) Then
  869. If RegSet := RegSet + [TRegister(TwoWords(Paicpu(p)^.oper[1]).Word1];
  870. top_ref:
  871. With TReference(Paicpu(p)^.oper[1]^) Do
  872. Begin
  873. If Not(Base in [procinfo^.FramePointer,R_NO,R_ESP])
  874. Then RegSet := RegSet + [Base];
  875. If Not(Index in [procinfo^.FramePointer,R_NO,R_ESP])
  876. Then RegSet := RegSet + [Index];
  877. End;
  878. End;
  879. End;
  880. End;}
  881. Function OpsEquivalent(const o1, o2: toper; Var RegInfo: TRegInfo; OpAct: TopAction): Boolean;
  882. Begin {checks whether the two ops are equivalent}
  883. OpsEquivalent := False;
  884. if o1.typ=o2.typ then
  885. Case o1.typ Of
  886. Top_Reg:
  887. OpsEquivalent :=RegsEquivalent(o1.reg,o2.reg, RegInfo, OpAct);
  888. Top_Ref:
  889. OpsEquivalent := RefsEquivalent(o1.ref^, o2.ref^, RegInfo, OpAct);
  890. Top_Const:
  891. OpsEquivalent := o1.val = o2.val;
  892. Top_None:
  893. OpsEquivalent := True
  894. End;
  895. End;
  896. Function OpsEqual(const o1,o2:toper): Boolean;
  897. Begin {checks whether the two ops are equal}
  898. OpsEqual := False;
  899. if o1.typ=o2.typ then
  900. Case o1.typ Of
  901. Top_Reg :
  902. OpsEqual:=o1.reg=o2.reg;
  903. Top_Ref :
  904. OpsEqual := RefsEqual(o1.ref^, o2.ref^);
  905. Top_Const :
  906. OpsEqual:=o1.val=o2.val;
  907. Top_Symbol :
  908. OpsEqual:=(o1.sym=o2.sym) and (o1.symofs=o2.symofs);
  909. Top_None :
  910. OpsEqual := True
  911. End;
  912. End;
  913. Function InstructionsEquivalent(p1, p2: Pai; Var RegInfo: TRegInfo): Boolean;
  914. {$ifdef csdebug}
  915. var hp: pai;
  916. {$endif csdebug}
  917. Begin {checks whether two Paicpu instructions are equal}
  918. If Assigned(p1) And Assigned(p2) And
  919. (Pai(p1)^.typ = ait_instruction) And
  920. (Pai(p1)^.typ = ait_instruction) And
  921. (Paicpu(p1)^.opcode = Paicpu(p2)^.opcode) And
  922. (Paicpu(p1)^.oper[0].typ = Paicpu(p2)^.oper[0].typ) And
  923. (Paicpu(p1)^.oper[1].typ = Paicpu(p2)^.oper[1].typ) And
  924. (Paicpu(p1)^.oper[2].typ = Paicpu(p2)^.oper[2].typ)
  925. Then
  926. {both instructions have the same structure:
  927. "<operator> <operand of type1>, <operand of type 2>"}
  928. If ((Paicpu(p1)^.opcode = A_MOV) or
  929. (Paicpu(p1)^.opcode = A_MOVZX) or
  930. (Paicpu(p1)^.opcode = A_MOVSX)) And
  931. (Paicpu(p1)^.oper[0].typ = top_ref) {then .oper[1]t = top_reg} Then
  932. If Not(RegInRef(Paicpu(p1)^.oper[1].reg, Paicpu(p1)^.oper[0].ref^)) Then
  933. {the "old" instruction is a load of a register with a new value, not with
  934. a value based on the contents of this register (so no "mov (reg), reg")}
  935. If Not(RegInRef(Paicpu(p2)^.oper[1].reg, Paicpu(p2)^.oper[0].ref^)) And
  936. RefsEqual(Paicpu(p1)^.oper[0].ref^, Paicpu(p2)^.oper[0].ref^)
  937. Then
  938. {the "new" instruction is also a load of a register with a new value, and
  939. this value is fetched from the same memory location}
  940. Begin
  941. With Paicpu(p2)^.oper[0].ref^ Do
  942. Begin
  943. If Not(Base in [procinfo^.FramePointer, R_NO, R_ESP])
  944. {it won't do any harm if the register is already in RegsLoadedForRef}
  945. Then RegInfo.RegsLoadedForRef := RegInfo.RegsLoadedForRef + [Base];
  946. If Not(Index in [procinfo^.FramePointer, R_NO, R_ESP])
  947. Then RegInfo.RegsLoadedForRef := RegInfo.RegsLoadedForRef + [Index];
  948. End;
  949. {add the registers from the reference (.oper[0]) to the RegInfo, all registers
  950. from the reference are the same in the old and in the new instruction
  951. sequence}
  952. AddOp2RegInfo(Paicpu(p1)^.oper[0], RegInfo);
  953. {the registers from .oper[1] have to be equivalent, but not necessarily equal}
  954. InstructionsEquivalent :=
  955. RegsEquivalent(Paicpu(p1)^.oper[1].reg, Paicpu(p2)^.oper[1].reg, RegInfo, OpAct_Write);
  956. End
  957. {the registers are loaded with values from different memory locations. If
  958. this was allowed, the instructions "mov -4(esi),eax" and "mov -4(ebp),eax"
  959. would be considered equivalent}
  960. Else InstructionsEquivalent := False
  961. Else
  962. {load register with a value based on the current value of this register}
  963. Begin
  964. With Paicpu(p2)^.oper[0].ref^ Do
  965. Begin
  966. If Not(Base in [procinfo^.FramePointer,
  967. Reg32(Paicpu(p2)^.oper[1].reg),R_NO,R_ESP])
  968. {it won't do any harm if the register is already in RegsLoadedForRef}
  969. Then
  970. Begin
  971. RegInfo.RegsLoadedForRef := RegInfo.RegsLoadedForRef + [Base];
  972. {$ifdef csdebug}
  973. Writeln(att_reg2str[base], ' added');
  974. {$endif csdebug}
  975. end;
  976. If Not(Index in [procinfo^.FramePointer,
  977. Reg32(Paicpu(p2)^.oper[1].reg),R_NO,R_ESP])
  978. Then
  979. Begin
  980. RegInfo.RegsLoadedForRef := RegInfo.RegsLoadedForRef + [Index];
  981. {$ifdef csdebug}
  982. Writeln(att_reg2str[index], ' added');
  983. {$endif csdebug}
  984. end;
  985. End;
  986. If Not(Reg32(Paicpu(p2)^.oper[1].reg) In [procinfo^.FramePointer,R_NO,R_ESP])
  987. Then
  988. Begin
  989. RegInfo.RegsLoadedForRef := RegInfo.RegsLoadedForRef -
  990. [Reg32(Paicpu(p2)^.oper[1].reg)];
  991. {$ifdef csdebug}
  992. Writeln(att_reg2str[Reg32(Paicpu(p2)^.oper[1].reg)], ' removed');
  993. {$endif csdebug}
  994. end;
  995. InstructionsEquivalent :=
  996. OpsEquivalent(Paicpu(p1)^.oper[0], Paicpu(p2)^.oper[0], RegInfo, OpAct_Read) And
  997. OpsEquivalent(Paicpu(p1)^.oper[1], Paicpu(p2)^.oper[1], RegInfo, OpAct_Write)
  998. End
  999. Else
  1000. {an instruction <> mov, movzx, movsx}
  1001. begin
  1002. {$ifdef csdebug}
  1003. hp := new(pai_asm_comment,init(strpnew('checking if equivalent')));
  1004. hp^.previous := p2;
  1005. hp^.next := p2^.next;
  1006. p2^.next^.previous := hp;
  1007. p2^.next := hp;
  1008. {$endif csdebug}
  1009. InstructionsEquivalent :=
  1010. OpsEquivalent(Paicpu(p1)^.oper[0], Paicpu(p2)^.oper[0], RegInfo, OpAct_Unknown) And
  1011. OpsEquivalent(Paicpu(p1)^.oper[1], Paicpu(p2)^.oper[1], RegInfo, OpAct_Unknown) And
  1012. OpsEquivalent(Paicpu(p1)^.oper[2], Paicpu(p2)^.oper[2], RegInfo, OpAct_Unknown)
  1013. end
  1014. {the instructions haven't even got the same structure, so they're certainly
  1015. not equivalent}
  1016. Else
  1017. begin
  1018. {$ifdef csdebug}
  1019. hp := new(pai_asm_comment,init(strpnew('different opcodes/format')));
  1020. hp^.previous := p2;
  1021. hp^.next := p2^.next;
  1022. p2^.next^.previous := hp;
  1023. p2^.next := hp;
  1024. {$endif csdebug}
  1025. InstructionsEquivalent := False;
  1026. end;
  1027. {$ifdef csdebug}
  1028. hp := new(pai_asm_comment,init(strpnew('instreq: '+tostr(byte(instructionsequivalent)))));
  1029. hp^.previous := p2;
  1030. hp^.next := p2^.next;
  1031. p2^.next^.previous := hp;
  1032. p2^.next := hp;
  1033. {$endif csdebug}
  1034. End;
  1035. (*
  1036. Function InstructionsEqual(p1, p2: Pai): Boolean;
  1037. Begin {checks whether two Paicpu instructions are equal}
  1038. InstructionsEqual :=
  1039. Assigned(p1) And Assigned(p2) And
  1040. ((Pai(p1)^.typ = ait_instruction) And
  1041. (Pai(p1)^.typ = ait_instruction) And
  1042. (Paicpu(p1)^.opcode = Paicpu(p2)^.opcode) And
  1043. (Paicpu(p1)^.oper[0].typ = Paicpu(p2)^.oper[0].typ) And
  1044. (Paicpu(p1)^.oper[1].typ = Paicpu(p2)^.oper[1].typ) And
  1045. OpsEqual(Paicpu(p1)^.oper[0].typ, Paicpu(p1)^.oper[0], Paicpu(p2)^.oper[0]) And
  1046. OpsEqual(Paicpu(p1)^.oper[1].typ, Paicpu(p1)^.oper[1], Paicpu(p2)^.oper[1]))
  1047. End;
  1048. *)
  1049. Procedure ReadReg(p: PPaiProp; Reg: TRegister);
  1050. Begin
  1051. Reg := Reg32(Reg);
  1052. If Reg in [R_EAX..R_EDI] Then
  1053. IncState(p^.Regs[Reg].RState)
  1054. End;
  1055. Procedure ReadRef(p: PPaiProp; Ref: PReference);
  1056. Begin
  1057. If Ref^.Base <> R_NO Then
  1058. ReadReg(p, Ref^.Base);
  1059. If Ref^.Index <> R_NO Then
  1060. ReadReg(p, Ref^.Index);
  1061. End;
  1062. Procedure ReadOp(P: PPaiProp;const o:toper);
  1063. Begin
  1064. Case o.typ Of
  1065. top_reg: ReadReg(P, o.reg);
  1066. top_ref: ReadRef(P, o.ref);
  1067. top_symbol : ;
  1068. End;
  1069. End;
  1070. Function RefInInstruction(Const Ref: TReference; p: Pai;
  1071. RefsEq: TRefCompare): Boolean;
  1072. {checks whehter Ref is used in P}
  1073. Var TmpResult: Boolean;
  1074. Begin
  1075. TmpResult := False;
  1076. If (p^.typ = ait_instruction) Then
  1077. Begin
  1078. If (Paicpu(p)^.oper[0].typ = Top_Ref) Then
  1079. TmpResult := RefsEq(Ref, Paicpu(p)^.oper[0].ref^);
  1080. If Not(TmpResult) And (Paicpu(p)^.oper[1].typ = Top_Ref) Then
  1081. TmpResult := RefsEq(Ref, Paicpu(p)^.oper[1].ref^);
  1082. If Not(TmpResult) And (Paicpu(p)^.oper[2].typ = Top_Ref) Then
  1083. TmpResult := RefsEq(Ref, Paicpu(p)^.oper[2].ref^);
  1084. End;
  1085. RefInInstruction := TmpResult;
  1086. End;
  1087. Function RefInSequence(Const Ref: TReference; Content: TContent;
  1088. RefsEq: TRefCompare): Boolean;
  1089. {checks the whole sequence of Content (so StartMod and and the next NrOfMods
  1090. Pai objects) to see whether Ref is used somewhere}
  1091. Var p: Pai;
  1092. Counter: Byte;
  1093. TmpResult: Boolean;
  1094. Begin
  1095. p := Content.StartMod;
  1096. TmpResult := False;
  1097. Counter := 1;
  1098. While Not(TmpResult) And
  1099. (Counter <= Content.NrOfMods) Do
  1100. Begin
  1101. If (p^.typ = ait_instruction) And
  1102. RefInInstruction(Ref, p, RefsEq)
  1103. Then TmpResult := True;
  1104. Inc(Counter);
  1105. GetNextInstruction(p,p)
  1106. End;
  1107. RefInSequence := TmpResult
  1108. End;
  1109. Function ArrayRefsEq(const r1, r2: TReference): Boolean;{$ifdef tp}far;{$endif}
  1110. Begin
  1111. ArrayRefsEq := (R1.Offset+R1.OffsetFixup = R2.Offset+R2.OffsetFixup) And
  1112. (R1.Segment = R2.Segment) And
  1113. (R1.Symbol=R2.Symbol) And
  1114. ((Assigned(R1.Symbol)) Or
  1115. (R1.Base = R2.Base))
  1116. End;
  1117. Procedure DestroyRefs(p: pai; Const Ref: TReference; WhichReg: TRegister);
  1118. {destroys all registers which possibly contain a reference to Ref, WhichReg
  1119. is the register whose contents are being written to memory (if this proc
  1120. is called because of a "mov?? %reg, (mem)" instruction)}
  1121. Var RefsEq: TRefCompare;
  1122. Counter: TRegister;
  1123. Begin
  1124. WhichReg := Reg32(WhichReg);
  1125. If (Ref.base = procinfo^.FramePointer) or
  1126. Assigned(Ref.Symbol) Then
  1127. Begin
  1128. If (Ref.Index = R_NO) And
  1129. (Not(Assigned(Ref.Symbol)) or
  1130. (Ref.base = R_NO)) Then
  1131. { local variable which is not an array }
  1132. RefsEq := {$ifdef fpc}@{$endif}RefsEqual
  1133. Else
  1134. { local variable which is an array }
  1135. RefsEq := {$ifdef fpc}@{$endif}ArrayRefsEq;
  1136. {write something to a parameter, a local or global variable, so
  1137. * with uncertain optimizations on:
  1138. - destroy the contents of registers whose contents have somewhere a
  1139. "mov?? (Ref), %reg". WhichReg (this is the register whose contents
  1140. are being written to memory) is not destroyed if it's StartMod is
  1141. of that form and NrOfMods = 1 (so if it holds ref, but is not a
  1142. pointer based on Ref)
  1143. * with uncertain optimizations off:
  1144. - also destroy registers that contain any pointer}
  1145. For Counter := R_EAX to R_EDI Do
  1146. With PPaiProp(p^.OptInfo)^.Regs[Counter] Do
  1147. Begin
  1148. If (typ = Con_Ref) And
  1149. ((Not(cs_UncertainOpts in aktglobalswitches) And
  1150. (NrOfMods <> 1)
  1151. ) Or
  1152. (RefInSequence(Ref,PPaiProp(p^.OptInfo)^.Regs[Counter],RefsEq) And
  1153. ((Counter <> WhichReg) Or
  1154. ((NrOfMods <> 1) And
  1155. {StarMod is always of the type ait_instruction}
  1156. (Paicpu(StartMod)^.oper[0].typ = top_ref) And
  1157. RefsEq(Paicpu(StartMod)^.oper[0].ref^, Ref)
  1158. )
  1159. )
  1160. )
  1161. )
  1162. Then
  1163. DestroyReg(PPaiProp(p^.OptInfo), Counter, false)
  1164. End
  1165. End
  1166. Else
  1167. {write something to a pointer location, so
  1168. * with uncertain optimzations on:
  1169. - do not destroy registers which contain a local/global variable or a
  1170. parameter, except if DestroyRefs is called because of a "movsl"
  1171. * with uncertain optimzations off:
  1172. - destroy every register which contains a memory location
  1173. }
  1174. For Counter := R_EAX to R_EDI Do
  1175. With PPaiProp(p^.OptInfo)^.Regs[Counter] Do
  1176. If (typ = Con_Ref) And
  1177. (Not(cs_UncertainOpts in aktglobalswitches) Or
  1178. {for movsl}
  1179. (Ref.Base = R_EDI) Or
  1180. {don't destroy if reg contains a parameter, local or global variable}
  1181. Not((NrOfMods = 1) And
  1182. (Paicpu(StartMod)^.oper[0].typ = top_ref) And
  1183. ((Paicpu(StartMod)^.oper[0].ref^.base = procinfo^.FramePointer) Or
  1184. Assigned(Paicpu(StartMod)^.oper[0].ref^.Symbol)
  1185. )
  1186. )
  1187. )
  1188. Then DestroyReg(PPaiProp(p^.OptInfo), Counter, false)
  1189. End;
  1190. Procedure DestroyAllRegs(p: PPaiProp);
  1191. Var Counter: TRegister;
  1192. Begin {initializes/desrtoys all registers}
  1193. For Counter := R_EAX To R_EDI Do
  1194. Begin
  1195. ReadReg(p, Counter);
  1196. DestroyReg(p, Counter, true);
  1197. End;
  1198. p^.DirFlag := F_Unknown;
  1199. End;
  1200. Procedure DestroyOp(PaiObj: Pai; const o:Toper);
  1201. Begin
  1202. Case o.typ Of
  1203. top_reg: DestroyReg(PPaiProp(PaiObj^.OptInfo), o.reg, true);
  1204. top_ref:
  1205. Begin
  1206. ReadRef(PPaiProp(PaiObj^.OptInfo), o.ref);
  1207. DestroyRefs(PaiObj, o.ref^, R_NO);
  1208. End;
  1209. top_symbol:;
  1210. End;
  1211. End;
  1212. Function DFAPass1(AsmL: PAasmOutput; BlockStart: Pai): Pai;
  1213. {gathers the RegAlloc data... still need to think about where to store it to
  1214. avoid global vars}
  1215. Var BlockEnd: Pai;
  1216. Begin
  1217. BlockEnd := FindLoHiLabels(LoLab, HiLab, LabDif, BlockStart);
  1218. BuildLabelTableAndFixRegAlloc(AsmL, LTable, LoLab, LabDif, BlockStart, BlockEnd);
  1219. DFAPass1 := BlockEnd;
  1220. End;
  1221. {$ifdef arithopt}
  1222. Procedure AddInstr2RegContents({$ifdef statedebug} asml: paasmoutput; {$endif}
  1223. p: paicpu; reg: TRegister);
  1224. {$ifdef statedebug}
  1225. var hp: pai;
  1226. {$endif statedebug}
  1227. Begin
  1228. Reg := Reg32(Reg);
  1229. With PPaiProp(p^.optinfo)^.Regs[reg] Do
  1230. If (Typ = Con_Ref)
  1231. Then
  1232. Begin
  1233. IncState(WState);
  1234. {also store how many instructions are part of the sequence in the first
  1235. instructions PPaiProp, so it can be easily accessed from within
  1236. CheckSequence}
  1237. Inc(NrOfMods, NrOfInstrSinceLastMod[Reg]);
  1238. PPaiProp(Pai(StartMod)^.OptInfo)^.Regs[Reg].NrOfMods := NrOfMods;
  1239. NrOfInstrSinceLastMod[Reg] := 0;
  1240. {$ifdef StateDebug}
  1241. hp := new(pai_asm_comment,init(strpnew(att_reg2str[reg]+': '+tostr(PPaiProp(p^.optinfo)^.Regs[reg].WState)
  1242. + ' -- ' + tostr(PPaiProp(p^.optinfo)^.Regs[reg].nrofmods))));
  1243. InsertLLItem(AsmL, p, p^.next, hp);
  1244. {$endif StateDebug}
  1245. End
  1246. Else
  1247. Begin
  1248. DestroyReg(PPaiProp(p^.optinfo), Reg, true);
  1249. {$ifdef StateDebug}
  1250. hp := new(pai_asm_comment,init(strpnew(att_reg2str[reg]+': '+tostr(PPaiProp(p^.optinfo)^.Regs[reg].WState))));
  1251. InsertLLItem(AsmL, p, p^.next, hp);
  1252. {$endif StateDebug}
  1253. End
  1254. End;
  1255. Procedure AddInstr2OpContents({$ifdef statedebug} asml: paasmoutput; {$endif}
  1256. p: paicpu; const oper: TOper);
  1257. Begin
  1258. If oper.typ = top_reg Then
  1259. AddInstr2RegContents({$ifdef statedebug} asml, {$endif}p, oper.reg)
  1260. Else
  1261. Begin
  1262. ReadOp(PPaiProp(p^.optinfo), oper);
  1263. DestroyOp(p, oper);
  1264. End
  1265. End;
  1266. {$endif arithopt}
  1267. Procedure DoDFAPass2(
  1268. {$Ifdef StateDebug}
  1269. AsmL: PAasmOutput;
  1270. {$endif statedebug}
  1271. BlockStart, BlockEnd: Pai);
  1272. {Analyzes the Data Flow of an assembler list. Starts creating the reg
  1273. contents for the instructions starting with p. Returns the last pai which has
  1274. been processed}
  1275. Var
  1276. CurProp: PPaiProp;
  1277. {$ifdef AnalyzeLoops}
  1278. TmpState: Byte;
  1279. {$endif AnalyzeLoops}
  1280. Cnt, InstrCnt : Longint;
  1281. InstrProp: TInsProp;
  1282. UsedRegs: TRegSet;
  1283. p, hp : Pai;
  1284. TmpRef: TReference;
  1285. TmpReg: TRegister;
  1286. Begin
  1287. p := BlockStart;
  1288. UsedRegs := [];
  1289. UpdateUsedregs(UsedRegs, p);
  1290. SkipHead(P);
  1291. BlockStart := p;
  1292. InstrCnt := 1;
  1293. FillChar(NrOfInstrSinceLastMod, SizeOf(NrOfInstrSinceLastMod), 0);
  1294. While (P <> BlockEnd) Do
  1295. Begin
  1296. {$IfDef TP}
  1297. New(CurProp);
  1298. {$Else TP}
  1299. CurProp := @PaiPropBlock^[InstrCnt];
  1300. {$EndIf TP}
  1301. If (p <> BlockStart)
  1302. Then
  1303. Begin
  1304. {$ifdef JumpAnal}
  1305. If (p^.Typ <> ait_label) Then
  1306. {$endif JumpAnal}
  1307. Begin
  1308. GetLastInstruction(p, hp);
  1309. CurProp^.Regs := PPaiProp(hp^.OptInfo)^.Regs;
  1310. CurProp^.DirFlag := PPaiProp(hp^.OptInfo)^.DirFlag;
  1311. End
  1312. End
  1313. Else
  1314. Begin
  1315. FillChar(CurProp^, SizeOf(CurProp^), 0);
  1316. { For TmpReg := R_EAX to R_EDI Do
  1317. CurProp^.Regs[TmpReg].WState := 1;}
  1318. End;
  1319. CurProp^.UsedRegs := UsedRegs;
  1320. CurProp^.CanBeRemoved := False;
  1321. UpdateUsedRegs(UsedRegs, Pai(p^.Next));
  1322. {$ifdef TP}
  1323. PPaiProp(p^.OptInfo) := CurProp;
  1324. {$Endif TP}
  1325. For TmpReg := R_EAX To R_EDI Do
  1326. Inc(NrOfInstrSinceLastMod[TmpReg]);
  1327. Case p^.typ Of
  1328. ait_label:
  1329. {$Ifndef JumpAnal}
  1330. If (Pai_label(p)^.l^.is_used) Then
  1331. DestroyAllRegs(CurProp);
  1332. {$Else JumpAnal}
  1333. Begin
  1334. If (Pai_Label(p)^.is_used) Then
  1335. With LTable^[Pai_Label(p)^.l^.labelnr-LoLab] Do
  1336. {$IfDef AnalyzeLoops}
  1337. If (RefsFound = Pai_Label(p)^.l^.RefCount)
  1338. {$Else AnalyzeLoops}
  1339. If (JmpsProcessed = Pai_Label(p)^.l^.RefCount)
  1340. {$EndIf AnalyzeLoops}
  1341. Then
  1342. {all jumps to this label have been found}
  1343. {$IfDef AnalyzeLoops}
  1344. If (JmpsProcessed > 0)
  1345. Then
  1346. {$EndIf AnalyzeLoops}
  1347. {we've processed at least one jump to this label}
  1348. Begin
  1349. If (GetLastInstruction(p, hp) And
  1350. Not(((hp^.typ = ait_instruction)) And
  1351. (paicpu_labeled(hp)^.is_jmp))
  1352. Then
  1353. {previous instruction not a JMP -> the contents of the registers after the
  1354. previous intruction has been executed have to be taken into account as well}
  1355. For TmpReg := R_EAX to R_EDI Do
  1356. Begin
  1357. If (CurProp^.Regs[TmpReg].WState <>
  1358. PPaiProp(hp^.OptInfo)^.Regs[TmpReg].WState)
  1359. Then DestroyReg(CurProp, TmpReg, true)
  1360. End
  1361. End
  1362. {$IfDef AnalyzeLoops}
  1363. Else
  1364. {a label from a backward jump (e.g. a loop), no jump to this label has
  1365. already been processed}
  1366. If GetLastInstruction(p, hp) And
  1367. Not(hp^.typ = ait_instruction) And
  1368. (paicpu_labeled(hp)^.opcode = A_JMP))
  1369. Then
  1370. {previous instruction not a jmp, so keep all the registers' contents from the
  1371. previous instruction}
  1372. Begin
  1373. CurProp^.Regs := PPaiProp(hp^.OptInfo)^.Regs;
  1374. CurProp^.DirFlag := PPaiProp(hp^.OptInfo)^.DirFlag;
  1375. End
  1376. Else
  1377. {previous instruction a jmp and no jump to this label processed yet}
  1378. Begin
  1379. hp := p;
  1380. Cnt := InstrCnt;
  1381. {continue until we find a jump to the label or a label which has already
  1382. been processed}
  1383. While GetNextInstruction(hp, hp) And
  1384. Not((hp^.typ = ait_instruction) And
  1385. (paicpu(hp)^.is_jmp) and
  1386. (pasmlabel(paicpu(hp)^.oper[0].sym)^.labelnr = Pai_Label(p)^.l^.labelnr)) And
  1387. Not((hp^.typ = ait_label) And
  1388. (LTable^[Pai_Label(hp)^.l^.labelnr-LoLab].RefsFound
  1389. = Pai_Label(hp)^.l^.RefCount) And
  1390. (LTable^[Pai_Label(hp)^.l^.labelnr-LoLab].JmpsProcessed > 0)) Do
  1391. Inc(Cnt);
  1392. If (hp^.typ = ait_label)
  1393. Then
  1394. {there's a processed label after the current one}
  1395. Begin
  1396. CurProp^.Regs := PaiPropBlock^[Cnt].Regs;
  1397. CurProp^.DirFlag := PaiPropBlock^[Cnt].DirFlag;
  1398. End
  1399. Else
  1400. {there's no label anymore after the current one, or they haven't been
  1401. processed yet}
  1402. Begin
  1403. GetLastInstruction(p, hp);
  1404. CurProp^.Regs := PPaiProp(hp^.OptInfo)^.Regs;
  1405. CurProp^.DirFlag := PPaiProp(hp^.OptInfo)^.DirFlag;
  1406. DestroyAllRegs(PPaiProp(hp^.OptInfo))
  1407. End
  1408. End
  1409. {$EndIf AnalyzeLoops}
  1410. Else
  1411. {not all references to this label have been found, so destroy all registers}
  1412. Begin
  1413. GetLastInstruction(p, hp);
  1414. CurProp^.Regs := PPaiProp(hp^.OptInfo)^.Regs;
  1415. CurProp^.DirFlag := PPaiProp(hp^.OptInfo)^.DirFlag;
  1416. DestroyAllRegs(CurProp)
  1417. End;
  1418. End;
  1419. {$EndIf JumpAnal}
  1420. {$ifdef GDB}
  1421. ait_stabs, ait_stabn, ait_stab_function_name:;
  1422. {$endif GDB}
  1423. ait_align: ; { may destroy flags !!! }
  1424. ait_instruction:
  1425. Begin
  1426. if paicpu(p)^.is_jmp then
  1427. begin
  1428. {$IfNDef JumpAnal}
  1429. ;
  1430. {$Else JumpAnal}
  1431. With LTable^[pasmlabel(paicpu(p)^.oper[0].sym)^.labelnr-LoLab] Do
  1432. If (RefsFound = pasmlabel(paicpu(p)^.oper[0].sym)^.RefCount) Then
  1433. Begin
  1434. If (InstrCnt < InstrNr)
  1435. Then
  1436. {forward jump}
  1437. If (JmpsProcessed = 0) Then
  1438. {no jump to this label has been processed yet}
  1439. Begin
  1440. PaiPropBlock^[InstrNr].Regs := CurProp^.Regs;
  1441. PaiPropBlock^[InstrNr].DirFlag := CurProp^.DirFlag;
  1442. Inc(JmpsProcessed);
  1443. End
  1444. Else
  1445. Begin
  1446. For TmpReg := R_EAX to R_EDI Do
  1447. If (PaiPropBlock^[InstrNr].Regs[TmpReg].WState <>
  1448. CurProp^.Regs[TmpReg].WState) Then
  1449. DestroyReg(@PaiPropBlock^[InstrNr], TmpReg, true);
  1450. Inc(JmpsProcessed);
  1451. End
  1452. {$ifdef AnalyzeLoops}
  1453. Else
  1454. { backward jump, a loop for example}
  1455. { If (JmpsProcessed > 0) Or
  1456. Not(GetLastInstruction(PaiObj, hp) And
  1457. (hp^.typ = ait_labeled_instruction) And
  1458. (paicpu_labeled(hp)^.opcode = A_JMP))
  1459. Then}
  1460. {instruction prior to label is not a jmp, or at least one jump to the label
  1461. has yet been processed}
  1462. Begin
  1463. Inc(JmpsProcessed);
  1464. For TmpReg := R_EAX to R_EDI Do
  1465. If (PaiPropBlock^[InstrNr].Regs[TmpReg].WState <>
  1466. CurProp^.Regs[TmpReg].WState)
  1467. Then
  1468. Begin
  1469. TmpState := PaiPropBlock^[InstrNr].Regs[TmpReg].WState;
  1470. Cnt := InstrNr;
  1471. While (TmpState = PaiPropBlock^[Cnt].Regs[TmpReg].WState) Do
  1472. Begin
  1473. DestroyReg(@PaiPropBlock^[Cnt], TmpReg, true);
  1474. Inc(Cnt);
  1475. End;
  1476. While (Cnt <= InstrCnt) Do
  1477. Begin
  1478. Inc(PaiPropBlock^[Cnt].Regs[TmpReg].WState);
  1479. Inc(Cnt)
  1480. End
  1481. End;
  1482. End
  1483. { Else }
  1484. {instruction prior to label is a jmp and no jumps to the label have yet been
  1485. processed}
  1486. { Begin
  1487. Inc(JmpsProcessed);
  1488. For TmpReg := R_EAX to R_EDI Do
  1489. Begin
  1490. TmpState := PaiPropBlock^[InstrNr].Regs[TmpReg].WState;
  1491. Cnt := InstrNr;
  1492. While (TmpState = PaiPropBlock^[Cnt].Regs[TmpReg].WState) Do
  1493. Begin
  1494. PaiPropBlock^[Cnt].Regs[TmpReg] := CurProp^.Regs[TmpReg];
  1495. Inc(Cnt);
  1496. End;
  1497. TmpState := PaiPropBlock^[InstrNr].Regs[TmpReg].WState;
  1498. While (TmpState = PaiPropBlock^[Cnt].Regs[TmpReg].WState) Do
  1499. Begin
  1500. DestroyReg(@PaiPropBlock^[Cnt], TmpReg, true);
  1501. Inc(Cnt);
  1502. End;
  1503. While (Cnt <= InstrCnt) Do
  1504. Begin
  1505. Inc(PaiPropBlock^[Cnt].Regs[TmpReg].WState);
  1506. Inc(Cnt)
  1507. End
  1508. End
  1509. End}
  1510. {$endif AnalyzeLoops}
  1511. End;
  1512. {$EndIf JumpAnal}
  1513. end
  1514. else
  1515. begin
  1516. InstrProp := InsProp[Paicpu(p)^.opcode];
  1517. Case Paicpu(p)^.opcode Of
  1518. A_MOV, A_MOVZX, A_MOVSX:
  1519. Begin
  1520. Case Paicpu(p)^.oper[0].typ Of
  1521. Top_Reg:
  1522. Case Paicpu(p)^.oper[1].typ Of
  1523. Top_Reg:
  1524. Begin
  1525. DestroyReg(CurProp, Paicpu(p)^.oper[1].reg, true);
  1526. ReadReg(CurProp, Paicpu(p)^.oper[0].reg);
  1527. { CurProp^.Regs[Paicpu(p)^.oper[1].reg] :=
  1528. CurProp^.Regs[Paicpu(p)^.oper[0].reg];
  1529. If (CurProp^.Regs[Paicpu(p)^.oper[1].reg].ModReg = R_NO) Then
  1530. CurProp^.Regs[Paicpu(p)^.oper[1].reg].ModReg :=
  1531. Paicpu(p)^.oper[0].reg;}
  1532. End;
  1533. Top_Ref:
  1534. Begin
  1535. ReadReg(CurProp, Paicpu(p)^.oper[0].reg);
  1536. ReadRef(CurProp, Paicpu(p)^.oper[1].ref);
  1537. DestroyRefs(p, Paicpu(p)^.oper[1].ref^, Paicpu(p)^.oper[0].reg);
  1538. End;
  1539. End;
  1540. Top_Ref:
  1541. Begin {destination is always a register in this case}
  1542. ReadRef(CurProp, Paicpu(p)^.oper[0].ref);
  1543. ReadReg(CurProp, Paicpu(p)^.oper[1].reg);
  1544. TmpReg := Reg32(Paicpu(p)^.oper[1].reg);
  1545. If RegInRef(TmpReg, Paicpu(p)^.oper[0].ref^) And
  1546. (CurProp^.Regs[TmpReg].Typ = Con_Ref)
  1547. Then
  1548. Begin
  1549. With CurProp^.Regs[TmpReg] Do
  1550. Begin
  1551. IncState(WState);
  1552. {also store how many instructions are part of the sequence in the first
  1553. instructions PPaiProp, so it can be easily accessed from within
  1554. CheckSequence}
  1555. Inc(NrOfMods, NrOfInstrSinceLastMod[TmpReg]);
  1556. PPaiProp(Pai(StartMod)^.OptInfo)^.Regs[TmpReg].NrOfMods := NrOfMods;
  1557. NrOfInstrSinceLastMod[TmpReg] := 0;
  1558. End;
  1559. End
  1560. Else
  1561. Begin
  1562. DestroyReg(CurProp, TmpReg, true);
  1563. If Not(RegInRef(TmpReg, Paicpu(p)^.oper[0].ref^)) Then
  1564. With CurProp^.Regs[TmpReg] Do
  1565. Begin
  1566. Typ := Con_Ref;
  1567. StartMod := p;
  1568. NrOfMods := 1;
  1569. End
  1570. End;
  1571. {$ifdef StateDebug}
  1572. hp := new(pai_asm_comment,init(strpnew(att_reg2str[TmpReg]+': '+tostr(CurProp^.Regs[TmpReg].WState))));
  1573. InsertLLItem(AsmL, p, p^.next, hp);
  1574. {$endif StateDebug}
  1575. End;
  1576. Top_Const:
  1577. Begin
  1578. Case Paicpu(p)^.oper[1].typ Of
  1579. Top_Reg:
  1580. Begin
  1581. TmpReg := Reg32(Paicpu(p)^.oper[1].reg);
  1582. With CurProp^.Regs[TmpReg] Do
  1583. Begin
  1584. DestroyReg(CurProp, TmpReg, true);
  1585. typ := Con_Const;
  1586. StartMod := p;
  1587. End
  1588. End;
  1589. Top_Ref:
  1590. Begin
  1591. ReadRef(CurProp, Paicpu(p)^.oper[1].ref);
  1592. DestroyRefs(P, Paicpu(p)^.oper[1].ref^, R_NO);
  1593. End;
  1594. End;
  1595. End;
  1596. End;
  1597. End;
  1598. A_DIV, A_IDIV, A_MUL:
  1599. Begin
  1600. ReadOp(Curprop, Paicpu(p)^.oper[0]);
  1601. ReadReg(CurProp,R_EAX);
  1602. If (Paicpu(p)^.OpCode = A_IDIV) or
  1603. (Paicpu(p)^.OpCode = A_DIV) Then
  1604. ReadReg(CurProp,R_EDX);
  1605. DestroyReg(CurProp, R_EAX, true);
  1606. DestroyReg(CurProp, R_EDX, true)
  1607. End;
  1608. A_IMUL:
  1609. Begin
  1610. ReadOp(CurProp,Paicpu(p)^.oper[0]);
  1611. ReadOp(CurProp,Paicpu(p)^.oper[1]);
  1612. If (Paicpu(p)^.oper[2].typ = top_none) Then
  1613. If (Paicpu(p)^.oper[1].typ = top_none) Then
  1614. Begin
  1615. ReadReg(CurProp,R_EAX);
  1616. DestroyReg(CurProp, R_EAX, true);
  1617. DestroyReg(CurProp, R_EDX, true)
  1618. End
  1619. Else
  1620. {$ifdef arithopt}
  1621. AddInstr2OpContents(Paicpu(p), Paicpu(p)^.oper[1])
  1622. {$else arithopt}
  1623. DestroyOp(p, Paicpu(p)^.oper[1])
  1624. {$endif arithopt}
  1625. Else
  1626. {$ifdef arithopt}
  1627. AddInstr2OpContents(Paicpu(p), Paicpu(p)^.oper[2]);
  1628. {$else arithopt}
  1629. DestroyOp(p, Paicpu(p)^.oper[2]);
  1630. {$endif arithopt}
  1631. End;
  1632. A_XOR:
  1633. Begin
  1634. ReadOp(CurProp, Paicpu(p)^.oper[0]);
  1635. ReadOp(CurProp, Paicpu(p)^.oper[1]);
  1636. If (Paicpu(p)^.oper[0].typ = top_reg) And
  1637. (Paicpu(p)^.oper[1].typ = top_reg) And
  1638. (Paicpu(p)^.oper[0].reg = Paicpu(p)^.oper[1].reg)
  1639. Then
  1640. Begin
  1641. DestroyReg(CurProp, Paicpu(p)^.oper[0].reg, true);
  1642. CurProp^.Regs[Reg32(Paicpu(p)^.oper[0].reg)].typ := Con_Const;
  1643. CurProp^.Regs[Reg32(Paicpu(p)^.oper[0].reg)].StartMod := Pointer(0)
  1644. End
  1645. Else
  1646. DestroyOp(p, Paicpu(p)^.oper[1]);
  1647. End
  1648. Else
  1649. Begin
  1650. Cnt := 1;
  1651. While (Cnt <= MaxCh) And
  1652. (InstrProp.Ch[Cnt] <> Ch_None) Do
  1653. Begin
  1654. Case InstrProp.Ch[Cnt] Of
  1655. Ch_REAX..Ch_REDI: ReadReg(CurProp,TCh2Reg(InstrProp.Ch[Cnt]));
  1656. Ch_WEAX..Ch_RWEDI:
  1657. Begin
  1658. If (InstrProp.Ch[Cnt] >= Ch_RWEAX) Then
  1659. ReadReg(CurProp, TCh2Reg(InstrProp.Ch[Cnt]));
  1660. DestroyReg(CurProp, TCh2Reg(InstrProp.Ch[Cnt]), true);
  1661. End;
  1662. {$ifdef arithopt}
  1663. Ch_MEAX..Ch_MEDI:
  1664. AddInstr2RegContents({$ifdef statedebug} asml, {$endif}
  1665. Paicpu(p),
  1666. TCh2Reg(InstrProp.Ch[Cnt]));
  1667. {$endif arithopt}
  1668. Ch_CDirFlag: CurProp^.DirFlag := F_NotSet;
  1669. Ch_SDirFlag: CurProp^.DirFlag := F_Set;
  1670. Ch_Rop1: ReadOp(CurProp, Paicpu(p)^.oper[0]);
  1671. Ch_Rop2: ReadOp(CurProp, Paicpu(p)^.oper[1]);
  1672. Ch_ROp3: ReadOp(CurProp, Paicpu(p)^.oper[2]);
  1673. Ch_Wop1..Ch_RWop1:
  1674. Begin
  1675. If (InstrProp.Ch[Cnt] in [Ch_RWop1]) Then
  1676. ReadOp(CurProp, Paicpu(p)^.oper[0]);
  1677. DestroyOp(p, Paicpu(p)^.oper[0]);
  1678. End;
  1679. {$ifdef arithopt}
  1680. Ch_Mop1:
  1681. AddInstr2OpContents({$ifdef statedebug} asml, {$endif}
  1682. Paicpu(p), Paicpu(p)^.oper[0]);
  1683. {$endif arithopt}
  1684. Ch_Wop2..Ch_RWop2:
  1685. Begin
  1686. If (InstrProp.Ch[Cnt] = Ch_RWop2) Then
  1687. ReadOp(CurProp, Paicpu(p)^.oper[1]);
  1688. DestroyOp(p, Paicpu(p)^.oper[1]);
  1689. End;
  1690. {$ifdef arithopt}
  1691. Ch_Mop2:
  1692. AddInstr2OpContents({$ifdef statedebug} asml, {$endif}
  1693. Paicpu(p), Paicpu(p)^.oper[1]);
  1694. {$endif arithopt}
  1695. Ch_WOp3..Ch_RWOp3:
  1696. Begin
  1697. If (InstrProp.Ch[Cnt] = Ch_RWOp3) Then
  1698. ReadOp(CurProp, Paicpu(p)^.oper[2]);
  1699. DestroyOp(p, Paicpu(p)^.oper[2]);
  1700. End;
  1701. {$ifdef arithopt}
  1702. Ch_Mop3:
  1703. AddInstr2OpContents({$ifdef statedebug} asml, {$endif}
  1704. Paicpu(p), Paicpu(p)^.oper[2]);
  1705. {$endif arithopt}
  1706. Ch_WMemEDI:
  1707. Begin
  1708. ReadReg(CurProp, R_EDI);
  1709. FillChar(TmpRef, SizeOf(TmpRef), 0);
  1710. TmpRef.Base := R_EDI;
  1711. DestroyRefs(p, TmpRef, R_NO)
  1712. End;
  1713. Ch_RFlags, Ch_WFlags, Ch_RWFlags, Ch_FPU:
  1714. Else
  1715. Begin
  1716. DestroyAllRegs(CurProp);
  1717. End;
  1718. End;
  1719. Inc(Cnt);
  1720. End
  1721. End;
  1722. end;
  1723. End;
  1724. End
  1725. Else
  1726. Begin
  1727. DestroyAllRegs(CurProp);
  1728. End;
  1729. End;
  1730. Inc(InstrCnt);
  1731. GetNextInstruction(p, p);
  1732. End;
  1733. End;
  1734. Function InitDFAPass2(BlockStart, BlockEnd: Pai): Boolean;
  1735. {reserves memory for the PPaiProps in one big memory block when not using
  1736. TP, returns False if not enough memory is available for the optimizer in all
  1737. cases}
  1738. Var p: Pai;
  1739. Count: Longint;
  1740. { TmpStr: String; }
  1741. Begin
  1742. P := BlockStart;
  1743. SkipHead(P);
  1744. NrOfPaiObjs := 0;
  1745. While (P <> BlockEnd) Do
  1746. Begin
  1747. {$IfDef JumpAnal}
  1748. Case P^.Typ Of
  1749. ait_label:
  1750. Begin
  1751. If (Pai_Label(p)^.l^.is_used) Then
  1752. LTable^[Pai_Label(P)^.l^.labelnr-LoLab].InstrNr := NrOfPaiObjs
  1753. End;
  1754. ait_instruction:
  1755. begin
  1756. if paicpu(p)^.is_jmp then
  1757. begin
  1758. If (pasmlabel(paicpu(P)^.oper[0].sym)^.labelnr >= LoLab) And
  1759. (pasmlabel(paicpu(P)^.oper[0].sym)^.labelnr <= HiLab) Then
  1760. Inc(LTable^[pasmlabel(paicpu(P)^.oper[0].sym)^.labelnr-LoLab].RefsFound);
  1761. end;
  1762. end;
  1763. { ait_instruction:
  1764. Begin
  1765. If (Paicpu(p)^.opcode = A_PUSH) And
  1766. (Paicpu(p)^.oper[0].typ = top_symbol) And
  1767. (PCSymbol(Paicpu(p)^.oper[0])^.offset = 0) Then
  1768. Begin
  1769. TmpStr := StrPas(PCSymbol(Paicpu(p)^.oper[0])^.symbol);
  1770. If}
  1771. End;
  1772. {$EndIf JumpAnal}
  1773. Inc(NrOfPaiObjs);
  1774. GetNextInstruction(p, p);
  1775. End;
  1776. {$IfDef TP}
  1777. If (MemAvail < (SizeOf(TPaiProp)*NrOfPaiObjs))
  1778. Or (NrOfPaiObjs = 0)
  1779. {this doesn't have to be one contiguous block}
  1780. Then InitDFAPass2 := False
  1781. Else InitDFAPass2 := True;
  1782. {$Else}
  1783. {Uncomment the next line to see how much memory the reloading optimizer needs}
  1784. { Writeln((NrOfPaiObjs*(((SizeOf(TPaiProp)+3)div 4)*4)));}
  1785. {no need to check mem/maxavail, we've got as much virtual memory as we want}
  1786. If NrOfPaiObjs <> 0 Then
  1787. Begin
  1788. InitDFAPass2 := True;
  1789. GetMem(PaiPropBlock, NrOfPaiObjs*(((SizeOf(TPaiProp)+3)div 4)*4));
  1790. p := BlockStart;
  1791. SkipHead(p);
  1792. For Count := 1 To NrOfPaiObjs Do
  1793. Begin
  1794. PPaiProp(p^.OptInfo) := @PaiPropBlock^[Count];
  1795. GetNextInstruction(p, p);
  1796. End;
  1797. End
  1798. Else InitDFAPass2 := False;
  1799. {$EndIf TP}
  1800. End;
  1801. Function DFAPass2(
  1802. {$ifdef statedebug}
  1803. AsmL: PAasmOutPut;
  1804. {$endif statedebug}
  1805. BlockStart, BlockEnd: Pai): Boolean;
  1806. Begin
  1807. If InitDFAPass2(BlockStart, BlockEnd) Then
  1808. Begin
  1809. DoDFAPass2(
  1810. {$ifdef statedebug}
  1811. asml,
  1812. {$endif statedebug}
  1813. BlockStart, BlockEnd);
  1814. DFAPass2 := True
  1815. End
  1816. Else DFAPass2 := False;
  1817. End;
  1818. Procedure ShutDownDFA;
  1819. Begin
  1820. If LabDif <> 0 Then
  1821. FreeMem(LTable, LabDif*SizeOf(TLabelTableItem));
  1822. End;
  1823. End.
  1824. {
  1825. $Log$
  1826. Revision 1.72 1999-11-21 13:06:30 jonas
  1827. * improved fixing of missing regallocs (they're almost all correct
  1828. now!)
  1829. Revision 1.71 1999/11/20 12:50:32 jonas
  1830. * fixed small typo (C_M* -> Ch_M*) so -darithopt compiles again
  1831. Revision 1.70 1999/11/14 11:25:38 jonas
  1832. * fixed stupid typo in previous commit :(
  1833. Revision 1.69 1999/11/13 19:01:51 jonas
  1834. * div, idiv and mul destroy edx!!
  1835. Revision 1.68 1999/11/07 14:57:09 jonas
  1836. * much more complete/waterproof RegModifiedByInstruction()
  1837. Revision 1.67 1999/11/06 14:34:20 peter
  1838. * truncated log to 20 revs
  1839. Revision 1.66 1999/11/05 16:01:46 jonas
  1840. + first implementation of choosing least used register for alignment code
  1841. (not yet working, between ifdef alignreg)
  1842. Revision 1.65 1999/10/27 16:11:28 peter
  1843. * insns.dat is used to generate all i386*.inc files
  1844. Revision 1.64 1999/10/23 14:44:24 jonas
  1845. * finally got around making GetNextInstruction return false when
  1846. the current pai object is a AsmBlockStart marker
  1847. * changed a loop in aopt386 which was incompatible with this change
  1848. Revision 1.63 1999/10/14 14:57:52 florian
  1849. - removed the hcodegen use in the new cg, use cgbase instead
  1850. Revision 1.62 1999/10/07 16:07:35 jonas
  1851. * small bugfix in ArrayRefsEq
  1852. Revision 1.61 1999/09/29 13:49:53 jonas
  1853. * writing to a position in an array now only destroys registers
  1854. containing a reference pointing somewhere in that array (since my last
  1855. fix, it behaved like a write to a pointer location)
  1856. Revision 1.60 1999/09/27 23:44:50 peter
  1857. * procinfo is now a pointer
  1858. * support for result setting in sub procedure
  1859. Revision 1.59 1999/09/21 15:46:58 jonas
  1860. * fixed bug in destroyrefs (indexes are now handled as pointers)
  1861. Revision 1.58 1999/09/05 12:37:50 jonas
  1862. * fixed typo's in -darithopt
  1863. Revision 1.57 1999/08/25 12:00:00 jonas
  1864. * changed pai386, paippc and paiapha (same for tai*) to paicpu (taicpu)
  1865. Revision 1.56 1999/08/18 13:25:54 jonas
  1866. * minor fixes regarding the reading of operands
  1867. Revision 1.55 1999/08/12 14:36:03 peter
  1868. + KNI instructions
  1869. Revision 1.54 1999/08/05 15:01:52 jonas
  1870. * fix in -darithopt code (sometimes crashed on 8/16bit regs)
  1871. Revision 1.53 1999/08/04 00:22:59 florian
  1872. * renamed i386asm and i386base to cpuasm and cpubase
  1873. Revision 1.52 1999/08/02 14:35:21 jonas
  1874. * bugfix in DestroyRefs
  1875. Revision 1.51 1999/08/02 12:12:53 jonas
  1876. * also add arithmetic operations to instruction sequences contained in registers
  1877. (compile with -darithopt, very nice!)
  1878. Revision 1.50 1999/07/30 18:18:51 jonas
  1879. * small bugfix in instructionsequal
  1880. * small bugfix in reginsequence
  1881. * made regininstruction a bit more logical
  1882. Revision 1.48 1999/07/01 18:21:21 jonas
  1883. * removed unused AsmL parameter from FindLoHiLabels
  1884. Revision 1.47 1999/05/27 19:44:24 peter
  1885. * removed oldasm
  1886. * plabel -> pasmlabel
  1887. * -a switches to source writing automaticly
  1888. * assembler readers OOPed
  1889. * asmsymbol automaticly external
  1890. * jumptables and other label fixes for asm readers
  1891. Revision 1.46 1999/05/08 20:40:02 jonas
  1892. * seperate OPTimizer INFO pointer field in tai object
  1893. * fix to GetLastInstruction that sometimes caused a crash
  1894. }