daopt386.pas 99 KB

1234567891011121314151617181920212223242526272829303132333435363738394041424344454647484950515253545556575859606162636465666768697071727374757677787980818283848586878889909192939495969798991001011021031041051061071081091101111121131141151161171181191201211221231241251261271281291301311321331341351361371381391401411421431441451461471481491501511521531541551561571581591601611621631641651661671681691701711721731741751761771781791801811821831841851861871881891901911921931941951961971981992002012022032042052062072082092102112122132142152162172182192202212222232242252262272282292302312322332342352362372382392402412422432442452462472482492502512522532542552562572582592602612622632642652662672682692702712722732742752762772782792802812822832842852862872882892902912922932942952962972982993003013023033043053063073083093103113123133143153163173183193203213223233243253263273283293303313323333343353363373383393403413423433443453463473483493503513523533543553563573583593603613623633643653663673683693703713723733743753763773783793803813823833843853863873883893903913923933943953963973983994004014024034044054064074084094104114124134144154164174184194204214224234244254264274284294304314324334344354364374384394404414424434444454464474484494504514524534544554564574584594604614624634644654664674684694704714724734744754764774784794804814824834844854864874884894904914924934944954964974984995005015025035045055065075085095105115125135145155165175185195205215225235245255265275285295305315325335345355365375385395405415425435445455465475485495505515525535545555565575585595605615625635645655665675685695705715725735745755765775785795805815825835845855865875885895905915925935945955965975985996006016026036046056066076086096106116126136146156166176186196206216226236246256266276286296306316326336346356366376386396406416426436446456466476486496506516526536546556566576586596606616626636646656666676686696706716726736746756766776786796806816826836846856866876886896906916926936946956966976986997007017027037047057067077087097107117127137147157167177187197207217227237247257267277287297307317327337347357367377387397407417427437447457467477487497507517527537547557567577587597607617627637647657667677687697707717727737747757767777787797807817827837847857867877887897907917927937947957967977987998008018028038048058068078088098108118128138148158168178188198208218228238248258268278288298308318328338348358368378388398408418428438448458468478488498508518528538548558568578588598608618628638648658668678688698708718728738748758768778788798808818828838848858868878888898908918928938948958968978988999009019029039049059069079089099109119129139149159169179189199209219229239249259269279289299309319329339349359369379389399409419429439449459469479489499509519529539549559569579589599609619629639649659669679689699709719729739749759769779789799809819829839849859869879889899909919929939949959969979989991000100110021003100410051006100710081009101010111012101310141015101610171018101910201021102210231024102510261027102810291030103110321033103410351036103710381039104010411042104310441045104610471048104910501051105210531054105510561057105810591060106110621063106410651066106710681069107010711072107310741075107610771078107910801081108210831084108510861087108810891090109110921093109410951096109710981099110011011102110311041105110611071108110911101111111211131114111511161117111811191120112111221123112411251126112711281129113011311132113311341135113611371138113911401141114211431144114511461147114811491150115111521153115411551156115711581159116011611162116311641165116611671168116911701171117211731174117511761177117811791180118111821183118411851186118711881189119011911192119311941195119611971198119912001201120212031204120512061207120812091210121112121213121412151216121712181219122012211222122312241225122612271228122912301231123212331234123512361237123812391240124112421243124412451246124712481249125012511252125312541255125612571258125912601261126212631264126512661267126812691270127112721273127412751276127712781279128012811282128312841285128612871288128912901291129212931294129512961297129812991300130113021303130413051306130713081309131013111312131313141315131613171318131913201321132213231324132513261327132813291330133113321333133413351336133713381339134013411342134313441345134613471348134913501351135213531354135513561357135813591360136113621363136413651366136713681369137013711372137313741375137613771378137913801381138213831384138513861387138813891390139113921393139413951396139713981399140014011402140314041405140614071408140914101411141214131414141514161417141814191420142114221423142414251426142714281429143014311432143314341435143614371438143914401441144214431444144514461447144814491450145114521453145414551456145714581459146014611462146314641465146614671468146914701471147214731474147514761477147814791480148114821483148414851486148714881489149014911492149314941495149614971498149915001501150215031504150515061507150815091510151115121513151415151516151715181519152015211522152315241525152615271528152915301531153215331534153515361537153815391540154115421543154415451546154715481549155015511552155315541555155615571558155915601561156215631564156515661567156815691570157115721573157415751576157715781579158015811582158315841585158615871588158915901591159215931594159515961597159815991600160116021603160416051606160716081609161016111612161316141615161616171618161916201621162216231624162516261627162816291630163116321633163416351636163716381639164016411642164316441645164616471648164916501651165216531654165516561657165816591660166116621663166416651666166716681669167016711672167316741675167616771678167916801681168216831684168516861687168816891690169116921693169416951696169716981699170017011702170317041705170617071708170917101711171217131714171517161717171817191720172117221723172417251726172717281729173017311732173317341735173617371738173917401741174217431744174517461747174817491750175117521753175417551756175717581759176017611762176317641765176617671768176917701771177217731774177517761777177817791780178117821783178417851786178717881789179017911792179317941795179617971798179918001801180218031804180518061807180818091810181118121813181418151816181718181819182018211822182318241825182618271828182918301831183218331834183518361837183818391840184118421843184418451846184718481849185018511852185318541855185618571858185918601861186218631864186518661867186818691870187118721873187418751876187718781879188018811882188318841885188618871888188918901891189218931894189518961897189818991900190119021903190419051906190719081909191019111912191319141915191619171918191919201921192219231924192519261927192819291930193119321933193419351936193719381939194019411942194319441945194619471948194919501951195219531954195519561957195819591960196119621963196419651966196719681969197019711972197319741975197619771978197919801981198219831984198519861987198819891990199119921993199419951996199719981999200020012002200320042005200620072008200920102011201220132014201520162017201820192020202120222023202420252026202720282029203020312032203320342035203620372038203920402041204220432044204520462047204820492050205120522053205420552056205720582059206020612062206320642065206620672068206920702071207220732074207520762077207820792080208120822083208420852086208720882089209020912092209320942095209620972098209921002101210221032104210521062107210821092110211121122113211421152116211721182119212021212122212321242125212621272128212921302131213221332134213521362137213821392140214121422143214421452146214721482149215021512152215321542155215621572158215921602161216221632164216521662167216821692170217121722173217421752176217721782179218021812182218321842185218621872188218921902191219221932194219521962197219821992200220122022203220422052206220722082209221022112212221322142215221622172218221922202221222222232224222522262227222822292230223122322233223422352236223722382239224022412242224322442245224622472248224922502251225222532254225522562257225822592260226122622263226422652266226722682269227022712272227322742275227622772278227922802281228222832284228522862287228822892290229122922293229422952296229722982299230023012302230323042305230623072308230923102311231223132314231523162317231823192320232123222323232423252326232723282329233023312332233323342335233623372338233923402341234223432344234523462347234823492350235123522353235423552356235723582359236023612362236323642365236623672368236923702371237223732374237523762377237823792380238123822383238423852386238723882389239023912392239323942395239623972398239924002401240224032404240524062407240824092410241124122413241424152416241724182419242024212422242324242425242624272428242924302431243224332434243524362437243824392440244124422443244424452446244724482449245024512452245324542455245624572458245924602461246224632464246524662467246824692470247124722473247424752476247724782479248024812482248324842485248624872488248924902491249224932494249524962497249824992500250125022503250425052506250725082509251025112512251325142515251625172518251925202521252225232524252525262527252825292530253125322533253425352536253725382539254025412542254325442545254625472548254925502551255225532554255525562557255825592560256125622563256425652566256725682569257025712572257325742575257625772578257925802581258225832584258525862587258825892590259125922593259425952596259725982599260026012602260326042605260626072608260926102611261226132614261526162617261826192620262126222623262426252626262726282629263026312632263326342635263626372638263926402641264226432644264526462647264826492650265126522653265426552656265726582659266026612662266326642665266626672668266926702671267226732674267526762677267826792680268126822683268426852686268726882689269026912692269326942695269626972698269927002701270227032704270527062707270827092710271127122713271427152716271727182719272027212722272327242725272627272728272927302731273227332734273527362737273827392740274127422743274427452746274727482749275027512752275327542755275627572758275927602761276227632764276527662767276827692770277127722773277427752776277727782779278027812782278327842785278627872788278927902791279227932794279527962797279827992800280128022803280428052806280728082809281028112812281328142815281628172818281928202821282228232824282528262827282828292830283128322833283428352836283728382839284028412842284328442845284628472848284928502851285228532854285528562857285828592860286128622863286428652866286728682869287028712872287328742875287628772878287928802881288228832884288528862887288828892890289128922893289428952896289728982899290029012902290329042905290629072908290929102911291229132914291529162917291829192920292129222923
  1. {
  2. $Id$
  3. Copyright (c) 1998-2002 by Jonas Maebe, member of the Freepascal
  4. development team
  5. This unit contains the data flow analyzer and several helper procedures
  6. and functions.
  7. This program is free software; you can redistribute it and/or modify
  8. it under the terms of the GNU General Public License as published by
  9. the Free Software Foundation; either version 2 of the License, or
  10. (at your option) any later version.
  11. This program is distributed in the hope that it will be useful,
  12. but WITHOUT ANY WARRANTY; without even the implied warranty of
  13. MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
  14. GNU General Public License for more details.
  15. You should have received a copy of the GNU General Public License
  16. along with this program; if not, write to the Free Software
  17. Foundation, inc., 675 Mass Ave, Cambridge, MA 02139, USA.
  18. ****************************************************************************
  19. }
  20. unit daopt386;
  21. {$i fpcdefs.inc}
  22. interface
  23. uses
  24. globtype,
  25. cclasses,aasmbase,aasmtai,aasmcpu,cgbase,
  26. cpubase,optbase;
  27. {******************************* Constants *******************************}
  28. const
  29. { Possible register content types }
  30. con_Unknown = 0;
  31. con_ref = 1;
  32. con_const = 2;
  33. { The contents aren't usable anymore for CSE, but they may still be }
  34. { usefull for detecting whether the result of a load is actually used }
  35. con_invalid = 3;
  36. { the reverse of the above (in case a (conditional) jump is encountered): }
  37. { CSE is still possible, but the original instruction can't be removed }
  38. con_noRemoveRef = 4;
  39. { same, but for constants }
  40. con_noRemoveConst = 5;
  41. {********************************* Types *********************************}
  42. type
  43. TRegArray = Array[RS_EAX..RS_ESP] of tsuperregister;
  44. TRegSet = Set of RS_EAX..RS_ESP;
  45. toptreginfo = Record
  46. NewRegsEncountered, OldRegsEncountered: TRegSet;
  47. RegsLoadedForRef: TRegSet;
  48. regsStillUsedAfterSeq: TRegSet;
  49. lastReload: array[RS_EAX..RS_ESP] of tai;
  50. New2OldReg: TRegArray;
  51. end;
  52. {possible actions on an operand: read, write or modify (= read & write)}
  53. TOpAction = (OpAct_Read, OpAct_Write, OpAct_Modify, OpAct_Unknown);
  54. {the possible states of a flag}
  55. TFlagContents = (F_Unknown, F_notSet, F_Set);
  56. TContent = Packed Record
  57. {start and end of block instructions that defines the
  58. content of this register.}
  59. StartMod: tai;
  60. MemWrite: taicpu;
  61. {how many instructions starting with StarMod does the block consist of}
  62. NrOfMods: Word;
  63. {the type of the content of the register: unknown, memory, constant}
  64. Typ: Byte;
  65. case byte of
  66. {starts at 0, gets increased everytime the register is written to}
  67. 1: (WState: Byte;
  68. {starts at 0, gets increased everytime the register is read from}
  69. RState: Byte);
  70. { to compare both states in one operation }
  71. 2: (state: word);
  72. end;
  73. {Contents of the integer registers}
  74. TRegContent = Array[RS_EAX..RS_ESP] Of TContent;
  75. {contents of the FPU registers}
  76. // TRegFPUContent = Array[RS_ST..RS_ST7] Of TContent;
  77. {$ifdef tempOpts}
  78. { linked list which allows searching/deleting based on value, no extra frills}
  79. PSearchLinkedListItem = ^TSearchLinkedListItem;
  80. TSearchLinkedListItem = object(TLinkedList_Item)
  81. constructor init;
  82. function equals(p: PSearchLinkedListItem): boolean; virtual;
  83. end;
  84. PSearchDoubleIntItem = ^TSearchDoubleInttem;
  85. TSearchDoubleIntItem = object(TLinkedList_Item)
  86. constructor init(_int1,_int2: longint);
  87. function equals(p: PSearchLinkedListItem): boolean; virtual;
  88. private
  89. int1, int2: longint;
  90. end;
  91. PSearchLinkedList = ^TSearchLinkedList;
  92. TSearchLinkedList = object(TLinkedList)
  93. function searchByValue(p: PSearchLinkedListItem): boolean;
  94. procedure removeByValue(p: PSearchLinkedListItem);
  95. end;
  96. {$endif tempOpts}
  97. {information record with the contents of every register. Every tai object
  98. gets one of these assigned: a pointer to it is stored in the OptInfo field}
  99. TtaiProp = Record
  100. Regs: TRegContent;
  101. { FPURegs: TRegFPUContent;} {currently not yet used}
  102. { allocated Registers }
  103. UsedRegs: TRegSet;
  104. { status of the direction flag }
  105. DirFlag: TFlagContents;
  106. {$ifdef tempOpts}
  107. { currently used temps }
  108. tempAllocs: PSearchLinkedList;
  109. {$endif tempOpts}
  110. { can this instruction be removed? }
  111. CanBeRemoved: Boolean;
  112. { are the resultflags set by this instruction used? }
  113. FlagsUsed: Boolean;
  114. end;
  115. ptaiprop = ^TtaiProp;
  116. TtaiPropBlock = Array[1..250000] Of TtaiProp;
  117. PtaiPropBlock = ^TtaiPropBlock;
  118. TInstrSinceLastMod = Array[RS_EAX..RS_ESP] Of Word;
  119. TLabelTableItem = Record
  120. taiObj: tai;
  121. {$ifDef JumpAnal}
  122. InstrNr: Longint;
  123. RefsFound: Word;
  124. JmpsProcessed: Word
  125. {$endif JumpAnal}
  126. end;
  127. TLabelTable = Array[0..2500000] Of TLabelTableItem;
  128. PLabelTable = ^TLabelTable;
  129. {*********************** procedures and functions ************************}
  130. procedure InsertLLItem(AsmL: TAAsmOutput; prev, foll, new_one: TLinkedListItem);
  131. function RefsEquivalent(const R1, R2: TReference; var RegInfo: toptreginfo; OpAct: TOpAction): Boolean;
  132. function RefsEqual(const R1, R2: TReference): Boolean;
  133. function isgp32reg(supreg: tsuperregister): Boolean;
  134. function reginref(supreg: tsuperregister; const ref: treference): boolean;
  135. function RegReadByInstruction(supreg: tsuperregister; hp: tai): boolean;
  136. function RegModifiedByInstruction(supreg: tsuperregister; p1: tai): boolean;
  137. function RegInInstruction(supreg: tsuperregister; p1: tai): boolean;
  138. function reginop(supreg: tsuperregister; const o:toper): boolean;
  139. function instrWritesFlags(p: tai): boolean;
  140. function instrReadsFlags(p: tai): boolean;
  141. function writeToMemDestroysContents(regWritten: tsuperregister; const ref: treference;
  142. supreg: tsuperregister; const c: tcontent; var invalsmemwrite: boolean): boolean;
  143. function writeToRegDestroysContents(destReg, supreg: tsuperregister;
  144. const c: tcontent): boolean;
  145. function writeDestroysContents(const op: toper; supreg: tsuperregister;
  146. const c: tcontent; var memwritedestroyed: boolean): boolean;
  147. function GetNextInstruction(Current: tai; var Next: tai): Boolean;
  148. function GetLastInstruction(Current: tai; var Last: tai): Boolean;
  149. procedure SkipHead(var p: tai);
  150. function labelCanBeSkipped(p: tai_label): boolean;
  151. procedure RemoveLastDeallocForFuncRes(asmL: TAAsmOutput; p: tai);
  152. function regLoadedWithNewValue(supreg: tsuperregister; canDependOnPrevValue: boolean;
  153. hp: tai): boolean;
  154. procedure UpdateUsedRegs(var UsedRegs: TRegSet; p: tai);
  155. procedure AllocRegBetween(asml: taasmoutput; reg: tregister; p1, p2: tai);
  156. function FindRegDealloc(supreg: tsuperregister; p: tai): boolean;
  157. //function RegsEquivalent(OldReg, NewReg: tregister; var RegInfo: toptreginfo; OpAct: TopAction): Boolean;
  158. function InstructionsEquivalent(p1, p2: tai; var RegInfo: toptreginfo): Boolean;
  159. function sizescompatible(loadsize,newsize: topsize): boolean;
  160. function OpsEqual(const o1,o2:toper): Boolean;
  161. type
  162. tdfaobj = class
  163. constructor create(_list: taasmoutput); virtual;
  164. function pass_1(_blockstart: tai): tai;
  165. function pass_2: boolean;
  166. procedure clear;
  167. function getlabelwithsym(sym: tasmlabel): tai;
  168. private
  169. { Walks through the list to find the lowest and highest label number, inits the }
  170. { labeltable and fixes/optimizes some regallocs }
  171. procedure initlabeltable;
  172. function initdfapass2: boolean;
  173. procedure dodfapass2;
  174. { asm list we're working on }
  175. list: taasmoutput;
  176. { current part of the asm list }
  177. blockstart, blockend: tai;
  178. { the amount of taiObjects in the current part of the assembler list }
  179. nroftaiobjs: longint;
  180. { Array which holds all TtaiProps }
  181. taipropblock: ptaipropblock;
  182. { all labels in the current block: their value mapped to their location }
  183. lolab, hilab, labdif: longint;
  184. labeltable: plabeltable;
  185. end;
  186. function FindLabel(L: tasmlabel; var hp: tai): Boolean;
  187. procedure incState(var S: Byte; amount: longint);
  188. {******************************* Variables *******************************}
  189. var
  190. dfa: tdfaobj;
  191. {*********************** end of Interface section ************************}
  192. Implementation
  193. Uses
  194. {$ifdef csdebug}
  195. cutils,
  196. {$else}
  197. {$ifdef statedebug}
  198. cutils,
  199. {$endif}
  200. {$endif}
  201. globals, systems, verbose, symconst, symsym, cgobj,
  202. rgobj, procinfo;
  203. Type
  204. TRefCompare = function(const r1, r2: TReference): Boolean;
  205. var
  206. {How many instructions are between the current instruction and the last one
  207. that modified the register}
  208. NrOfInstrSinceLastMod: TInstrSinceLastMod;
  209. {$ifdef tempOpts}
  210. constructor TSearchLinkedListItem.init;
  211. begin
  212. end;
  213. function TSearchLinkedListItem.equals(p: PSearchLinkedListItem): boolean;
  214. begin
  215. equals := false;
  216. end;
  217. constructor TSearchDoubleIntItem.init(_int1,_int2: longint);
  218. begin
  219. int1 := _int1;
  220. int2 := _int2;
  221. end;
  222. function TSearchDoubleIntItem.equals(p: PSearchLinkedListItem): boolean;
  223. begin
  224. equals := (TSearchDoubleIntItem(p).int1 = int1) and
  225. (TSearchDoubleIntItem(p).int2 = int2);
  226. end;
  227. function TSearchLinkedList.searchByValue(p: PSearchLinkedListItem): boolean;
  228. var temp: PSearchLinkedListItem;
  229. begin
  230. temp := first;
  231. while (temp <> last.next) and
  232. not(temp.equals(p)) do
  233. temp := temp.next;
  234. searchByValue := temp <> last.next;
  235. end;
  236. procedure TSearchLinkedList.removeByValue(p: PSearchLinkedListItem);
  237. begin
  238. temp := first;
  239. while (temp <> last.next) and
  240. not(temp.equals(p)) do
  241. temp := temp.next;
  242. if temp <> last.next then
  243. begin
  244. remove(temp);
  245. dispose(temp,done);
  246. end;
  247. end;
  248. procedure updateTempAllocs(var UsedRegs: TRegSet; p: tai);
  249. {updates UsedRegs with the RegAlloc Information coming after p}
  250. begin
  251. repeat
  252. while assigned(p) and
  253. ((p.typ in (SkipInstr - [ait_RegAlloc])) or
  254. ((p.typ = ait_label) and
  255. labelCanBeSkipped(tai_label(current)))) Do
  256. p := tai(p.next);
  257. while assigned(p) and
  258. (p.typ=ait_RegAlloc) Do
  259. begin
  260. if tai_regalloc(p).allocation then
  261. UsedRegs := UsedRegs + [tai_regalloc(p).reg]
  262. else
  263. UsedRegs := UsedRegs - [tai_regalloc(p).reg];
  264. p := tai(p.next);
  265. end;
  266. until not(assigned(p)) or
  267. (not(p.typ in SkipInstr) and
  268. not((p.typ = ait_label) and
  269. labelCanBeSkipped(tai_label(current))));
  270. end;
  271. {$endif tempOpts}
  272. {************************ Create the Label table ************************}
  273. function findregalloc(reg: tregister; starttai: tai; alloc: boolean): boolean;
  274. { Returns true if a ait_alloc object for reg is found in the block of tai's }
  275. { starting with Starttai and ending with the next "real" instruction }
  276. var
  277. supreg: tsuperregister;
  278. begin
  279. findregalloc := false;
  280. supreg := getsupreg(reg);
  281. repeat
  282. while assigned(starttai) and
  283. ((starttai.typ in (skipinstr - [ait_regalloc])) or
  284. ((starttai.typ = ait_label) and
  285. labelcanbeskipped(tai_label(starttai)))) do
  286. starttai := tai(starttai.next);
  287. if assigned(starttai) and
  288. (starttai.typ = ait_regalloc) then
  289. begin
  290. if (tai_regalloc(Starttai).allocation = alloc) and
  291. (getsupreg(tai_regalloc(Starttai).reg) = supreg) then
  292. begin
  293. findregalloc:=true;
  294. break;
  295. end;
  296. starttai := tai(starttai.next);
  297. end
  298. else
  299. break;
  300. until false;
  301. end;
  302. procedure RemoveLastDeallocForFuncRes(asml: taasmoutput; p: tai);
  303. procedure DoRemoveLastDeallocForFuncRes(asml: taasmoutput; supreg: tsuperregister);
  304. var
  305. hp2: tai;
  306. begin
  307. hp2 := p;
  308. repeat
  309. hp2 := tai(hp2.previous);
  310. if assigned(hp2) and
  311. (hp2.typ = ait_regalloc) and
  312. not(tai_regalloc(hp2).allocation) and
  313. (getregtype(tai_regalloc(hp2).reg) = R_INTREGISTER) and
  314. (getsupreg(tai_regalloc(hp2).reg) = supreg) then
  315. begin
  316. asml.remove(hp2);
  317. hp2.free;
  318. break;
  319. end;
  320. until not(assigned(hp2)) or regInInstruction(supreg,hp2);
  321. end;
  322. begin
  323. case current_procinfo.procdef.rettype.def.deftype of
  324. arraydef,recorddef,pointerdef,
  325. stringdef,enumdef,procdef,objectdef,errordef,
  326. filedef,setdef,procvardef,
  327. classrefdef,forwarddef:
  328. DoRemoveLastDeallocForFuncRes(asml,RS_EAX);
  329. orddef:
  330. if current_procinfo.procdef.rettype.def.size <> 0 then
  331. begin
  332. DoRemoveLastDeallocForFuncRes(asml,RS_EAX);
  333. { for int64/qword }
  334. if current_procinfo.procdef.rettype.def.size = 8 then
  335. DoRemoveLastDeallocForFuncRes(asml,RS_EDX);
  336. end;
  337. end;
  338. end;
  339. procedure getNoDeallocRegs(var regs: tregset);
  340. var
  341. regCounter: TSuperRegister;
  342. begin
  343. regs := [];
  344. case current_procinfo.procdef.rettype.def.deftype of
  345. arraydef,recorddef,pointerdef,
  346. stringdef,enumdef,procdef,objectdef,errordef,
  347. filedef,setdef,procvardef,
  348. classrefdef,forwarddef:
  349. regs := [RS_EAX];
  350. orddef:
  351. if current_procinfo.procdef.rettype.def.size <> 0 then
  352. begin
  353. regs := [RS_EAX];
  354. { for int64/qword }
  355. if current_procinfo.procdef.rettype.def.size = 8 then
  356. regs := regs + [RS_EDX];
  357. end;
  358. end;
  359. for regCounter := RS_EAX to RS_EBX do
  360. { if not(regCounter in rg.usableregsint) then}
  361. include(regs,regcounter);
  362. end;
  363. procedure AddRegDeallocFor(asml: taasmoutput; reg: tregister; p: tai);
  364. var
  365. hp1: tai;
  366. funcResRegs: tregset;
  367. funcResReg: boolean;
  368. begin
  369. { if not(supreg in rg.usableregsint) then
  370. exit;}
  371. { if not(supreg in [RS_EDI]) then
  372. exit;}
  373. getNoDeallocRegs(funcresregs);
  374. { funcResRegs := funcResRegs - rg.usableregsint;}
  375. { funcResRegs := funcResRegs - [RS_EDI];}
  376. { funcResRegs := funcResRegs - [RS_EAX,RS_EBX,RS_ECX,RS_EDX,RS_ESI]; }
  377. funcResReg := getsupreg(reg) in funcresregs;
  378. hp1 := p;
  379. {
  380. while not(funcResReg and
  381. (p.typ = ait_instruction) and
  382. (taicpu(p).opcode = A_JMP) and
  383. (tasmlabel(taicpu(p).oper[0]^.sym) = aktexit2label)) and
  384. getLastInstruction(p, p) and
  385. not(regInInstruction(supreg, p)) do
  386. hp1 := p;
  387. }
  388. { don't insert a dealloc for registers which contain the function result }
  389. { if they are followed by a jump to the exit label (for exit(...)) }
  390. { if not(funcResReg) or
  391. not((hp1.typ = ait_instruction) and
  392. (taicpu(hp1).opcode = A_JMP) and
  393. (tasmlabel(taicpu(hp1).oper[0]^.sym) = aktexit2label)) then }
  394. begin
  395. p := tai_regalloc.deAlloc(reg);
  396. insertLLItem(AsmL, hp1.previous, hp1, p);
  397. end;
  398. end;
  399. {************************ Search the Label table ************************}
  400. function findlabel(l: tasmlabel; var hp: tai): boolean;
  401. {searches for the specified label starting from hp as long as the
  402. encountered instructions are labels, to be able to optimize constructs like
  403. jne l2 jmp l2
  404. jmp l3 and l1:
  405. l1: l2:
  406. l2:}
  407. var
  408. p: tai;
  409. begin
  410. p := hp;
  411. while assigned(p) and
  412. (p.typ in SkipInstr + [ait_label,ait_align]) Do
  413. if (p.typ <> ait_Label) or
  414. (tai_label(p).l <> l) then
  415. GetNextInstruction(p, p)
  416. else
  417. begin
  418. hp := p;
  419. findlabel := true;
  420. exit
  421. end;
  422. findlabel := false;
  423. end;
  424. {************************ Some general functions ************************}
  425. function tch2reg(ch: tinschange): tsuperregister;
  426. {converts a TChange variable to a TRegister}
  427. const
  428. ch2reg: array[CH_REAX..CH_REDI] of tsuperregister = (RS_EAX,RS_ECX,RS_EDX,RS_EBX,RS_ESP,RS_EBP,RS_ESI,RS_EDI);
  429. begin
  430. if (ch <= CH_REDI) then
  431. tch2reg := ch2reg[ch]
  432. else if (ch <= CH_WEDI) then
  433. tch2reg := ch2reg[tinschange(ord(ch) - ord(CH_REDI))]
  434. else if (ch <= CH_RWEDI) then
  435. tch2reg := ch2reg[tinschange(ord(ch) - ord(CH_WEDI))]
  436. else if (ch <= CH_MEDI) then
  437. tch2reg := ch2reg[tinschange(ord(ch) - ord(CH_RWEDI))]
  438. else
  439. InternalError($db)
  440. end;
  441. { inserts new_one between prev and foll }
  442. procedure InsertLLItem(AsmL: TAAsmOutput; prev, foll, new_one: TLinkedListItem);
  443. begin
  444. if assigned(prev) then
  445. if assigned(foll) then
  446. begin
  447. if assigned(new_one) then
  448. begin
  449. new_one.previous := prev;
  450. new_one.next := foll;
  451. prev.next := new_one;
  452. foll.previous := new_one;
  453. { shgould we update line information }
  454. if (not (tai(new_one).typ in SkipLineInfo)) and
  455. (not (tai(foll).typ in SkipLineInfo)) then
  456. tailineinfo(new_one).fileinfo := tailineinfo(foll).fileinfo;
  457. end;
  458. end
  459. else
  460. asml.Concat(new_one)
  461. else
  462. if assigned(foll) then
  463. asml.Insert(new_one)
  464. end;
  465. {********************* Compare parts of tai objects *********************}
  466. function regssamesize(reg1, reg2: tregister): boolean;
  467. {returns true if Reg1 and Reg2 are of the same size (so if they're both
  468. 8bit, 16bit or 32bit)}
  469. begin
  470. if (reg1 = NR_NO) or (reg2 = NR_NO) then
  471. internalerror(2003111602);
  472. regssamesize := getsubreg(reg1) = getsubreg(reg2);
  473. end;
  474. procedure AddReg2RegInfo(OldReg, NewReg: TRegister; var RegInfo: toptreginfo);
  475. {updates the ???RegsEncountered and ???2???reg fields of RegInfo. Assumes that
  476. OldReg and NewReg have the same size (has to be chcked in advance with
  477. RegsSameSize) and that neither equals RS_INVALID}
  478. var
  479. newsupreg, oldsupreg: tsuperregister;
  480. begin
  481. if (newreg = NR_NO) or (oldreg = NR_NO) then
  482. internalerror(2003111601);
  483. newsupreg := getsupreg(newreg);
  484. oldsupreg := getsupreg(oldreg);
  485. with RegInfo Do
  486. begin
  487. NewRegsEncountered := NewRegsEncountered + [newsupreg];
  488. OldRegsEncountered := OldRegsEncountered + [oldsupreg];
  489. New2OldReg[newsupreg] := oldsupreg;
  490. end;
  491. end;
  492. procedure AddOp2RegInfo(const o:toper; var reginfo: toptreginfo);
  493. begin
  494. case o.typ Of
  495. top_reg:
  496. if (o.reg <> NR_NO) then
  497. AddReg2RegInfo(o.reg, o.reg, RegInfo);
  498. top_ref:
  499. begin
  500. if o.ref^.base <> NR_NO then
  501. AddReg2RegInfo(o.ref^.base, o.ref^.base, RegInfo);
  502. if o.ref^.index <> NR_NO then
  503. AddReg2RegInfo(o.ref^.index, o.ref^.index, RegInfo);
  504. end;
  505. end;
  506. end;
  507. function RegsEquivalent(oldreg, newreg: tregister; var reginfo: toptreginfo; opact: topaction): Boolean;
  508. begin
  509. if not((oldreg = NR_NO) or (newreg = NR_NO)) then
  510. if RegsSameSize(oldreg, newreg) then
  511. with reginfo do
  512. {here we always check for the 32 bit component, because it is possible that
  513. the 8 bit component has not been set, event though NewReg already has been
  514. processed. This happens if it has been compared with a register that doesn't
  515. have an 8 bit component (such as EDI). in that case the 8 bit component is
  516. still set to RS_NO and the comparison in the else-part will fail}
  517. if (getsupreg(oldReg) in OldRegsEncountered) then
  518. if (getsupreg(NewReg) in NewRegsEncountered) then
  519. RegsEquivalent := (getsupreg(oldreg) = New2OldReg[getsupreg(newreg)])
  520. { if we haven't encountered the new register yet, but we have encountered the
  521. old one already, the new one can only be correct if it's being written to
  522. (and consequently the old one is also being written to), otherwise
  523. movl -8(%ebp), %eax and movl -8(%ebp), %eax
  524. movl (%eax), %eax movl (%edx), %edx
  525. are considered equivalent}
  526. else
  527. if (opact = opact_write) then
  528. begin
  529. AddReg2RegInfo(oldreg, newreg, reginfo);
  530. RegsEquivalent := true
  531. end
  532. else
  533. Regsequivalent := false
  534. else
  535. if not(getsupreg(newreg) in NewRegsEncountered) and
  536. ((opact = opact_write) or
  537. (newreg = oldreg)) then
  538. begin
  539. AddReg2RegInfo(oldreg, newreg, reginfo);
  540. RegsEquivalent := true
  541. end
  542. else
  543. RegsEquivalent := false
  544. else
  545. RegsEquivalent := false
  546. else
  547. RegsEquivalent := oldreg = newreg
  548. end;
  549. function RefsEquivalent(const r1, r2: treference; var regInfo: toptreginfo; opact: topaction): boolean;
  550. begin
  551. RefsEquivalent :=
  552. (r1.offset = r2.offset) and
  553. RegsEquivalent(r1.base, r2.base, reginfo, opact) and
  554. RegsEquivalent(r1.index, r2.index, reginfo, opact) and
  555. (r1.segment = r2.segment) and (r1.scalefactor = r2.scalefactor) and
  556. (r1.symbol = r2.symbol) and (r1.refaddr = r2.refaddr) and
  557. (r1.relsymbol = r2.relsymbol);
  558. end;
  559. function refsequal(const r1, r2: treference): boolean;
  560. begin
  561. refsequal :=
  562. (r1.offset = r2.offset) and
  563. (r1.segment = r2.segment) and (r1.base = r2.base) and
  564. (r1.index = r2.index) and (r1.scalefactor = r2.scalefactor) and
  565. (r1.symbol=r2.symbol) and (r1.refaddr = r2.refaddr) and
  566. (r1.relsymbol = r2.relsymbol);
  567. end;
  568. function isgp32reg(supreg: tsuperregister): boolean;
  569. {Checks if the register is a 32 bit general purpose register}
  570. begin
  571. isgp32reg := false;
  572. if (supreg >= RS_EAX) and (supreg <= RS_EBX) then
  573. isgp32reg := true
  574. end;
  575. function reginref(supreg: tsuperregister; const ref: treference): boolean;
  576. begin {checks whether ref contains a reference to reg}
  577. reginref :=
  578. ((ref.base <> NR_NO) and
  579. (getsupreg(ref.base) = supreg)) or
  580. ((ref.index <> NR_NO) and
  581. (getsupreg(ref.index) = supreg))
  582. end;
  583. function RegReadByInstruction(supreg: tsuperregister; hp: tai): boolean;
  584. var
  585. p: taicpu;
  586. opcount: longint;
  587. begin
  588. RegReadByInstruction := false;
  589. if hp.typ <> ait_instruction then
  590. exit;
  591. p := taicpu(hp);
  592. case p.opcode of
  593. A_IMUL:
  594. case p.ops of
  595. 1:
  596. regReadByInstruction :=
  597. (supreg = RS_EAX) or reginop(supreg,p.oper[0]^);
  598. 2,3:
  599. regReadByInstruction :=
  600. reginop(supreg,p.oper[0]^) or
  601. reginop(supreg,p.oper[1]^);
  602. end;
  603. A_IDIV,A_DIV,A_MUL:
  604. begin
  605. regReadByInstruction :=
  606. reginop(supreg,p.oper[0]^) or (supreg in [RS_EAX,RS_EDX]);
  607. end;
  608. else
  609. begin
  610. for opcount := 0 to p.ops-1 do
  611. if (p.oper[opCount]^.typ = top_ref) and
  612. reginref(supreg,p.oper[opcount]^.ref^) then
  613. begin
  614. RegReadByInstruction := true;
  615. exit
  616. end;
  617. for opcount := 1 to maxch do
  618. case insprop[p.opcode].ch[opcount] of
  619. CH_REAX..CH_REDI,CH_RWEAX..CH_MEDI:
  620. if supreg = tch2reg(insprop[p.opcode].ch[opcount]) then
  621. begin
  622. RegReadByInstruction := true;
  623. exit
  624. end;
  625. CH_RWOP1,CH_ROP1,CH_MOP1:
  626. if //(p.oper[0]^.typ = top_reg) and
  627. reginop(supreg,p.oper[0]^) then
  628. begin
  629. RegReadByInstruction := true;
  630. exit
  631. end;
  632. Ch_RWOP2,Ch_ROP2,Ch_MOP2:
  633. if //(p.oper[1]^.typ = top_reg) and
  634. reginop(supreg,p.oper[1]^) then
  635. begin
  636. RegReadByInstruction := true;
  637. exit
  638. end;
  639. Ch_RWOP3,Ch_ROP3,Ch_MOP3:
  640. if //(p.oper[2]^.typ = top_reg) and
  641. reginop(supreg,p.oper[2]^) then
  642. begin
  643. RegReadByInstruction := true;
  644. exit
  645. end;
  646. end;
  647. end;
  648. end;
  649. end;
  650. function regInInstruction(supreg: tsuperregister; p1: tai): boolean;
  651. { Checks if reg is used by the instruction p1 }
  652. { Difference with "regReadBysinstruction() or regModifiedByInstruction()": }
  653. { this one ignores CH_ALL opcodes, while regModifiedByInstruction doesn't }
  654. var
  655. p: taicpu;
  656. opcount: Word;
  657. begin
  658. regInInstruction := false;
  659. if p1.typ <> ait_instruction then
  660. exit;
  661. p := taicpu(p1);
  662. case p.opcode of
  663. A_IMUL:
  664. case p.ops of
  665. 1:
  666. regInInstruction :=
  667. (supreg = RS_EAX) or reginop(supreg,p.oper[0]^);
  668. 2,3:
  669. regInInstruction :=
  670. reginop(supreg,p.oper[0]^) or
  671. reginop(supreg,p.oper[1]^) or
  672. (assigned(p.oper[2]) and
  673. reginop(supreg,p.oper[2]^));
  674. end;
  675. A_IDIV,A_DIV,A_MUL:
  676. regInInstruction :=
  677. reginop(supreg,p.oper[0]^) or
  678. (supreg in [RS_EAX,RS_EDX])
  679. else
  680. begin
  681. for opcount := 1 to MaxCh do
  682. case insprop[p.opcode].Ch[opCount] of
  683. CH_REAX..CH_MEDI:
  684. if tch2reg(InsProp[p.opcode].Ch[opCount]) = supreg then
  685. begin
  686. regInInstruction := true;
  687. exit;
  688. end;
  689. CH_ROp1..CH_MOp1:
  690. if reginop(supreg,p.oper[0]^) then
  691. begin
  692. regInInstruction := true;
  693. exit
  694. end;
  695. Ch_ROp2..Ch_MOp2:
  696. if reginop(supreg,p.oper[1]^) then
  697. begin
  698. regInInstruction := true;
  699. exit
  700. end;
  701. Ch_ROp3..Ch_MOp3:
  702. if reginop(supreg,p.oper[2]^) then
  703. begin
  704. regInInstruction := true;
  705. exit
  706. end;
  707. end;
  708. end;
  709. end;
  710. end;
  711. function reginop(supreg: tsuperregister; const o:toper): boolean;
  712. begin
  713. reginop := false;
  714. case o.typ Of
  715. top_reg:
  716. reginop :=
  717. (getregtype(o.reg) = R_INTREGISTER) and
  718. (supreg = getsupreg(o.reg));
  719. top_ref:
  720. reginop :=
  721. ((o.ref^.base <> NR_NO) and
  722. (supreg = getsupreg(o.ref^.base))) or
  723. ((o.ref^.index <> NR_NO) and
  724. (supreg = getsupreg(o.ref^.index)));
  725. end;
  726. end;
  727. function RegModifiedByInstruction(supreg: tsuperregister; p1: tai): boolean;
  728. var
  729. InstrProp: TInsProp;
  730. TmpResult: Boolean;
  731. Cnt: Word;
  732. begin
  733. TmpResult := False;
  734. if supreg = RS_INVALID then
  735. exit;
  736. if (p1.typ = ait_instruction) then
  737. case taicpu(p1).opcode of
  738. A_IMUL:
  739. With taicpu(p1) Do
  740. TmpResult :=
  741. ((ops = 1) and (supreg in [RS_EAX,RS_EDX])) or
  742. ((ops = 2) and (getsupreg(oper[1]^.reg) = supreg)) or
  743. ((ops = 3) and (getsupreg(oper[2]^.reg) = supreg));
  744. A_DIV, A_IDIV, A_MUL:
  745. With taicpu(p1) Do
  746. TmpResult :=
  747. (supreg in [RS_EAX,RS_EDX]);
  748. else
  749. begin
  750. Cnt := 1;
  751. InstrProp := InsProp[taicpu(p1).OpCode];
  752. while (Cnt <= MaxCh) and
  753. (InstrProp.Ch[Cnt] <> Ch_None) and
  754. not(TmpResult) Do
  755. begin
  756. case InstrProp.Ch[Cnt] Of
  757. Ch_WEAX..Ch_MEDI:
  758. TmpResult := supreg = tch2reg(InstrProp.Ch[Cnt]);
  759. Ch_RWOp1,Ch_WOp1,Ch_Mop1:
  760. TmpResult := (taicpu(p1).oper[0]^.typ = top_reg) and
  761. reginop(supreg,taicpu(p1).oper[0]^);
  762. Ch_RWOp2,Ch_WOp2,Ch_Mop2:
  763. TmpResult := (taicpu(p1).oper[1]^.typ = top_reg) and
  764. reginop(supreg,taicpu(p1).oper[1]^);
  765. Ch_RWOp3,Ch_WOp3,Ch_Mop3:
  766. TmpResult := (taicpu(p1).oper[2]^.typ = top_reg) and
  767. reginop(supreg,taicpu(p1).oper[2]^);
  768. Ch_FPU: TmpResult := false; // supreg is supposed to be an intreg!! supreg in [RS_ST..RS_ST7,RS_MM0..RS_MM7];
  769. Ch_ALL: TmpResult := true;
  770. end;
  771. inc(Cnt)
  772. end
  773. end
  774. end;
  775. RegModifiedByInstruction := TmpResult
  776. end;
  777. function instrWritesFlags(p: tai): boolean;
  778. var
  779. l: longint;
  780. begin
  781. instrWritesFlags := true;
  782. case p.typ of
  783. ait_instruction:
  784. begin
  785. for l := 1 to MaxCh do
  786. if InsProp[taicpu(p).opcode].Ch[l] in [Ch_WFlags,Ch_RWFlags,Ch_All] then
  787. exit;
  788. end;
  789. ait_label:
  790. exit;
  791. end;
  792. instrWritesFlags := false;
  793. end;
  794. function instrReadsFlags(p: tai): boolean;
  795. var
  796. l: longint;
  797. begin
  798. instrReadsFlags := true;
  799. case p.typ of
  800. ait_instruction:
  801. begin
  802. for l := 1 to MaxCh do
  803. if InsProp[taicpu(p).opcode].Ch[l] in [Ch_RFlags,Ch_RWFlags,Ch_All] then
  804. exit;
  805. end;
  806. ait_label:
  807. exit;
  808. end;
  809. instrReadsFlags := false;
  810. end;
  811. {********************* GetNext and GetLastInstruction *********************}
  812. function GetNextInstruction(Current: tai; var Next: tai): Boolean;
  813. { skips ait_regalloc, ait_regdealloc and ait_stab* objects and puts the }
  814. { next tai object in Next. Returns false if there isn't any }
  815. begin
  816. repeat
  817. if (Current.typ = ait_marker) and
  818. (tai_Marker(current).Kind = AsmBlockStart) then
  819. begin
  820. GetNextInstruction := False;
  821. Next := Nil;
  822. Exit
  823. end;
  824. Current := tai(current.Next);
  825. while assigned(Current) and
  826. ((current.typ in skipInstr) or
  827. ((current.typ = ait_label) and
  828. labelCanBeSkipped(tai_label(current)))) do
  829. Current := tai(current.Next);
  830. { if assigned(Current) and
  831. (current.typ = ait_Marker) and
  832. (tai_Marker(current).Kind = NoPropInfoStart) then
  833. begin
  834. while assigned(Current) and
  835. ((current.typ <> ait_Marker) or
  836. (tai_Marker(current).Kind <> NoPropInfoend)) Do
  837. Current := tai(current.Next);
  838. end;}
  839. until not(assigned(Current)) or
  840. (current.typ <> ait_Marker) or
  841. not(tai_Marker(current).Kind in [NoPropInfoStart,NoPropInfoend]);
  842. Next := Current;
  843. if assigned(Current) and
  844. not((current.typ in SkipInstr) or
  845. ((current.typ = ait_label) and
  846. labelCanBeSkipped(tai_label(current))))
  847. then
  848. GetNextInstruction :=
  849. not((current.typ = ait_marker) and
  850. (tai_marker(current).kind = asmBlockStart))
  851. else
  852. begin
  853. GetNextInstruction := False;
  854. Next := nil;
  855. end;
  856. end;
  857. function GetLastInstruction(Current: tai; var Last: tai): boolean;
  858. {skips the ait-types in SkipInstr puts the previous tai object in
  859. Last. Returns false if there isn't any}
  860. begin
  861. repeat
  862. Current := tai(current.previous);
  863. while assigned(Current) and
  864. (((current.typ = ait_Marker) and
  865. not(tai_Marker(current).Kind in [AsmBlockend{,NoPropInfoend}])) or
  866. (current.typ in SkipInstr) or
  867. ((current.typ = ait_label) and
  868. labelCanBeSkipped(tai_label(current)))) Do
  869. Current := tai(current.previous);
  870. { if assigned(Current) and
  871. (current.typ = ait_Marker) and
  872. (tai_Marker(current).Kind = NoPropInfoend) then
  873. begin
  874. while assigned(Current) and
  875. ((current.typ <> ait_Marker) or
  876. (tai_Marker(current).Kind <> NoPropInfoStart)) Do
  877. Current := tai(current.previous);
  878. end;}
  879. until not(assigned(Current)) or
  880. (current.typ <> ait_Marker) or
  881. not(tai_Marker(current).Kind in [NoPropInfoStart,NoPropInfoend]);
  882. if not(assigned(Current)) or
  883. (current.typ in SkipInstr) or
  884. ((current.typ = ait_label) and
  885. labelCanBeSkipped(tai_label(current))) or
  886. ((current.typ = ait_Marker) and
  887. (tai_Marker(current).Kind = AsmBlockend))
  888. then
  889. begin
  890. Last := nil;
  891. GetLastInstruction := False
  892. end
  893. else
  894. begin
  895. Last := Current;
  896. GetLastInstruction := True;
  897. end;
  898. end;
  899. procedure SkipHead(var p: tai);
  900. var
  901. oldp: tai;
  902. begin
  903. repeat
  904. oldp := p;
  905. if (p.typ in SkipInstr) or
  906. ((p.typ = ait_marker) and
  907. (tai_Marker(p).Kind in [AsmBlockend,inlinestart,inlineend])) then
  908. GetNextInstruction(p,p)
  909. else if ((p.Typ = Ait_Marker) and
  910. (tai_Marker(p).Kind = nopropinfostart)) then
  911. {a marker of the NoPropInfoStart can't be the first instruction of a
  912. TAAsmoutput list}
  913. GetNextInstruction(tai(p.previous),p);
  914. until p = oldp
  915. end;
  916. function labelCanBeSkipped(p: tai_label): boolean;
  917. begin
  918. labelCanBeSkipped := not(p.l.is_used) or p.l.is_addr;
  919. end;
  920. {******************* The Data Flow Analyzer functions ********************}
  921. function regLoadedWithNewValue(supreg: tsuperregister; canDependOnPrevValue: boolean;
  922. hp: tai): boolean;
  923. { assumes reg is a 32bit register }
  924. var
  925. p: taicpu;
  926. begin
  927. if not assigned(hp) or
  928. (hp.typ <> ait_instruction) then
  929. begin
  930. regLoadedWithNewValue := false;
  931. exit;
  932. end;
  933. p := taicpu(hp);
  934. regLoadedWithNewValue :=
  935. (((p.opcode = A_MOV) or
  936. (p.opcode = A_MOVZX) or
  937. (p.opcode = A_MOVSX) or
  938. (p.opcode = A_LEA)) and
  939. (p.oper[1]^.typ = top_reg) and
  940. (getsupreg(p.oper[1]^.reg) = supreg) and
  941. (canDependOnPrevValue or
  942. (p.oper[0]^.typ <> top_ref) or
  943. not regInRef(supreg,p.oper[0]^.ref^)) or
  944. ((p.opcode = A_POP) and
  945. (getsupreg(p.oper[0]^.reg) = supreg)));
  946. end;
  947. procedure UpdateUsedRegs(var UsedRegs: TRegSet; p: tai);
  948. {updates UsedRegs with the RegAlloc Information coming after p}
  949. begin
  950. repeat
  951. while assigned(p) and
  952. ((p.typ in (SkipInstr - [ait_RegAlloc])) or
  953. ((p.typ = ait_label) and
  954. labelCanBeSkipped(tai_label(p)))) Do
  955. p := tai(p.next);
  956. while assigned(p) and
  957. (p.typ=ait_RegAlloc) Do
  958. begin
  959. if (getregtype(tai_regalloc(p).reg) = R_INTREGISTER) then
  960. if tai_regalloc(p).allocation then
  961. UsedRegs := UsedRegs + [getsupreg(tai_regalloc(p).reg)]
  962. else
  963. UsedRegs := UsedRegs - [getsupreg(tai_regalloc(p).reg)];
  964. p := tai(p.next);
  965. end;
  966. until not(assigned(p)) or
  967. (not(p.typ in SkipInstr) and
  968. not((p.typ = ait_label) and
  969. labelCanBeSkipped(tai_label(p))));
  970. end;
  971. procedure AllocRegBetween(asml: taasmoutput; reg: tregister; p1, p2: tai);
  972. { allocates register reg between (and including) instructions p1 and p2 }
  973. { the type of p1 and p2 must not be in SkipInstr }
  974. var
  975. hp, start: tai;
  976. lastRemovedWasDealloc, firstRemovedWasAlloc, first: boolean;
  977. supreg: tsuperregister;
  978. begin
  979. supreg := getsupreg(reg);
  980. { if not(supreg in rg.usableregsint+[RS_EDI,RS_ESI]) or
  981. not(assigned(p1)) then}
  982. if not(supreg in [RS_EAX,RS_EBX,RS_ECX,RS_EDX,RS_EDI,RS_ESI]) or
  983. not(assigned(p1)) then
  984. { this happens with registers which are loaded implicitely, outside the }
  985. { current block (e.g. esi with self) }
  986. exit;
  987. { make sure we allocate it for this instruction }
  988. if p1 = p2 then
  989. getnextinstruction(p2,p2);
  990. lastRemovedWasDealloc := false;
  991. firstRemovedWasAlloc := false;
  992. first := true;
  993. {$ifdef allocregdebug}
  994. hp := tai_comment.Create(strpnew('allocating '+std_reg2str[supreg]+
  995. ' from here...')));
  996. insertllitem(asml,p1.previous,p1,hp);
  997. hp := tai_comment.Create(strpnew('allocated '+std_reg2str[supreg]+
  998. ' till here...')));
  999. insertllitem(asml,p2,p1.next,hp);
  1000. {$endif allocregdebug}
  1001. start := p1;
  1002. repeat
  1003. if assigned(p1.OptInfo) then
  1004. include(ptaiprop(p1.OptInfo)^.UsedRegs,supreg);
  1005. p1 := tai(p1.next);
  1006. repeat
  1007. while assigned(p1) and
  1008. (p1.typ in (SkipInstr-[ait_regalloc])) Do
  1009. p1 := tai(p1.next);
  1010. { remove all allocation/deallocation info about the register in between }
  1011. if assigned(p1) and
  1012. (p1.typ = ait_regalloc) then
  1013. if (getsupreg(tai_regalloc(p1).reg) = supreg) then
  1014. begin
  1015. if first then
  1016. begin
  1017. firstRemovedWasAlloc := tai_regalloc(p1).allocation;
  1018. first := false;
  1019. end;
  1020. lastRemovedWasDealloc := not tai_regalloc(p1).allocation;
  1021. hp := tai(p1.Next);
  1022. asml.Remove(p1);
  1023. p1.free;
  1024. p1 := hp;
  1025. end
  1026. else p1 := tai(p1.next);
  1027. until not(assigned(p1)) or
  1028. not(p1.typ in SkipInstr);
  1029. until not(assigned(p1)) or
  1030. (p1 = p2);
  1031. if assigned(p1) then
  1032. begin
  1033. if assigned(p1.optinfo) then
  1034. include(ptaiprop(p1.OptInfo)^.UsedRegs,supreg);
  1035. if lastRemovedWasDealloc then
  1036. begin
  1037. hp := tai_regalloc.DeAlloc(reg);
  1038. insertLLItem(asmL,p1,p1.next,hp);
  1039. end;
  1040. end;
  1041. if firstRemovedWasAlloc then
  1042. begin
  1043. hp := tai_regalloc.Alloc(reg);
  1044. insertLLItem(asmL,start.previous,start,hp);
  1045. end;
  1046. end;
  1047. function FindRegDealloc(supreg: tsuperregister; p: tai): boolean;
  1048. var
  1049. hp: tai;
  1050. first: boolean;
  1051. begin
  1052. findregdealloc := false;
  1053. first := true;
  1054. while assigned(p.previous) and
  1055. ((tai(p.previous).typ in (skipinstr+[ait_align])) or
  1056. ((tai(p.previous).typ = ait_label) and
  1057. labelCanBeSkipped(tai_label(p.previous)))) do
  1058. begin
  1059. p := tai(p.previous);
  1060. if (p.typ = ait_regalloc) and
  1061. (getsupreg(tai_regalloc(p).reg) = supreg) then
  1062. if not(tai_regalloc(p).allocation) then
  1063. if first then
  1064. begin
  1065. findregdealloc := true;
  1066. break;
  1067. end
  1068. else
  1069. begin
  1070. findRegDealloc :=
  1071. getNextInstruction(p,hp) and
  1072. regLoadedWithNewValue(supreg,false,hp);
  1073. break
  1074. end
  1075. else
  1076. first := false;
  1077. end
  1078. end;
  1079. procedure incState(var S: Byte; amount: longint);
  1080. {increases S by 1, wraps around at $ffff to 0 (so we won't get overflow
  1081. errors}
  1082. begin
  1083. if (s <= $ff - amount) then
  1084. inc(s, amount)
  1085. else s := longint(s) + amount - $ff;
  1086. end;
  1087. function sequenceDependsonReg(const Content: TContent; seqreg: tsuperregister; supreg: tsuperregister): Boolean;
  1088. { Content is the sequence of instructions that describes the contents of }
  1089. { seqReg. reg is being overwritten by the current instruction. if the }
  1090. { content of seqReg depends on reg (ie. because of a }
  1091. { "movl (seqreg,reg), seqReg" instruction), this function returns true }
  1092. var
  1093. p: tai;
  1094. Counter: Word;
  1095. TmpResult: Boolean;
  1096. RegsChecked: TRegSet;
  1097. begin
  1098. RegsChecked := [];
  1099. p := Content.StartMod;
  1100. TmpResult := False;
  1101. Counter := 1;
  1102. while not(TmpResult) and
  1103. (Counter <= Content.NrOfMods) Do
  1104. begin
  1105. if (p.typ = ait_instruction) and
  1106. ((taicpu(p).opcode = A_MOV) or
  1107. (taicpu(p).opcode = A_MOVZX) or
  1108. (taicpu(p).opcode = A_MOVSX) or
  1109. (taicpu(p).opcode = A_LEA)) and
  1110. (taicpu(p).oper[0]^.typ = top_ref) then
  1111. With taicpu(p).oper[0]^.ref^ Do
  1112. if ((base = current_procinfo.FramePointer) or
  1113. (assigned(symbol) and (base = NR_NO))) and
  1114. (index = NR_NO) then
  1115. begin
  1116. RegsChecked := RegsChecked + [getsupreg(taicpu(p).oper[1]^.reg)];
  1117. if supreg = getsupreg(taicpu(p).oper[1]^.reg) then
  1118. break;
  1119. end
  1120. else
  1121. tmpResult :=
  1122. regReadByInstruction(supreg,p) and
  1123. regModifiedByInstruction(seqReg,p)
  1124. else
  1125. tmpResult :=
  1126. regReadByInstruction(supreg,p) and
  1127. regModifiedByInstruction(seqReg,p);
  1128. inc(Counter);
  1129. GetNextInstruction(p,p)
  1130. end;
  1131. sequenceDependsonReg := TmpResult
  1132. end;
  1133. procedure invalidateDependingRegs(p1: ptaiprop; supreg: tsuperregister);
  1134. var
  1135. counter: tsuperregister;
  1136. begin
  1137. for counter := RS_EAX to RS_EDI do
  1138. if counter <> supreg then
  1139. with p1^.regs[counter] Do
  1140. begin
  1141. if (typ in [con_ref,con_noRemoveRef]) and
  1142. sequenceDependsOnReg(p1^.Regs[counter],counter,supreg) then
  1143. if typ in [con_ref, con_invalid] then
  1144. typ := con_invalid
  1145. { con_noRemoveRef = con_unknown }
  1146. else
  1147. typ := con_unknown;
  1148. if assigned(memwrite) and
  1149. regInRef(counter,memwrite.oper[1]^.ref^) then
  1150. memwrite := nil;
  1151. end;
  1152. end;
  1153. procedure DestroyReg(p1: ptaiprop; supreg: tsuperregister; doincState:Boolean);
  1154. {Destroys the contents of the register reg in the ptaiprop p1, as well as the
  1155. contents of registers are loaded with a memory location based on reg.
  1156. doincState is false when this register has to be destroyed not because
  1157. it's contents are directly modified/overwritten, but because of an indirect
  1158. action (e.g. this register holds the contents of a variable and the value
  1159. of the variable in memory is changed) }
  1160. begin
  1161. { the following happens for fpu registers }
  1162. if (supreg < low(NrOfInstrSinceLastMod)) or
  1163. (supreg > high(NrOfInstrSinceLastMod)) then
  1164. exit;
  1165. NrOfInstrSinceLastMod[supreg] := 0;
  1166. with p1^.regs[supreg] do
  1167. begin
  1168. if doincState then
  1169. begin
  1170. incState(wstate,1);
  1171. typ := con_unknown;
  1172. startmod := nil;
  1173. end
  1174. else
  1175. if typ in [con_ref,con_const,con_invalid] then
  1176. typ := con_invalid
  1177. { con_noRemoveRef = con_unknown }
  1178. else
  1179. typ := con_unknown;
  1180. memwrite := nil;
  1181. end;
  1182. invalidateDependingRegs(p1,supreg);
  1183. end;
  1184. {procedure AddRegsToSet(p: tai; var RegSet: TRegSet);
  1185. begin
  1186. if (p.typ = ait_instruction) then
  1187. begin
  1188. case taicpu(p).oper[0]^.typ Of
  1189. top_reg:
  1190. if not(taicpu(p).oper[0]^.reg in [RS_NO,RS_ESP,current_procinfo.FramePointer]) then
  1191. RegSet := RegSet + [taicpu(p).oper[0]^.reg];
  1192. top_ref:
  1193. With TReference(taicpu(p).oper[0]^) Do
  1194. begin
  1195. if not(base in [current_procinfo.FramePointer,RS_NO,RS_ESP])
  1196. then RegSet := RegSet + [base];
  1197. if not(index in [current_procinfo.FramePointer,RS_NO,RS_ESP])
  1198. then RegSet := RegSet + [index];
  1199. end;
  1200. end;
  1201. case taicpu(p).oper[1]^.typ Of
  1202. top_reg:
  1203. if not(taicpu(p).oper[1]^.reg in [RS_NO,RS_ESP,current_procinfo.FramePointer]) then
  1204. if RegSet := RegSet + [TRegister(TwoWords(taicpu(p).oper[1]^).Word1];
  1205. top_ref:
  1206. With TReference(taicpu(p).oper[1]^) Do
  1207. begin
  1208. if not(base in [current_procinfo.FramePointer,RS_NO,RS_ESP])
  1209. then RegSet := RegSet + [base];
  1210. if not(index in [current_procinfo.FramePointer,RS_NO,RS_ESP])
  1211. then RegSet := RegSet + [index];
  1212. end;
  1213. end;
  1214. end;
  1215. end;}
  1216. function OpsEquivalent(const o1, o2: toper; var RegInfo: toptreginfo; OpAct: TopAction): Boolean;
  1217. begin {checks whether the two ops are equivalent}
  1218. OpsEquivalent := False;
  1219. if o1.typ=o2.typ then
  1220. case o1.typ Of
  1221. top_reg:
  1222. OpsEquivalent :=RegsEquivalent(o1.reg,o2.reg, RegInfo, OpAct);
  1223. top_ref:
  1224. OpsEquivalent := RefsEquivalent(o1.ref^, o2.ref^, RegInfo, OpAct);
  1225. Top_Const:
  1226. OpsEquivalent := o1.val = o2.val;
  1227. Top_None:
  1228. OpsEquivalent := True
  1229. end;
  1230. end;
  1231. function OpsEqual(const o1,o2:toper): Boolean;
  1232. begin {checks whether the two ops are equal}
  1233. OpsEqual := False;
  1234. if o1.typ=o2.typ then
  1235. case o1.typ Of
  1236. top_reg :
  1237. OpsEqual:=o1.reg=o2.reg;
  1238. top_ref :
  1239. OpsEqual := RefsEqual(o1.ref^, o2.ref^);
  1240. Top_Const :
  1241. OpsEqual:=o1.val=o2.val;
  1242. Top_None :
  1243. OpsEqual := True
  1244. end;
  1245. end;
  1246. function sizescompatible(loadsize,newsize: topsize): boolean;
  1247. begin
  1248. case loadsize of
  1249. S_B,S_BW,S_BL:
  1250. sizescompatible := (newsize = loadsize) or (newsize = S_B);
  1251. S_W,S_WL:
  1252. sizescompatible := (newsize = loadsize) or (newsize = S_W);
  1253. else
  1254. sizescompatible := newsize = S_L;
  1255. end;
  1256. end;
  1257. function opscompatible(p1,p2: taicpu): boolean;
  1258. begin
  1259. case p1.opcode of
  1260. A_MOVZX,A_MOVSX:
  1261. opscompatible :=
  1262. ((p2.opcode = p1.opcode) or (p2.opcode = A_MOV)) and
  1263. sizescompatible(p1.opsize,p2.opsize);
  1264. else
  1265. opscompatible :=
  1266. (p1.opcode = p2.opcode) and
  1267. (p1.ops = p2.ops) and
  1268. (p1.opsize = p2.opsize);
  1269. end;
  1270. end;
  1271. function InstructionsEquivalent(p1, p2: tai; var RegInfo: toptreginfo): Boolean;
  1272. {$ifdef csdebug}
  1273. var
  1274. hp: tai;
  1275. {$endif csdebug}
  1276. begin {checks whether two taicpu instructions are equal}
  1277. if assigned(p1) and assigned(p2) and
  1278. (tai(p1).typ = ait_instruction) and
  1279. (tai(p2).typ = ait_instruction) and
  1280. opscompatible(taicpu(p1),taicpu(p2)) and
  1281. (not(assigned(taicpu(p1).oper[0])) or
  1282. (taicpu(p1).oper[0]^.typ = taicpu(p2).oper[0]^.typ)) and
  1283. (not(assigned(taicpu(p1).oper[1])) or
  1284. (taicpu(p1).oper[1]^.typ = taicpu(p2).oper[1]^.typ)) and
  1285. (not(assigned(taicpu(p1).oper[2])) or
  1286. (taicpu(p1).oper[2]^.typ = taicpu(p2).oper[2]^.typ)) then
  1287. {both instructions have the same structure:
  1288. "<operator> <operand of type1>, <operand of type 2>"}
  1289. if ((taicpu(p1).opcode = A_MOV) or
  1290. (taicpu(p1).opcode = A_MOVZX) or
  1291. (taicpu(p1).opcode = A_MOVSX) or
  1292. (taicpu(p1).opcode = A_LEA)) and
  1293. (taicpu(p1).oper[0]^.typ = top_ref) {then .oper[1]^t = top_reg} then
  1294. if not(RegInRef(getsupreg(taicpu(p1).oper[1]^.reg), taicpu(p1).oper[0]^.ref^)) then
  1295. {the "old" instruction is a load of a register with a new value, not with
  1296. a value based on the contents of this register (so no "mov (reg), reg")}
  1297. if not(RegInRef(getsupreg(taicpu(p2).oper[1]^.reg), taicpu(p2).oper[0]^.ref^)) and
  1298. RefsEqual(taicpu(p1).oper[0]^.ref^, taicpu(p2).oper[0]^.ref^) then
  1299. {the "new" instruction is also a load of a register with a new value, and
  1300. this value is fetched from the same memory location}
  1301. begin
  1302. With taicpu(p2).oper[0]^.ref^ Do
  1303. begin
  1304. if (base <> NR_NO) and
  1305. (not(getsupreg(base) in [getsupreg(current_procinfo.FramePointer), RS_ESP])) then
  1306. include(RegInfo.RegsLoadedForRef, getsupreg(base));
  1307. if (index <> NR_NO) and
  1308. (not(getsupreg(index) in [getsupreg(current_procinfo.FramePointer), RS_ESP])) then
  1309. include(RegInfo.RegsLoadedForRef, getsupreg(index));
  1310. end;
  1311. {add the registers from the reference (.oper[0]^) to the RegInfo, all registers
  1312. from the reference are the same in the old and in the new instruction
  1313. sequence}
  1314. AddOp2RegInfo(taicpu(p1).oper[0]^, RegInfo);
  1315. {the registers from .oper[1]^ have to be equivalent, but not necessarily equal}
  1316. InstructionsEquivalent :=
  1317. RegsEquivalent(taicpu(p1).oper[1]^.reg,
  1318. taicpu(p2).oper[1]^.reg, RegInfo, OpAct_Write);
  1319. end
  1320. {the registers are loaded with values from different memory locations. if
  1321. this was allowed, the instructions "mov -4(esi),eax" and "mov -4(ebp),eax"
  1322. would be considered equivalent}
  1323. else
  1324. InstructionsEquivalent := False
  1325. else
  1326. {load register with a value based on the current value of this register}
  1327. begin
  1328. With taicpu(p2).oper[0]^.ref^ Do
  1329. begin
  1330. if (base <> NR_NO) and
  1331. (not(getsupreg(base) in [getsupreg(current_procinfo.FramePointer),
  1332. getsupreg(taicpu(p2).oper[1]^.reg),RS_ESP])) then
  1333. {it won't do any harm if the register is already in RegsLoadedForRef}
  1334. begin
  1335. include(RegInfo.RegsLoadedForRef, getsupreg(base));
  1336. {$ifdef csdebug}
  1337. Writeln(std_regname(base), ' added');
  1338. {$endif csdebug}
  1339. end;
  1340. if (index <> NR_NO) and
  1341. (not(getsupreg(index) in [getsupreg(current_procinfo.FramePointer),
  1342. getsupreg(taicpu(p2).oper[1]^.reg),RS_ESP])) then
  1343. begin
  1344. include(RegInfo.RegsLoadedForRef, getsupreg(index));
  1345. {$ifdef csdebug}
  1346. Writeln(std_regname(index), ' added');
  1347. {$endif csdebug}
  1348. end;
  1349. end;
  1350. if (taicpu(p2).oper[1]^.reg <> NR_NO) and
  1351. (not(getsupreg(taicpu(p2).oper[1]^.reg) in [getsupreg(current_procinfo.FramePointer),RS_ESP])) then
  1352. begin
  1353. RegInfo.RegsLoadedForRef := RegInfo.RegsLoadedForRef -
  1354. [getsupreg(taicpu(p2).oper[1]^.reg)];
  1355. {$ifdef csdebug}
  1356. Writeln(std_regname(getsupreg(taicpu(p2).oper[1]^.reg)), ' removed');
  1357. {$endif csdebug}
  1358. end;
  1359. InstructionsEquivalent :=
  1360. OpsEquivalent(taicpu(p1).oper[0]^, taicpu(p2).oper[0]^, RegInfo, OpAct_Read) and
  1361. OpsEquivalent(taicpu(p1).oper[1]^, taicpu(p2).oper[1]^, RegInfo, OpAct_Write)
  1362. end
  1363. else
  1364. {an instruction <> mov, movzx, movsx}
  1365. begin
  1366. {$ifdef csdebug}
  1367. hp := tai_comment.Create(strpnew('checking if equivalent'));
  1368. hp.previous := p2;
  1369. hp.next := p2.next;
  1370. p2.next.previous := hp;
  1371. p2.next := hp;
  1372. {$endif csdebug}
  1373. InstructionsEquivalent :=
  1374. (not(assigned(taicpu(p1).oper[0])) or
  1375. OpsEquivalent(taicpu(p1).oper[0]^, taicpu(p2).oper[0]^, RegInfo, OpAct_Unknown)) and
  1376. (not(assigned(taicpu(p1).oper[1])) or
  1377. OpsEquivalent(taicpu(p1).oper[1]^, taicpu(p2).oper[1]^, RegInfo, OpAct_Unknown)) and
  1378. (not(assigned(taicpu(p1).oper[2])) or
  1379. OpsEquivalent(taicpu(p1).oper[2]^, taicpu(p2).oper[2]^, RegInfo, OpAct_Unknown))
  1380. end
  1381. {the instructions haven't even got the same structure, so they're certainly
  1382. not equivalent}
  1383. else
  1384. begin
  1385. {$ifdef csdebug}
  1386. hp := tai_comment.Create(strpnew('different opcodes/format'));
  1387. hp.previous := p2;
  1388. hp.next := p2.next;
  1389. p2.next.previous := hp;
  1390. p2.next := hp;
  1391. {$endif csdebug}
  1392. InstructionsEquivalent := False;
  1393. end;
  1394. {$ifdef csdebug}
  1395. hp := tai_comment.Create(strpnew('instreq: '+tostr(byte(instructionsequivalent))));
  1396. hp.previous := p2;
  1397. hp.next := p2.next;
  1398. p2.next.previous := hp;
  1399. p2.next := hp;
  1400. {$endif csdebug}
  1401. end;
  1402. (*
  1403. function InstructionsEqual(p1, p2: tai): Boolean;
  1404. begin {checks whether two taicpu instructions are equal}
  1405. InstructionsEqual :=
  1406. assigned(p1) and assigned(p2) and
  1407. ((tai(p1).typ = ait_instruction) and
  1408. (tai(p1).typ = ait_instruction) and
  1409. (taicpu(p1).opcode = taicpu(p2).opcode) and
  1410. (taicpu(p1).oper[0]^.typ = taicpu(p2).oper[0]^.typ) and
  1411. (taicpu(p1).oper[1]^.typ = taicpu(p2).oper[1]^.typ) and
  1412. OpsEqual(taicpu(p1).oper[0]^.typ, taicpu(p1).oper[0]^, taicpu(p2).oper[0]^) and
  1413. OpsEqual(taicpu(p1).oper[1]^.typ, taicpu(p1).oper[1]^, taicpu(p2).oper[1]^))
  1414. end;
  1415. *)
  1416. procedure readreg(p: ptaiprop; supreg: tsuperregister);
  1417. begin
  1418. if supreg in [RS_EAX..RS_EDI] then
  1419. incState(p^.regs[supreg].rstate,1)
  1420. end;
  1421. procedure readref(p: ptaiprop; const ref: preference);
  1422. begin
  1423. if ref^.base <> NR_NO then
  1424. readreg(p, getsupreg(ref^.base));
  1425. if ref^.index <> NR_NO then
  1426. readreg(p, getsupreg(ref^.index));
  1427. end;
  1428. procedure ReadOp(p: ptaiprop;const o:toper);
  1429. begin
  1430. case o.typ Of
  1431. top_reg: readreg(p, getsupreg(o.reg));
  1432. top_ref: readref(p, o.ref);
  1433. end;
  1434. end;
  1435. function RefInInstruction(const ref: TReference; p: tai;
  1436. RefsEq: TRefCompare): Boolean;
  1437. {checks whehter ref is used in p}
  1438. var TmpResult: Boolean;
  1439. begin
  1440. TmpResult := False;
  1441. if (p.typ = ait_instruction) then
  1442. begin
  1443. if (taicpu(p).ops >= 1) and
  1444. (taicpu(p).oper[0]^.typ = top_ref) then
  1445. TmpResult := RefsEq(ref, taicpu(p).oper[0]^.ref^);
  1446. if not(TmpResult) and
  1447. (taicpu(p).ops >= 2) and
  1448. (taicpu(p).oper[1]^.typ = top_ref) then
  1449. TmpResult := RefsEq(ref, taicpu(p).oper[1]^.ref^);
  1450. if not(TmpResult) and
  1451. (taicpu(p).ops >= 3) and
  1452. (taicpu(p).oper[2]^.typ = top_ref) then
  1453. TmpResult := RefsEq(ref, taicpu(p).oper[2]^.ref^);
  1454. end;
  1455. RefInInstruction := TmpResult;
  1456. end;
  1457. function RefInSequence(const ref: TReference; Content: TContent;
  1458. RefsEq: TRefCompare): Boolean;
  1459. {checks the whole sequence of Content (so StartMod and and the next NrOfMods
  1460. tai objects) to see whether ref is used somewhere}
  1461. var p: tai;
  1462. Counter: Word;
  1463. TmpResult: Boolean;
  1464. begin
  1465. p := Content.StartMod;
  1466. TmpResult := False;
  1467. Counter := 1;
  1468. while not(TmpResult) and
  1469. (Counter <= Content.NrOfMods) Do
  1470. begin
  1471. if (p.typ = ait_instruction) and
  1472. RefInInstruction(ref, p, RefsEq)
  1473. then TmpResult := True;
  1474. inc(Counter);
  1475. GetNextInstruction(p,p)
  1476. end;
  1477. RefInSequence := TmpResult
  1478. end;
  1479. function ArrayRefsEq(const r1, r2: TReference): Boolean;
  1480. begin
  1481. ArrayRefsEq := (R1.Offset = R2.Offset) and
  1482. (R1.Segment = R2.Segment) and
  1483. (R1.Symbol=R2.Symbol) and
  1484. (R1.base = R2.base)
  1485. end;
  1486. function isSimpleRef(const ref: treference): boolean;
  1487. { returns true if ref is reference to a local or global variable, to a }
  1488. { parameter or to an object field (this includes arrays). Returns false }
  1489. { otherwise. }
  1490. begin
  1491. isSimpleRef :=
  1492. assigned(ref.symbol) or
  1493. (ref.base = current_procinfo.framepointer);
  1494. end;
  1495. function containsPointerRef(p: tai): boolean;
  1496. { checks if an instruction contains a reference which is a pointer location }
  1497. var
  1498. hp: taicpu;
  1499. count: longint;
  1500. begin
  1501. containsPointerRef := false;
  1502. if p.typ <> ait_instruction then
  1503. exit;
  1504. hp := taicpu(p);
  1505. for count := 0 to hp.ops-1 do
  1506. begin
  1507. case hp.oper[count]^.typ of
  1508. top_ref:
  1509. if not isSimpleRef(hp.oper[count]^.ref^) then
  1510. begin
  1511. containsPointerRef := true;
  1512. exit;
  1513. end;
  1514. top_none:
  1515. exit;
  1516. end;
  1517. end;
  1518. end;
  1519. function containsPointerLoad(c: tcontent): boolean;
  1520. { checks whether the contents of a register contain a pointer reference }
  1521. var
  1522. p: tai;
  1523. count: longint;
  1524. begin
  1525. containsPointerLoad := false;
  1526. p := c.startmod;
  1527. for count := c.nrOfMods downto 1 do
  1528. begin
  1529. if containsPointerRef(p) then
  1530. begin
  1531. containsPointerLoad := true;
  1532. exit;
  1533. end;
  1534. getnextinstruction(p,p);
  1535. end;
  1536. end;
  1537. function writeToMemDestroysContents(regWritten: tsuperregister; const ref: treference;
  1538. supreg: tsuperregister; const c: tcontent; var invalsmemwrite: boolean): boolean;
  1539. { returns whether the contents c of reg are invalid after regWritten is }
  1540. { is written to ref }
  1541. var
  1542. refsEq: trefCompare;
  1543. begin
  1544. if isSimpleRef(ref) then
  1545. begin
  1546. if (ref.index <> NR_NO) or
  1547. (assigned(ref.symbol) and
  1548. (ref.base <> NR_NO)) then
  1549. { local/global variable or parameter which is an array }
  1550. refsEq := {$ifdef fpc}@{$endif}arrayRefsEq
  1551. else
  1552. { local/global variable or parameter which is not an array }
  1553. refsEq := {$ifdef fpc}@{$endif}refsEqual;
  1554. invalsmemwrite :=
  1555. assigned(c.memwrite) and
  1556. ((not(cs_uncertainOpts in aktglobalswitches) and
  1557. containsPointerRef(c.memwrite)) or
  1558. refsEq(c.memwrite.oper[1]^.ref^,ref));
  1559. if not(c.typ in [con_ref,con_noRemoveRef,con_invalid]) then
  1560. begin
  1561. writeToMemDestroysContents := false;
  1562. exit;
  1563. end;
  1564. { write something to a parameter, a local or global variable, so }
  1565. { * with uncertain optimizations on: }
  1566. { - destroy the contents of registers whose contents have somewhere a }
  1567. { "mov?? (ref), %reg". WhichReg (this is the register whose contents }
  1568. { are being written to memory) is not destroyed if it's StartMod is }
  1569. { of that form and NrOfMods = 1 (so if it holds ref, but is not a }
  1570. { expression based on ref) }
  1571. { * with uncertain optimizations off: }
  1572. { - also destroy registers that contain any pointer }
  1573. with c do
  1574. writeToMemDestroysContents :=
  1575. (typ in [con_ref,con_noRemoveRef]) and
  1576. ((not(cs_uncertainOpts in aktglobalswitches) and
  1577. containsPointerLoad(c)
  1578. ) or
  1579. (refInSequence(ref,c,refsEq) and
  1580. ((supreg <> regWritten) or
  1581. not((nrOfMods = 1) and
  1582. {StarMod is always of the type ait_instruction}
  1583. (taicpu(StartMod).oper[0]^.typ = top_ref) and
  1584. refsEq(taicpu(StartMod).oper[0]^.ref^, ref)
  1585. )
  1586. )
  1587. )
  1588. );
  1589. end
  1590. else
  1591. { write something to a pointer location, so }
  1592. { * with uncertain optimzations on: }
  1593. { - do not destroy registers which contain a local/global variable or }
  1594. { a parameter, except if DestroyRefs is called because of a "movsl" }
  1595. { * with uncertain optimzations off: }
  1596. { - destroy every register which contains a memory location }
  1597. begin
  1598. invalsmemwrite :=
  1599. assigned(c.memwrite) and
  1600. (not(cs_UncertainOpts in aktglobalswitches) or
  1601. containsPointerRef(c.memwrite));
  1602. if not(c.typ in [con_ref,con_noRemoveRef,con_invalid]) then
  1603. begin
  1604. writeToMemDestroysContents := false;
  1605. exit;
  1606. end;
  1607. with c do
  1608. writeToMemDestroysContents :=
  1609. (typ in [con_ref,con_noRemoveRef]) and
  1610. (not(cs_UncertainOpts in aktglobalswitches) or
  1611. { for movsl }
  1612. ((ref.base = NR_EDI) and (ref.index = NR_EDI)) or
  1613. { don't destroy if reg contains a parameter, local or global variable }
  1614. containsPointerLoad(c)
  1615. );
  1616. end;
  1617. end;
  1618. function writeToRegDestroysContents(destReg, supreg: tsuperregister;
  1619. const c: tcontent): boolean;
  1620. { returns whether the contents c of reg are invalid after destReg is }
  1621. { modified }
  1622. begin
  1623. writeToRegDestroysContents :=
  1624. (c.typ in [con_ref,con_noRemoveRef,con_invalid]) and
  1625. sequenceDependsOnReg(c,supreg,destReg);
  1626. end;
  1627. function writeDestroysContents(const op: toper; supreg: tsuperregister;
  1628. const c: tcontent; var memwritedestroyed: boolean): boolean;
  1629. { returns whether the contents c of reg are invalid after regWritten is }
  1630. { is written to op }
  1631. begin
  1632. memwritedestroyed := false;
  1633. case op.typ of
  1634. top_reg:
  1635. writeDestroysContents :=
  1636. writeToRegDestroysContents(getsupreg(op.reg),supreg,c);
  1637. top_ref:
  1638. writeDestroysContents :=
  1639. writeToMemDestroysContents(RS_INVALID,op.ref^,supreg,c,memwritedestroyed);
  1640. else
  1641. writeDestroysContents := false;
  1642. end;
  1643. end;
  1644. procedure destroyRefs(p: tai; const ref: treference; regwritten: tsuperregister);
  1645. { destroys all registers which possibly contain a reference to ref, regWritten }
  1646. { is the register whose contents are being written to memory (if this proc }
  1647. { is called because of a "mov?? %reg, (mem)" instruction) }
  1648. var
  1649. counter: tsuperregister;
  1650. destroymemwrite: boolean;
  1651. begin
  1652. for counter := RS_EAX to RS_EDI Do
  1653. begin
  1654. if writeToMemDestroysContents(regwritten,ref,counter,
  1655. ptaiprop(p.optInfo)^.regs[counter],destroymemwrite) then
  1656. destroyReg(ptaiprop(p.optInfo), counter, false)
  1657. else if destroymemwrite then
  1658. ptaiprop(p.optinfo)^.regs[counter].MemWrite := nil;
  1659. end;
  1660. end;
  1661. procedure DestroyAllRegs(p: ptaiprop; read, written: boolean);
  1662. var Counter: tsuperregister;
  1663. begin {initializes/desrtoys all registers}
  1664. For Counter := RS_EAX To RS_EDI Do
  1665. begin
  1666. if read then
  1667. readreg(p, Counter);
  1668. DestroyReg(p, Counter, written);
  1669. p^.regs[counter].MemWrite := nil;
  1670. end;
  1671. p^.DirFlag := F_Unknown;
  1672. end;
  1673. procedure DestroyOp(taiObj: tai; const o:Toper);
  1674. {$ifdef statedebug}
  1675. var
  1676. hp: tai;
  1677. {$endif statedebug}
  1678. begin
  1679. case o.typ Of
  1680. top_reg:
  1681. begin
  1682. {$ifdef statedebug}
  1683. hp := tai_comment.Create(strpnew('destroying '+std_regname(o.reg)));
  1684. hp.next := taiobj.next;
  1685. hp.previous := taiobj;
  1686. taiobj.next := hp;
  1687. if assigned(hp.next) then
  1688. hp.next.previous := hp;
  1689. {$endif statedebug}
  1690. DestroyReg(ptaiprop(taiObj.OptInfo), getsupreg(o.reg), true);
  1691. end;
  1692. top_ref:
  1693. begin
  1694. readref(ptaiprop(taiObj.OptInfo), o.ref);
  1695. DestroyRefs(taiObj, o.ref^, RS_INVALID);
  1696. end;
  1697. end;
  1698. end;
  1699. procedure AddInstr2RegContents({$ifdef statedebug} asml: taasmoutput; {$endif}
  1700. p: taicpu; supreg: tsuperregister);
  1701. {$ifdef statedebug}
  1702. var
  1703. hp: tai;
  1704. {$endif statedebug}
  1705. begin
  1706. With ptaiprop(p.optinfo)^.regs[supreg] Do
  1707. if (typ in [con_ref,con_noRemoveRef]) then
  1708. begin
  1709. incState(wstate,1);
  1710. { also store how many instructions are part of the sequence in the first }
  1711. { instructions ptaiprop, so it can be easily accessed from within }
  1712. { CheckSequence}
  1713. inc(NrOfMods, NrOfInstrSinceLastMod[supreg]);
  1714. ptaiprop(tai(StartMod).OptInfo)^.Regs[supreg].NrOfMods := NrOfMods;
  1715. NrOfInstrSinceLastMod[supreg] := 0;
  1716. invalidateDependingRegs(p.optinfo,supreg);
  1717. ptaiprop(p.optinfo)^.regs[supreg].memwrite := nil;
  1718. {$ifdef StateDebug}
  1719. hp := tai_comment.Create(strpnew(std_regname(newreg(R_INTREGISTER,supreg,R_SUBWHOLE))+': '+tostr(ptaiprop(p.optinfo)^.Regs[supreg].WState)
  1720. + ' -- ' + tostr(ptaiprop(p.optinfo)^.Regs[supreg].nrofmods)));
  1721. InsertLLItem(AsmL, p, p.next, hp);
  1722. {$endif StateDebug}
  1723. end
  1724. else
  1725. begin
  1726. {$ifdef statedebug}
  1727. hp := tai_comment.Create(strpnew('destroying '+std_regname(newreg(R_INTREGISTER,supreg,R_SUBWHOLE))));
  1728. insertllitem(asml,p,p.next,hp);
  1729. {$endif statedebug}
  1730. DestroyReg(ptaiprop(p.optinfo), supreg, true);
  1731. {$ifdef StateDebug}
  1732. hp := tai_comment.Create(strpnew(std_regname(newreg(R_INTREGISTER,supreg,R_SUBWHOLE))+': '+tostr(ptaiprop(p.optinfo)^.Regs[supreg].WState)));
  1733. InsertLLItem(AsmL, p, p.next, hp);
  1734. {$endif StateDebug}
  1735. end
  1736. end;
  1737. procedure AddInstr2OpContents({$ifdef statedebug} asml: TAAsmoutput; {$endif}
  1738. p: taicpu; const oper: TOper);
  1739. begin
  1740. if oper.typ = top_reg then
  1741. AddInstr2RegContents({$ifdef statedebug} asml, {$endif}p, getsupreg(oper.reg))
  1742. else
  1743. begin
  1744. ReadOp(ptaiprop(p.optinfo), oper);
  1745. DestroyOp(p, oper);
  1746. end
  1747. end;
  1748. {*************************************************************************************}
  1749. {************************************** TDFAOBJ **************************************}
  1750. {*************************************************************************************}
  1751. constructor tdfaobj.create(_list: taasmoutput);
  1752. begin
  1753. list := _list;
  1754. blockstart := nil;
  1755. blockend := nil;
  1756. nroftaiobjs := 0;
  1757. taipropblock := nil;
  1758. lolab := 0;
  1759. hilab := 0;
  1760. labdif := 0;
  1761. labeltable := nil;
  1762. end;
  1763. procedure tdfaobj.initlabeltable;
  1764. var
  1765. labelfound: boolean;
  1766. p, prev: tai;
  1767. hp1, hp2: tai;
  1768. {$ifdef i386}
  1769. regcounter,
  1770. supreg : tsuperregister;
  1771. {$endif i386}
  1772. usedregs, nodeallocregs: tregset;
  1773. begin
  1774. labelfound := false;
  1775. lolab := maxlongint;
  1776. hilab := 0;
  1777. p := blockstart;
  1778. prev := p;
  1779. while assigned(p) do
  1780. begin
  1781. if (tai(p).typ = ait_label) then
  1782. if not labelcanbeskipped(tai_label(p)) then
  1783. begin
  1784. labelfound := true;
  1785. if (tai_Label(p).l.labelnr < lolab) then
  1786. lolab := tai_label(p).l.labelnr;
  1787. if (tai_Label(p).l.labelnr > hilab) then
  1788. hilab := tai_label(p).l.labelnr;
  1789. end;
  1790. prev := p;
  1791. getnextinstruction(p, p);
  1792. end;
  1793. if (prev.typ = ait_marker) and
  1794. (tai_marker(prev).kind = asmblockstart) then
  1795. blockend := prev
  1796. else blockend := nil;
  1797. if labelfound then
  1798. labdif := hilab+1-lolab
  1799. else labdif := 0;
  1800. usedregs := [];
  1801. if (labdif <> 0) then
  1802. begin
  1803. getmem(labeltable, labdif*sizeof(tlabeltableitem));
  1804. fillchar(labeltable^, labdif*sizeof(tlabeltableitem), 0);
  1805. end;
  1806. p := blockstart;
  1807. prev := p;
  1808. while (p <> blockend) do
  1809. begin
  1810. case p.typ of
  1811. ait_label:
  1812. if not labelcanbeskipped(tai_label(p)) then
  1813. labeltable^[tai_label(p).l.labelnr-lolab].taiobj := p;
  1814. {$ifdef i386}
  1815. ait_regalloc:
  1816. begin
  1817. supreg:=getsupreg(tai_regalloc(p).reg);
  1818. if tai_regalloc(p).allocation then
  1819. begin
  1820. if not(supreg in usedregs) then
  1821. include(usedregs, supreg)
  1822. else
  1823. addregdeallocfor(list, tai_regalloc(p).reg, p);
  1824. end
  1825. else
  1826. begin
  1827. exclude(usedregs, supreg);
  1828. hp1 := p;
  1829. hp2 := nil;
  1830. while not(findregalloc(tai_regalloc(p).reg, tai(hp1.next),true)) and
  1831. getnextinstruction(hp1, hp1) and
  1832. regininstruction(getsupreg(tai_regalloc(p).reg), hp1) Do
  1833. hp2 := hp1;
  1834. if hp2 <> nil then
  1835. begin
  1836. hp1 := tai(p.previous);
  1837. list.remove(p);
  1838. insertllitem(list, hp2, tai(hp2.next), p);
  1839. p := hp1;
  1840. end;
  1841. end;
  1842. end;
  1843. {$endif i386}
  1844. end;
  1845. repeat
  1846. prev := p;
  1847. p := tai(p.next);
  1848. until not(assigned(p)) or
  1849. not(p.typ in (skipinstr - [ait_regalloc]));
  1850. end;
  1851. {$ifdef i386}
  1852. { don't add deallocation for function result variable or for regvars}
  1853. getNoDeallocRegs(noDeallocRegs);
  1854. usedRegs := usedRegs - noDeallocRegs;
  1855. for regCounter := RS_EAX to RS_EDI do
  1856. if regCounter in usedRegs then
  1857. addRegDeallocFor(list,newreg(R_INTREGISTER,regCounter,R_SUBWHOLE),prev);
  1858. {$endif i386}
  1859. end;
  1860. function tdfaobj.pass_1(_blockstart: tai): tai;
  1861. begin
  1862. blockstart := _blockstart;
  1863. initlabeltable;
  1864. pass_1 := blockend;
  1865. end;
  1866. function tdfaobj.initdfapass2: boolean;
  1867. {reserves memory for the PtaiProps in one big memory block when not using
  1868. TP, returns False if not enough memory is available for the optimizer in all
  1869. cases}
  1870. var
  1871. p: tai;
  1872. count: Longint;
  1873. { TmpStr: String; }
  1874. begin
  1875. p := blockstart;
  1876. skiphead(p);
  1877. nroftaiobjs := 0;
  1878. while (p <> blockend) do
  1879. begin
  1880. {$ifDef JumpAnal}
  1881. case p.typ of
  1882. ait_label:
  1883. begin
  1884. if not labelcanbeskipped(tai_label(p)) then
  1885. labeltable^[tai_label(p).l.labelnr-lolab].instrnr := nroftaiobjs
  1886. end;
  1887. ait_instruction:
  1888. begin
  1889. if taicpu(p).is_jmp then
  1890. begin
  1891. if (tasmlabel(taicpu(p).oper[0]^.sym).labelnr >= lolab) and
  1892. (tasmlabel(taicpu(p).oper[0]^.sym).labelnr <= hilab) then
  1893. inc(labeltable^[tasmlabel(taicpu(p).oper[0]^.sym).labelnr-lolab].refsfound);
  1894. end;
  1895. end;
  1896. { ait_instruction:
  1897. begin
  1898. if (taicpu(p).opcode = A_PUSH) and
  1899. (taicpu(p).oper[0]^.typ = top_symbol) and
  1900. (PCSymbol(taicpu(p).oper[0]^)^.offset = 0) then
  1901. begin
  1902. TmpStr := StrPas(PCSymbol(taicpu(p).oper[0]^)^.symbol);
  1903. if}
  1904. end;
  1905. {$endif JumpAnal}
  1906. inc(NrOftaiObjs);
  1907. getnextinstruction(p,p);
  1908. end;
  1909. if nroftaiobjs <> 0 then
  1910. begin
  1911. initdfapass2 := True;
  1912. getmem(taipropblock, nroftaiobjs*sizeof(ttaiprop));
  1913. fillchar(taiPropblock^,nroftaiobjs*sizeof(ttaiprop),0);
  1914. p := blockstart;
  1915. skiphead(p);
  1916. for count := 1 To nroftaiobjs do
  1917. begin
  1918. ptaiprop(p.optinfo) := @taipropblock^[count];
  1919. getnextinstruction(p, p);
  1920. end;
  1921. end
  1922. else
  1923. initdfapass2 := false;
  1924. end;
  1925. procedure tdfaobj.dodfapass2;
  1926. {Analyzes the Data Flow of an assembler list. Starts creating the reg
  1927. contents for the instructions starting with p. Returns the last tai which has
  1928. been processed}
  1929. var
  1930. curprop, LastFlagsChangeProp: ptaiprop;
  1931. Cnt, InstrCnt : Longint;
  1932. InstrProp: TInsProp;
  1933. UsedRegs: TRegSet;
  1934. prev,p : tai;
  1935. tmpref: TReference;
  1936. tmpsupreg: tsuperregister;
  1937. {$ifdef statedebug}
  1938. hp : tai;
  1939. {$endif}
  1940. {$ifdef AnalyzeLoops}
  1941. hp : tai;
  1942. TmpState: Byte;
  1943. {$endif AnalyzeLoops}
  1944. begin
  1945. p := BlockStart;
  1946. LastFlagsChangeProp := nil;
  1947. prev := nil;
  1948. UsedRegs := [];
  1949. UpdateUsedregs(UsedRegs, p);
  1950. SkipHead(p);
  1951. BlockStart := p;
  1952. InstrCnt := 1;
  1953. fillchar(NrOfInstrSinceLastMod, SizeOf(NrOfInstrSinceLastMod), 0);
  1954. while (p <> Blockend) Do
  1955. begin
  1956. curprop := @taiPropBlock^[InstrCnt];
  1957. if assigned(prev)
  1958. then
  1959. begin
  1960. {$ifdef JumpAnal}
  1961. if (p.Typ <> ait_label) then
  1962. {$endif JumpAnal}
  1963. begin
  1964. curprop^.regs := ptaiprop(prev.OptInfo)^.Regs;
  1965. curprop^.DirFlag := ptaiprop(prev.OptInfo)^.DirFlag;
  1966. curprop^.FlagsUsed := false;
  1967. end
  1968. end
  1969. else
  1970. begin
  1971. fillchar(curprop^, SizeOf(curprop^), 0);
  1972. { For tmpreg := RS_EAX to RS_EDI Do
  1973. curprop^.regs[tmpreg].WState := 1;}
  1974. end;
  1975. curprop^.UsedRegs := UsedRegs;
  1976. curprop^.CanBeRemoved := False;
  1977. UpdateUsedRegs(UsedRegs, tai(p.Next));
  1978. For tmpsupreg := RS_EAX To RS_EDI Do
  1979. if NrOfInstrSinceLastMod[tmpsupreg] < 255 then
  1980. inc(NrOfInstrSinceLastMod[tmpsupreg])
  1981. else
  1982. begin
  1983. NrOfInstrSinceLastMod[tmpsupreg] := 0;
  1984. curprop^.regs[tmpsupreg].typ := con_unknown;
  1985. end;
  1986. case p.typ Of
  1987. ait_marker:;
  1988. ait_label:
  1989. {$ifndef JumpAnal}
  1990. if not labelCanBeSkipped(tai_label(p)) then
  1991. DestroyAllRegs(curprop,false,false);
  1992. {$else JumpAnal}
  1993. begin
  1994. if not labelCanBeSkipped(tai_label(p)) then
  1995. With LTable^[tai_Label(p).l^.labelnr-LoLab] Do
  1996. {$ifDef AnalyzeLoops}
  1997. if (RefsFound = tai_Label(p).l^.RefCount)
  1998. {$else AnalyzeLoops}
  1999. if (JmpsProcessed = tai_Label(p).l^.RefCount)
  2000. {$endif AnalyzeLoops}
  2001. then
  2002. {all jumps to this label have been found}
  2003. {$ifDef AnalyzeLoops}
  2004. if (JmpsProcessed > 0)
  2005. then
  2006. {$endif AnalyzeLoops}
  2007. {we've processed at least one jump to this label}
  2008. begin
  2009. if (GetLastInstruction(p, hp) and
  2010. not(((hp.typ = ait_instruction)) and
  2011. (taicpu_labeled(hp).is_jmp))
  2012. then
  2013. {previous instruction not a JMP -> the contents of the registers after the
  2014. previous intruction has been executed have to be taken into account as well}
  2015. For tmpsupreg := RS_EAX to RS_EDI Do
  2016. begin
  2017. if (curprop^.regs[tmpsupreg].WState <>
  2018. ptaiprop(hp.OptInfo)^.Regs[tmpsupreg].WState)
  2019. then DestroyReg(curprop, tmpsupreg, true)
  2020. end
  2021. end
  2022. {$ifDef AnalyzeLoops}
  2023. else
  2024. {a label from a backward jump (e.g. a loop), no jump to this label has
  2025. already been processed}
  2026. if GetLastInstruction(p, hp) and
  2027. not(hp.typ = ait_instruction) and
  2028. (taicpu_labeled(hp).opcode = A_JMP))
  2029. then
  2030. {previous instruction not a jmp, so keep all the registers' contents from the
  2031. previous instruction}
  2032. begin
  2033. curprop^.regs := ptaiprop(hp.OptInfo)^.Regs;
  2034. curprop.DirFlag := ptaiprop(hp.OptInfo)^.DirFlag;
  2035. end
  2036. else
  2037. {previous instruction a jmp and no jump to this label processed yet}
  2038. begin
  2039. hp := p;
  2040. Cnt := InstrCnt;
  2041. {continue until we find a jump to the label or a label which has already
  2042. been processed}
  2043. while GetNextInstruction(hp, hp) and
  2044. not((hp.typ = ait_instruction) and
  2045. (taicpu(hp).is_jmp) and
  2046. (tasmlabel(taicpu(hp).oper[0]^.sym).labelnr = tai_Label(p).l^.labelnr)) and
  2047. not((hp.typ = ait_label) and
  2048. (LTable^[tai_Label(hp).l^.labelnr-LoLab].RefsFound
  2049. = tai_Label(hp).l^.RefCount) and
  2050. (LTable^[tai_Label(hp).l^.labelnr-LoLab].JmpsProcessed > 0)) Do
  2051. inc(Cnt);
  2052. if (hp.typ = ait_label)
  2053. then
  2054. {there's a processed label after the current one}
  2055. begin
  2056. curprop^.regs := taiPropBlock^[Cnt].Regs;
  2057. curprop.DirFlag := taiPropBlock^[Cnt].DirFlag;
  2058. end
  2059. else
  2060. {there's no label anymore after the current one, or they haven't been
  2061. processed yet}
  2062. begin
  2063. GetLastInstruction(p, hp);
  2064. curprop^.regs := ptaiprop(hp.OptInfo)^.Regs;
  2065. curprop.DirFlag := ptaiprop(hp.OptInfo)^.DirFlag;
  2066. DestroyAllRegs(ptaiprop(hp.OptInfo),true,true)
  2067. end
  2068. end
  2069. {$endif AnalyzeLoops}
  2070. else
  2071. {not all references to this label have been found, so destroy all registers}
  2072. begin
  2073. GetLastInstruction(p, hp);
  2074. curprop^.regs := ptaiprop(hp.OptInfo)^.Regs;
  2075. curprop.DirFlag := ptaiprop(hp.OptInfo)^.DirFlag;
  2076. DestroyAllRegs(curprop,true,true)
  2077. end;
  2078. end;
  2079. {$endif JumpAnal}
  2080. {$ifdef GDB}
  2081. ait_stabs, ait_stabn, ait_stab_function_name:;
  2082. {$endif GDB}
  2083. ait_align: ; { may destroy flags !!! }
  2084. ait_instruction:
  2085. begin
  2086. if taicpu(p).is_jmp or
  2087. (taicpu(p).opcode = A_JMP) then
  2088. begin
  2089. {$ifNDef JumpAnal}
  2090. for tmpsupreg := RS_EAX to RS_EDI do
  2091. with curprop^.regs[tmpsupreg] do
  2092. case typ of
  2093. con_ref: typ := con_noRemoveRef;
  2094. con_const: typ := con_noRemoveConst;
  2095. con_invalid: typ := con_unknown;
  2096. end;
  2097. {$else JumpAnal}
  2098. With LTable^[tasmlabel(taicpu(p).oper[0]^.sym).labelnr-LoLab] Do
  2099. if (RefsFound = tasmlabel(taicpu(p).oper[0]^.sym).RefCount) then
  2100. begin
  2101. if (InstrCnt < InstrNr)
  2102. then
  2103. {forward jump}
  2104. if (JmpsProcessed = 0) then
  2105. {no jump to this label has been processed yet}
  2106. begin
  2107. taiPropBlock^[InstrNr].Regs := curprop^.regs;
  2108. taiPropBlock^[InstrNr].DirFlag := curprop.DirFlag;
  2109. inc(JmpsProcessed);
  2110. end
  2111. else
  2112. begin
  2113. For tmpreg := RS_EAX to RS_EDI Do
  2114. if (taiPropBlock^[InstrNr].Regs[tmpreg].WState <>
  2115. curprop^.regs[tmpreg].WState) then
  2116. DestroyReg(@taiPropBlock^[InstrNr], tmpreg, true);
  2117. inc(JmpsProcessed);
  2118. end
  2119. {$ifdef AnalyzeLoops}
  2120. else
  2121. { backward jump, a loop for example}
  2122. { if (JmpsProcessed > 0) or
  2123. not(GetLastInstruction(taiObj, hp) and
  2124. (hp.typ = ait_labeled_instruction) and
  2125. (taicpu_labeled(hp).opcode = A_JMP))
  2126. then}
  2127. {instruction prior to label is not a jmp, or at least one jump to the label
  2128. has yet been processed}
  2129. begin
  2130. inc(JmpsProcessed);
  2131. For tmpreg := RS_EAX to RS_EDI Do
  2132. if (taiPropBlock^[InstrNr].Regs[tmpreg].WState <>
  2133. curprop^.regs[tmpreg].WState)
  2134. then
  2135. begin
  2136. TmpState := taiPropBlock^[InstrNr].Regs[tmpreg].WState;
  2137. Cnt := InstrNr;
  2138. while (TmpState = taiPropBlock^[Cnt].Regs[tmpreg].WState) Do
  2139. begin
  2140. DestroyReg(@taiPropBlock^[Cnt], tmpreg, true);
  2141. inc(Cnt);
  2142. end;
  2143. while (Cnt <= InstrCnt) Do
  2144. begin
  2145. inc(taiPropBlock^[Cnt].Regs[tmpreg].WState);
  2146. inc(Cnt)
  2147. end
  2148. end;
  2149. end
  2150. { else }
  2151. {instruction prior to label is a jmp and no jumps to the label have yet been
  2152. processed}
  2153. { begin
  2154. inc(JmpsProcessed);
  2155. For tmpreg := RS_EAX to RS_EDI Do
  2156. begin
  2157. TmpState := taiPropBlock^[InstrNr].Regs[tmpreg].WState;
  2158. Cnt := InstrNr;
  2159. while (TmpState = taiPropBlock^[Cnt].Regs[tmpreg].WState) Do
  2160. begin
  2161. taiPropBlock^[Cnt].Regs[tmpreg] := curprop^.regs[tmpreg];
  2162. inc(Cnt);
  2163. end;
  2164. TmpState := taiPropBlock^[InstrNr].Regs[tmpreg].WState;
  2165. while (TmpState = taiPropBlock^[Cnt].Regs[tmpreg].WState) Do
  2166. begin
  2167. DestroyReg(@taiPropBlock^[Cnt], tmpreg, true);
  2168. inc(Cnt);
  2169. end;
  2170. while (Cnt <= InstrCnt) Do
  2171. begin
  2172. inc(taiPropBlock^[Cnt].Regs[tmpreg].WState);
  2173. inc(Cnt)
  2174. end
  2175. end
  2176. end}
  2177. {$endif AnalyzeLoops}
  2178. end;
  2179. {$endif JumpAnal}
  2180. end
  2181. else
  2182. begin
  2183. InstrProp := InsProp[taicpu(p).opcode];
  2184. case taicpu(p).opcode Of
  2185. A_MOV, A_MOVZX, A_MOVSX:
  2186. begin
  2187. case taicpu(p).oper[0]^.typ Of
  2188. top_ref, top_reg:
  2189. case taicpu(p).oper[1]^.typ Of
  2190. top_reg:
  2191. begin
  2192. {$ifdef statedebug}
  2193. hp := tai_comment.Create(strpnew('destroying '+std_regname(taicpu(p).oper[1]^.reg)));
  2194. insertllitem(list,p,p.next,hp);
  2195. {$endif statedebug}
  2196. readOp(curprop, taicpu(p).oper[0]^);
  2197. tmpsupreg := getsupreg(taicpu(p).oper[1]^.reg);
  2198. if reginop(tmpsupreg, taicpu(p).oper[0]^) and
  2199. (curprop^.regs[tmpsupreg].typ in [con_ref,con_noRemoveRef]) then
  2200. begin
  2201. with curprop^.regs[tmpsupreg] Do
  2202. begin
  2203. incState(wstate,1);
  2204. { also store how many instructions are part of the sequence in the first }
  2205. { instruction's ptaiprop, so it can be easily accessed from within }
  2206. { CheckSequence }
  2207. inc(nrOfMods, nrOfInstrSinceLastMod[tmpsupreg]);
  2208. ptaiprop(startmod.optinfo)^.regs[tmpsupreg].nrOfMods := nrOfMods;
  2209. nrOfInstrSinceLastMod[tmpsupreg] := 0;
  2210. { Destroy the contents of the registers }
  2211. { that depended on the previous value of }
  2212. { this register }
  2213. invalidateDependingRegs(curprop,tmpsupreg);
  2214. curprop^.regs[tmpsupreg].memwrite := nil;
  2215. end;
  2216. end
  2217. else
  2218. begin
  2219. {$ifdef statedebug}
  2220. hp := tai_comment.Create(strpnew('destroying & initing '+std_regname(newreg(R_INTREGISTER,tmpsupreg,R_SUBWHOLE))));
  2221. insertllitem(list,p,p.next,hp);
  2222. {$endif statedebug}
  2223. destroyReg(curprop, tmpsupreg, true);
  2224. if not(reginop(tmpsupreg, taicpu(p).oper[0]^)) then
  2225. with curprop^.regs[tmpsupreg] Do
  2226. begin
  2227. typ := con_ref;
  2228. startmod := p;
  2229. nrOfMods := 1;
  2230. end
  2231. end;
  2232. {$ifdef StateDebug}
  2233. hp := tai_comment.Create(strpnew(std_regname(newreg(R_INTREGISTER,tmpsupreg,R_SUBWHOLE))+': '+tostr(curprop^.regs[tmpsupreg].WState)));
  2234. insertllitem(list,p,p.next,hp);
  2235. {$endif StateDebug}
  2236. end;
  2237. top_ref:
  2238. begin
  2239. readref(curprop, taicpu(p).oper[1]^.ref);
  2240. if taicpu(p).oper[0]^.typ = top_reg then
  2241. begin
  2242. readreg(curprop, getsupreg(taicpu(p).oper[0]^.reg));
  2243. DestroyRefs(p, taicpu(p).oper[1]^.ref^, getsupreg(taicpu(p).oper[0]^.reg));
  2244. ptaiprop(p.optinfo)^.regs[getsupreg(taicpu(p).oper[0]^.reg)].memwrite :=
  2245. taicpu(p);
  2246. end
  2247. else
  2248. DestroyRefs(p, taicpu(p).oper[1]^.ref^, RS_INVALID);
  2249. end;
  2250. end;
  2251. top_Const:
  2252. begin
  2253. case taicpu(p).oper[1]^.typ Of
  2254. top_reg:
  2255. begin
  2256. tmpsupreg := getsupreg(taicpu(p).oper[1]^.reg);
  2257. {$ifdef statedebug}
  2258. hp := tai_comment.Create(strpnew('destroying '+std_regname(newreg(R_INTREGISTER,tmpsupreg,R_SUBWHOLE))));
  2259. insertllitem(list,p,p.next,hp);
  2260. {$endif statedebug}
  2261. With curprop^.regs[tmpsupreg] Do
  2262. begin
  2263. DestroyReg(curprop, tmpsupreg, true);
  2264. typ := Con_Const;
  2265. StartMod := p;
  2266. end
  2267. end;
  2268. top_ref:
  2269. begin
  2270. readref(curprop, taicpu(p).oper[1]^.ref);
  2271. DestroyRefs(p, taicpu(p).oper[1]^.ref^, RS_INVALID);
  2272. end;
  2273. end;
  2274. end;
  2275. end;
  2276. end;
  2277. A_DIV, A_IDIV, A_MUL:
  2278. begin
  2279. ReadOp(curprop, taicpu(p).oper[0]^);
  2280. readreg(curprop,RS_EAX);
  2281. if (taicpu(p).OpCode = A_IDIV) or
  2282. (taicpu(p).OpCode = A_DIV) then
  2283. begin
  2284. readreg(curprop,RS_EDX);
  2285. end;
  2286. {$ifdef statedebug}
  2287. hp := tai_comment.Create(strpnew('destroying eax and edx'));
  2288. insertllitem(list,p,p.next,hp);
  2289. {$endif statedebug}
  2290. { DestroyReg(curprop, RS_EAX, true);}
  2291. AddInstr2RegContents({$ifdef statedebug}list,{$endif}
  2292. taicpu(p), RS_EAX);
  2293. DestroyReg(curprop, RS_EDX, true)
  2294. end;
  2295. A_IMUL:
  2296. begin
  2297. ReadOp(curprop,taicpu(p).oper[0]^);
  2298. if (taicpu(p).ops >= 2) then
  2299. ReadOp(curprop,taicpu(p).oper[1]^);
  2300. if (taicpu(p).ops <= 2) then
  2301. if (taicpu(p).oper[1]^.typ = top_none) then
  2302. begin
  2303. readreg(curprop,RS_EAX);
  2304. {$ifdef statedebug}
  2305. hp := tai_comment.Create(strpnew('destroying eax and edx'));
  2306. insertllitem(list,p,p.next,hp);
  2307. {$endif statedebug}
  2308. { DestroyReg(curprop, RS_EAX, true); }
  2309. AddInstr2RegContents({$ifdef statedebug}list,{$endif}
  2310. taicpu(p), RS_EAX);
  2311. DestroyReg(curprop,RS_EDX, true)
  2312. end
  2313. else
  2314. AddInstr2OpContents(
  2315. {$ifdef statedebug}list,{$endif}
  2316. taicpu(p), taicpu(p).oper[1]^)
  2317. else
  2318. AddInstr2OpContents({$ifdef statedebug}list,{$endif}
  2319. taicpu(p), taicpu(p).oper[2]^);
  2320. end;
  2321. A_LEA:
  2322. begin
  2323. readop(curprop,taicpu(p).oper[0]^);
  2324. if reginref(getsupreg(taicpu(p).oper[1]^.reg),taicpu(p).oper[0]^.ref^) then
  2325. AddInstr2RegContents({$ifdef statedebug}list,{$endif}
  2326. taicpu(p), getsupreg(taicpu(p).oper[1]^.reg))
  2327. else
  2328. begin
  2329. {$ifdef statedebug}
  2330. hp := tai_comment.Create(strpnew('destroying & initing'+
  2331. std_regname(taicpu(p).oper[1]^.reg)));
  2332. insertllitem(list,p,p.next,hp);
  2333. {$endif statedebug}
  2334. destroyreg(curprop,getsupreg(taicpu(p).oper[1]^.reg),true);
  2335. with curprop^.regs[getsupreg(taicpu(p).oper[1]^.reg)] Do
  2336. begin
  2337. typ := con_ref;
  2338. startmod := p;
  2339. nrOfMods := 1;
  2340. end
  2341. end;
  2342. end;
  2343. else
  2344. begin
  2345. Cnt := 1;
  2346. while (Cnt <= MaxCh) and
  2347. (InstrProp.Ch[Cnt] <> Ch_None) Do
  2348. begin
  2349. case InstrProp.Ch[Cnt] Of
  2350. Ch_REAX..Ch_REDI:
  2351. begin
  2352. tmpsupreg:=tch2reg(InstrProp.Ch[Cnt]);
  2353. readreg(curprop,tmpsupreg);
  2354. end;
  2355. Ch_WEAX..Ch_RWEDI:
  2356. begin
  2357. if (InstrProp.Ch[Cnt] >= Ch_RWEAX) then
  2358. begin
  2359. tmpsupreg:=tch2reg(InstrProp.Ch[Cnt]);
  2360. readreg(curprop,tmpsupreg);
  2361. end;
  2362. {$ifdef statedebug}
  2363. hp := tai_comment.Create(strpnew('destroying '+
  2364. std_regname(tch2reg(InstrProp.Ch[Cnt]))));
  2365. insertllitem(list,p,p.next,hp);
  2366. {$endif statedebug}
  2367. tmpsupreg:=tch2reg(InstrProp.Ch[Cnt]);
  2368. DestroyReg(curprop,tmpsupreg, true);
  2369. end;
  2370. Ch_MEAX..Ch_MEDI:
  2371. begin
  2372. tmpsupreg:=tch2reg(InstrProp.Ch[Cnt]);
  2373. AddInstr2RegContents({$ifdef statedebug} list,{$endif}
  2374. taicpu(p),tmpsupreg);
  2375. end;
  2376. Ch_CDirFlag: curprop^.DirFlag := F_notSet;
  2377. Ch_SDirFlag: curprop^.DirFlag := F_Set;
  2378. Ch_Rop1: ReadOp(curprop, taicpu(p).oper[0]^);
  2379. Ch_Rop2: ReadOp(curprop, taicpu(p).oper[1]^);
  2380. Ch_ROp3: ReadOp(curprop, taicpu(p).oper[2]^);
  2381. Ch_Wop1..Ch_RWop1:
  2382. begin
  2383. if (InstrProp.Ch[Cnt] in [Ch_RWop1]) then
  2384. ReadOp(curprop, taicpu(p).oper[0]^);
  2385. DestroyOp(p, taicpu(p).oper[0]^);
  2386. end;
  2387. Ch_Mop1:
  2388. AddInstr2OpContents({$ifdef statedebug} list, {$endif}
  2389. taicpu(p), taicpu(p).oper[0]^);
  2390. Ch_Wop2..Ch_RWop2:
  2391. begin
  2392. if (InstrProp.Ch[Cnt] = Ch_RWop2) then
  2393. ReadOp(curprop, taicpu(p).oper[1]^);
  2394. DestroyOp(p, taicpu(p).oper[1]^);
  2395. end;
  2396. Ch_Mop2:
  2397. AddInstr2OpContents({$ifdef statedebug} list, {$endif}
  2398. taicpu(p), taicpu(p).oper[1]^);
  2399. Ch_WOp3..Ch_RWOp3:
  2400. begin
  2401. if (InstrProp.Ch[Cnt] = Ch_RWOp3) then
  2402. ReadOp(curprop, taicpu(p).oper[2]^);
  2403. DestroyOp(p, taicpu(p).oper[2]^);
  2404. end;
  2405. Ch_Mop3:
  2406. AddInstr2OpContents({$ifdef statedebug} list, {$endif}
  2407. taicpu(p), taicpu(p).oper[2]^);
  2408. Ch_WMemEDI:
  2409. begin
  2410. readreg(curprop, RS_EDI);
  2411. fillchar(tmpref, SizeOf(tmpref), 0);
  2412. tmpref.base := NR_EDI;
  2413. tmpref.index := NR_EDI;
  2414. DestroyRefs(p, tmpref,RS_INVALID)
  2415. end;
  2416. Ch_RFlags:
  2417. if assigned(LastFlagsChangeProp) then
  2418. LastFlagsChangeProp^.FlagsUsed := true;
  2419. Ch_WFlags:
  2420. LastFlagsChangeProp := curprop;
  2421. Ch_RWFlags:
  2422. begin
  2423. if assigned(LastFlagsChangeProp) then
  2424. LastFlagsChangeProp^.FlagsUsed := true;
  2425. LastFlagsChangeProp := curprop;
  2426. end;
  2427. Ch_FPU:;
  2428. else
  2429. begin
  2430. {$ifdef statedebug}
  2431. hp := tai_comment.Create(strpnew(
  2432. 'destroying all regs for prev instruction'));
  2433. insertllitem(list,p, p.next,hp);
  2434. {$endif statedebug}
  2435. DestroyAllRegs(curprop,true,true);
  2436. LastFlagsChangeProp := curprop;
  2437. end;
  2438. end;
  2439. inc(Cnt);
  2440. end
  2441. end;
  2442. end;
  2443. end;
  2444. end
  2445. else
  2446. begin
  2447. {$ifdef statedebug}
  2448. hp := tai_comment.Create(strpnew(
  2449. 'destroying all regs: unknown tai: '+tostr(ord(p.typ))));
  2450. insertllitem(list,p, p.next,hp);
  2451. {$endif statedebug}
  2452. DestroyAllRegs(curprop,true,true);
  2453. end;
  2454. end;
  2455. inc(InstrCnt);
  2456. prev := p;
  2457. GetNextInstruction(p, p);
  2458. end;
  2459. end;
  2460. function tdfaobj.pass_2: boolean;
  2461. begin
  2462. if initdfapass2 then
  2463. begin
  2464. dodfapass2;
  2465. pass_2 := true
  2466. end
  2467. else
  2468. pass_2 := false;
  2469. end;
  2470. {$ifopt r+}
  2471. {$define rangewason}
  2472. {$r-}
  2473. {$endif}
  2474. function tdfaobj.getlabelwithsym(sym: tasmlabel): tai;
  2475. begin
  2476. if (sym.labelnr >= lolab) and
  2477. (sym.labelnr <= hilab) then { range check, a jump can go past an assembler block! }
  2478. getlabelwithsym := labeltable^[sym.labelnr-lolab].taiobj
  2479. else
  2480. getlabelwithsym := nil;
  2481. end;
  2482. {$ifdef rangewason}
  2483. {$r+}
  2484. {$undef rangewason}
  2485. {$endif}
  2486. procedure tdfaobj.clear;
  2487. begin
  2488. if labdif <> 0 then
  2489. begin
  2490. freemem(labeltable);
  2491. labeltable := nil;
  2492. end;
  2493. if assigned(taipropblock) then
  2494. begin
  2495. freemem(taipropblock, nroftaiobjs*sizeof(ttaiprop));
  2496. taipropblock := nil;
  2497. end;
  2498. end;
  2499. end.
  2500. {
  2501. $Log$
  2502. Revision 1.66 2004-02-27 19:55:23 jonas
  2503. * fixed optimizer for new treference fields
  2504. Revision 1.65 2004/02/27 10:21:05 florian
  2505. * top_symbol killed
  2506. + refaddr to treference added
  2507. + refsymbol to treference added
  2508. * top_local stuff moved to an extra record to save memory
  2509. + aint introduced
  2510. * tppufile.get/putint64/aint implemented
  2511. Revision 1.64 2003/12/23 19:52:55 peter
  2512. * more byte->word
  2513. Revision 1.63 2003/12/22 23:11:41 peter
  2514. * overflow for instruction counters
  2515. Revision 1.62 2003/12/20 22:53:33 jonas
  2516. * fixed some more optimizer bugs, make cycle now works with -O2p3,
  2517. -O2p3u, -O3p3 and -O3p3u
  2518. Revision 1.61 2003/12/15 21:25:49 peter
  2519. * reg allocations for imaginary register are now inserted just
  2520. before reg allocation
  2521. * tregister changed to enum to allow compile time check
  2522. * fixed several tregister-tsuperregister errors
  2523. Revision 1.60 2003/12/15 15:58:58 peter
  2524. * fix statedebug compile
  2525. Revision 1.59 2003/12/14 22:42:14 peter
  2526. * fixed csdebug
  2527. Revision 1.58 2003/12/14 14:18:59 peter
  2528. * optimizer works again with 1.0.x
  2529. * fixed wrong loop in FindRegWithConst
  2530. Revision 1.57 2003/12/13 15:48:47 jonas
  2531. * isgp32reg was being called with both tsuperregister and tregister
  2532. parameters, so changed type to tsuperregister (fixes bug reported by
  2533. Bas Steendijk)
  2534. * improved regsizesok() checking so it gives no false positives anymore
  2535. Revision 1.56 2003/12/07 19:19:56 jonas
  2536. * fixed some more bugs which only showed up in a ppc cross compiler
  2537. Revision 1.55 2003/11/22 13:10:32 jonas
  2538. * fixed double unit usage
  2539. Revision 1.54 2003/11/22 00:40:19 jonas
  2540. * fixed optimiser so it compiles again
  2541. * fixed several bugs which were in there already for a long time, but
  2542. which only popped up now :) -O2/-O3 will now optimise less than in
  2543. the past (and correctly so), but -O2u/-O3u will optimise a bit more
  2544. * some more small improvements for -O3 are still possible
  2545. Revision 1.53 2003/06/13 21:19:31 peter
  2546. * current_procdef removed, use current_procinfo.procdef instead
  2547. Revision 1.52 2003/06/08 18:48:03 jonas
  2548. * first small steps towards an oop optimizer
  2549. Revision 1.51 2003/06/03 21:09:05 peter
  2550. * internal changeregsize for optimizer
  2551. * fix with a hack to not remove the first instruction of a block
  2552. which will leave blockstart pointing to invalid memory
  2553. Revision 1.50 2003/05/26 21:17:18 peter
  2554. * procinlinenode removed
  2555. * aktexit2label removed, fast exit removed
  2556. + tcallnode.inlined_pass_2 added
  2557. Revision 1.49 2003/04/27 11:21:35 peter
  2558. * aktprocdef renamed to current_procinfo.procdef
  2559. * procinfo renamed to current_procinfo
  2560. * procinfo will now be stored in current_module so it can be
  2561. cleaned up properly
  2562. * gen_main_procsym changed to create_main_proc and release_main_proc
  2563. to also generate a tprocinfo structure
  2564. * fixed unit implicit initfinal
  2565. Revision 1.48 2003/03/28 19:16:57 peter
  2566. * generic constructor working for i386
  2567. * remove fixed self register
  2568. * esi added as address register for i386
  2569. Revision 1.47 2003/02/26 21:15:43 daniel
  2570. * Fixed the optimizer
  2571. Revision 1.46 2003/02/19 22:00:15 daniel
  2572. * Code generator converted to new register notation
  2573. - Horribily outdated todo.txt removed
  2574. Revision 1.45 2003/01/08 18:43:57 daniel
  2575. * Tregister changed into a record
  2576. Revision 1.44 2002/11/17 16:31:59 carl
  2577. * memory optimization (3-4%) : cleanup of tai fields,
  2578. cleanup of tdef and tsym fields.
  2579. * make it work for m68k
  2580. Revision 1.43 2002/08/18 20:06:29 peter
  2581. * inlining is now also allowed in interface
  2582. * renamed write/load to ppuwrite/ppuload
  2583. * tnode storing in ppu
  2584. * nld,ncon,nbas are already updated for storing in ppu
  2585. Revision 1.42 2002/08/17 09:23:44 florian
  2586. * first part of procinfo rewrite
  2587. Revision 1.41 2002/07/01 18:46:31 peter
  2588. * internal linker
  2589. * reorganized aasm layer
  2590. Revision 1.40 2002/06/24 12:43:00 jonas
  2591. * fixed errors found with new -CR code from Peter when cycling with -O2p3r
  2592. Revision 1.39 2002/06/09 12:56:04 jonas
  2593. * IDIV reads edx too (but now the div/mod optimization fails :/ )
  2594. Revision 1.38 2002/05/18 13:34:22 peter
  2595. * readded missing revisions
  2596. Revision 1.37 2002/05/16 19:46:51 carl
  2597. + defines.inc -> fpcdefs.inc to avoid conflicts if compiling by hand
  2598. + try to fix temp allocation (still in ifdef)
  2599. + generic constructor calls
  2600. + start of tassembler / tmodulebase class cleanup
  2601. Revision 1.34 2002/05/12 16:53:16 peter
  2602. * moved entry and exitcode to ncgutil and cgobj
  2603. * foreach gets extra argument for passing local data to the
  2604. iterator function
  2605. * -CR checks also class typecasts at runtime by changing them
  2606. into as
  2607. * fixed compiler to cycle with the -CR option
  2608. * fixed stabs with elf writer, finally the global variables can
  2609. be watched
  2610. * removed a lot of routines from cga unit and replaced them by
  2611. calls to cgobj
  2612. * u32bit-s32bit updates for and,or,xor nodes. When one element is
  2613. u32bit then the other is typecasted also to u32bit without giving
  2614. a rangecheck warning/error.
  2615. * fixed pascal calling method with reversing also the high tree in
  2616. the parast, detected by tcalcst3 test
  2617. Revision 1.33 2002/04/21 15:32:59 carl
  2618. * changeregsize -> changeregsize
  2619. Revision 1.32 2002/04/20 21:37:07 carl
  2620. + generic FPC_CHECKPOINTER
  2621. + first parameter offset in stack now portable
  2622. * rename some constants
  2623. + move some cpu stuff to other units
  2624. - remove unused constents
  2625. * fix stacksize for some targets
  2626. * fix generic size problems which depend now on EXTEND_SIZE constant
  2627. * removing frame pointer in routines is only available for : i386,m68k and vis targets
  2628. Revision 1.31 2002/04/15 19:44:20 peter
  2629. * fixed stackcheck that would be called recursively when a stack
  2630. error was found
  2631. * generic changeregsize(reg,size) for i386 register resizing
  2632. * removed some more routines from cga unit
  2633. * fixed returnvalue handling
  2634. * fixed default stacksize of linux and go32v2, 8kb was a bit small :-)
  2635. Revision 1.30 2002/04/15 19:12:09 carl
  2636. + target_info.size_of_pointer -> pointeRS_size
  2637. + some cleanup of unused types/variables
  2638. * move several constants from cpubase to their specific units
  2639. (where they are used)
  2640. + att_Reg2str -> gas_reg2str
  2641. + int_reg2str -> std_reg2str
  2642. Revision 1.29 2002/04/14 17:00:49 carl
  2643. + att_reg2str -> std_reg2str
  2644. Revision 1.28 2002/04/02 17:11:34 peter
  2645. * tlocation,treference update
  2646. * LOC_CONSTANT added for better constant handling
  2647. * secondadd splitted in multiple routines
  2648. * location_force_reg added for loading a location to a register
  2649. of a specified size
  2650. * secondassignment parses now first the right and then the left node
  2651. (this is compatible with Kylix). This saves a lot of push/pop especially
  2652. with string operations
  2653. * adapted some routines to use the new cg methods
  2654. Revision 1.27 2002/03/31 20:26:38 jonas
  2655. + a_loadfpu_* and a_loadmm_* methods in tcg
  2656. * register allocation is now handled by a class and is mostly processor
  2657. independent (+rgobj.pas and i386/rgcpu.pas)
  2658. * temp allocation is now handled by a class (+tgobj.pas, -i386\tgcpu.pas)
  2659. * some small improvements and fixes to the optimizer
  2660. * some register allocation fixes
  2661. * some fpuvaroffset fixes in the unary minus node
  2662. * push/popusedregisters is now called rg.save/restoreusedregisters and
  2663. (for i386) uses temps instead of push/pop's when using -Op3 (that code is
  2664. also better optimizable)
  2665. * fixed and optimized register saving/restoring for new/dispose nodes
  2666. * LOC_FPU locations now also require their "register" field to be set to
  2667. RS_ST, not RS_ST0 (the latter is used for LOC_CFPUREGISTER locations only)
  2668. - list field removed of the tnode class because it's not used currently
  2669. and can cause hard-to-find bugs
  2670. Revision 1.26 2002/03/04 19:10:13 peter
  2671. * removed compiler warnings
  2672. }