daopt386.pas 79 KB

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