daopt386.pas 78 KB

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