daopt386.pas 96 KB

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