daopt386.pas 71 KB

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