daopt386.pas 82 KB

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