daopt386.pas 84 KB

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