daopt386.pas 83 KB

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