daopt386.pas 81 KB

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