daopt386.pas 70 KB

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