rgobj.pas 52 KB

12345678910111213141516171819202122232425262728293031323334353637383940414243444546474849505152535455565758596061626364656667686970717273747576777879808182838485868788899091929394959697989910010110210310410510610710810911011111211311411511611711811912012112212312412512612712812913013113213313413513613713813914014114214314414514614714814915015115215315415515615715815916016116216316416516616716816917017117217317417517617717817918018118218318418518618718818919019119219319419519619719819920020120220320420520620720820921021121221321421521621721821922022122222322422522622722822923023123223323423523623723823924024124224324424524624724824925025125225325425525625725825926026126226326426526626726826927027127227327427527627727827928028128228328428528628728828929029129229329429529629729829930030130230330430530630730830931031131231331431531631731831932032132232332432532632732832933033133233333433533633733833934034134234334434534634734834935035135235335435535635735835936036136236336436536636736836937037137237337437537637737837938038138238338438538638738838939039139239339439539639739839940040140240340440540640740840941041141241341441541641741841942042142242342442542642742842943043143243343443543643743843944044144244344444544644744844945045145245345445545645745845946046146246346446546646746846947047147247347447547647747847948048148248348448548648748848949049149249349449549649749849950050150250350450550650750850951051151251351451551651751851952052152252352452552652752852953053153253353453553653753853954054154254354454554654754854955055155255355455555655755855956056156256356456556656756856957057157257357457557657757857958058158258358458558658758858959059159259359459559659759859960060160260360460560660760860961061161261361461561661761861962062162262362462562662762862963063163263363463563663763863964064164264364464564664764864965065165265365465565665765865966066166266366466566666766866967067167267367467567667767867968068168268368468568668768868969069169269369469569669769869970070170270370470570670770870971071171271371471571671771871972072172272372472572672772872973073173273373473573673773873974074174274374474574674774874975075175275375475575675775875976076176276376476576676776876977077177277377477577677777877978078178278378478578678778878979079179279379479579679779879980080180280380480580680780880981081181281381481581681781881982082182282382482582682782882983083183283383483583683783883984084184284384484584684784884985085185285385485585685785885986086186286386486586686786886987087187287387487587687787887988088188288388488588688788888989089189289389489589689789889990090190290390490590690790890991091191291391491591691791891992092192292392492592692792892993093193293393493593693793893994094194294394494594694794894995095195295395495595695795895996096196296396496596696796896997097197297397497597697797897998098198298398498598698798898999099199299399499599699799899910001001100210031004100510061007100810091010101110121013101410151016101710181019102010211022102310241025102610271028102910301031103210331034103510361037103810391040104110421043104410451046104710481049105010511052105310541055105610571058105910601061106210631064106510661067106810691070107110721073107410751076107710781079108010811082108310841085108610871088108910901091109210931094109510961097109810991100110111021103110411051106110711081109111011111112111311141115111611171118111911201121112211231124112511261127112811291130113111321133113411351136113711381139114011411142114311441145114611471148114911501151115211531154115511561157115811591160116111621163116411651166116711681169117011711172117311741175117611771178117911801181118211831184118511861187118811891190119111921193119411951196119711981199120012011202120312041205120612071208120912101211121212131214121512161217121812191220122112221223122412251226122712281229123012311232123312341235123612371238123912401241124212431244124512461247124812491250125112521253125412551256125712581259126012611262126312641265126612671268126912701271127212731274127512761277127812791280128112821283128412851286128712881289129012911292129312941295129612971298129913001301130213031304130513061307130813091310131113121313131413151316131713181319132013211322132313241325132613271328132913301331133213331334133513361337133813391340134113421343134413451346134713481349135013511352135313541355135613571358135913601361136213631364136513661367136813691370137113721373137413751376137713781379138013811382138313841385138613871388138913901391139213931394139513961397139813991400140114021403140414051406140714081409141014111412141314141415141614171418141914201421142214231424142514261427142814291430143114321433143414351436143714381439144014411442144314441445144614471448144914501451145214531454145514561457145814591460146114621463146414651466146714681469147014711472147314741475147614771478147914801481148214831484148514861487148814891490149114921493149414951496149714981499150015011502150315041505150615071508150915101511151215131514151515161517151815191520152115221523152415251526152715281529153015311532153315341535153615371538153915401541154215431544154515461547154815491550155115521553155415551556155715581559156015611562
  1. {
  2. $Id$
  3. Copyright (c) 1998-2002 by Florian Klaempfl
  4. This unit implements the base class for the register allocator
  5. This program is free software; you can redistribute it and/or modify
  6. it under the terms of the GNU General Public License as published by
  7. the Free Software Foundation; either version 2 of the License, or
  8. (at your option) any later version.
  9. This program is distributed in the hope that it will be useful,
  10. but WITHOUT ANY WARRANTY; without even the implied warranty of
  11. MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
  12. GNU General Public License for more details.
  13. You should have received a copy of the GNU General Public License
  14. along with this program; if not, write to the Free Software
  15. Foundation, Inc., 675 Mass Ave, Cambridge, MA 02139, USA.
  16. ****************************************************************************
  17. }
  18. {$i fpcdefs.inc}
  19. {# @abstract(Abstract register allocator unit)
  20. This unit contains services to allocate, free
  21. references and registers which are used by
  22. the code generator.
  23. }
  24. {*******************************************************************************
  25. (applies to new register allocator)
  26. Register allocator introduction.
  27. Free Pascal uses a Chaitin style register allocator similair to the one
  28. described in the book "Modern compiler implementation in C" by Andrew W. Appel.,
  29. published by Cambridge University Press.
  30. Reading this book is recommended for a complete understanding. Here is a small
  31. introduction.
  32. The code generator thinks it has an infinite amount of registers. Our processor
  33. has a limited amount of registers. Therefore we must reduce the amount of
  34. registers until there are less enough to fit into the processors registers.
  35. Registers can interfere or not interfere. If two imaginary registers interfere
  36. they cannot be placed into the same psysical register. Reduction of registers
  37. is done by:
  38. - "coalescing" Two registers that do not interfere are combined
  39. into one register.
  40. - "spilling" A register is changed into a memory location and the generated
  41. code is modified to use the memory location instead of the register.
  42. Register allocation is a graph colouring problem. Each register is a colour, and
  43. if two registers interfere there is a connection between them in the graph.
  44. In addition to the imaginary registers in the code generator, the psysical
  45. CPU registers are also present in this graph. This allows us to make
  46. interferences between imaginary registers and cpu registers. This is very
  47. usefull for describing archtectural constrains, like for example that
  48. the div instruction modifies edx, so variables that are in use at that time
  49. cannot be stored into edx. This can be modelled by making edx interfere
  50. with those variables.
  51. *******************************************************************************}
  52. unit rgobj;
  53. interface
  54. uses
  55. cutils, cpubase,
  56. cpuinfo,
  57. aasmbase,aasmtai,aasmcpu,
  58. cclasses,globtype,cginfo,cgbase,node
  59. {$ifdef delphi}
  60. ,dmisc
  61. {$endif}
  62. ;
  63. type
  64. regvar_longintarray = array[firstreg..lastreg] of longint;
  65. regvarint_longintarray = array[first_supreg..last_supreg] of longint;
  66. regvar_booleanarray = array[firstreg..lastreg] of boolean;
  67. regvar_ptreearray = array[firstreg..lastreg] of tnode;
  68. tpushedsavedloc = record
  69. case byte of
  70. 0: (pushed: boolean);
  71. 1: (ofs: longint);
  72. end;
  73. tpushedsaved = array[firstreg..lastreg] of tpushedsavedloc;
  74. Tpushedsavedint = array[first_supreg..last_supreg] of Tpushedsavedloc;
  75. Tinterferencebitmap=array[Tsuperregister] of set of Tsuperregister;
  76. Tinterferenceadjlist=array[Tsuperregister] of Pstring;
  77. Tinterferencegraph=record
  78. bitmap:Tinterferencebitmap;
  79. adjlist:Tinterferenceadjlist;
  80. end;
  81. Pinterferencegraph=^Tinterferencegraph;
  82. Tmoveset=(ms_coalesced_moves,ms_constrained_moves,ms_frozen_moves,
  83. ms_worklist_moves,ms_activemoves);
  84. Tmoveins=class(Tlinkedlistitem)
  85. moveset:Tmoveset;
  86. instruction:Taicpu;
  87. end;
  88. {#
  89. This class implements the abstract register allocator
  90. It is used by the code generator to allocate and free
  91. registers which might be valid across nodes. It also
  92. contains utility routines related to registers.
  93. Some of the methods in this class should be overriden
  94. by cpu-specific implementations.
  95. }
  96. trgobj = class
  97. { The "usableregsxxx" contain all registers of type "xxx" that }
  98. { aren't currently allocated to a regvar. The "unusedregsxxx" }
  99. { contain all registers of type "xxx" that aren't currenly }
  100. { allocated }
  101. lastintreg:Tsuperregister;
  102. unusedregsint,usableregsint:Tsupregset;
  103. unusedregsaddr,usableregsaddr:Tsupregset;
  104. unusedregsfpu,usableregsfpu : tregisterset;
  105. unusedregsmm,usableregsmm : tregisterset;
  106. { these counters contain the number of elements in the }
  107. { unusedregsxxx/usableregsxxx sets }
  108. countunusedregsint,
  109. countunusedregsaddr,
  110. countunusedregsfpu,
  111. countunusedregsmm : byte;
  112. countusableregsint,
  113. countusableregsaddr,
  114. countusableregsfpu,
  115. countusableregsmm : byte;
  116. { Contains the registers which are really used by the proc itself.
  117. It doesn't take care of registers used by called procedures
  118. }
  119. usedbyproc,
  120. usedinproc : tregisterset;
  121. usedintbyproc,
  122. usedaddrbyproc,
  123. usedintinproc,
  124. usedaddrinproc:Tsupregset;
  125. reg_pushes : regvar_longintarray;
  126. reg_pushes_int : regvarint_longintarray;
  127. is_reg_var : regvar_booleanarray;
  128. is_reg_var_int:Tsupregset;
  129. regvar_loaded: regvar_booleanarray;
  130. regvar_loaded_int: Tsupregset;
  131. { tries to hold the amount of times which the current tree is processed }
  132. t_times: longint;
  133. constructor create;
  134. {# Allocate a general purpose register
  135. An internalerror will be generated if there
  136. is no more free registers which can be allocated
  137. }
  138. function getregisterint(list:Taasmoutput;size:Tcgsize):Tregister;virtual;
  139. {# Free a general purpose register
  140. @param(r register to free)
  141. }
  142. procedure ungetregisterint(list: taasmoutput; r : tregister); virtual;
  143. {# Allocate a floating point register
  144. An internalerror will be generated if there
  145. is no more free registers which can be allocated
  146. }
  147. function getregisterfpu(list: taasmoutput) : tregister; virtual;
  148. {# Free a floating point register
  149. @param(r register to free)
  150. }
  151. procedure ungetregisterfpu(list: taasmoutput; r : tregister); virtual;
  152. function getregistermm(list: taasmoutput) : tregister; virtual;
  153. procedure ungetregistermm(list: taasmoutput; r : tregister); virtual;
  154. {# Allocate an address register.
  155. Address registers are the only registers which can
  156. be used as a base register in references (treference).
  157. On most cpu's this is the same as a general purpose
  158. register.
  159. An internalerror will be generated if there
  160. is no more free registers which can be allocated
  161. }
  162. function getaddressregister(list:Taasmoutput):Tregister;virtual;
  163. procedure ungetaddressregister(list: taasmoutput; r: tregister); virtual;
  164. {# Verify if the specified register is an address or
  165. general purpose register. Returns TRUE if @var(reg)
  166. is an adress register.
  167. This routine should only be used to check on
  168. general purpose or address register. It will
  169. not work on multimedia or floating point
  170. registers
  171. @param(reg register to verify)
  172. }
  173. function isaddressregister(reg: tregister): boolean; virtual;
  174. {# Tries to allocate the passed register, if possible
  175. @param(r specific register to allocate)
  176. }
  177. function getexplicitregisterint(list:Taasmoutput;r:Tnewregister):Tregister;virtual;
  178. {# Tries to allocate the passed fpu register, if possible
  179. @param(r specific register to allocate)
  180. }
  181. function getexplicitregisterfpu(list : taasmoutput; r : Toldregister) : tregister;
  182. {# Deallocate any kind of register }
  183. procedure ungetregister(list: taasmoutput; r : tregister); virtual;
  184. {# Deallocate all registers which are allocated
  185. in the specified reference. On most systems,
  186. this will free the base and index registers
  187. of the specified reference.
  188. @param(ref reference which must have its registers freed)
  189. }
  190. procedure ungetreference(list: taasmoutput; const ref : treference); virtual;
  191. {# Reset the register allocator information (usable registers etc) }
  192. procedure cleartempgen;virtual;
  193. {# Convert a register to a specified register size, and return that register size }
  194. function makeregsize(reg: tregister; size: tcgsize): tregister; virtual;
  195. {# saves register variables (restoring happens automatically) }
  196. procedure saveintregvars(list:Taasmoutput;const s:Tsupregset);
  197. procedure saveotherregvars(list:Taasmoutput;const s:Tregisterset);
  198. {# Saves in temporary references (allocated via the temp. allocator)
  199. the registers defined in @var(s). The registers are only saved
  200. if they are currently in use, otherwise they are left as is.
  201. On processors which have instructions which manipulate the stack,
  202. this routine should be overriden for performance reasons.
  203. @param(list) List to add the instruction to
  204. @param(saved) Array of saved register information
  205. @param(s) Registers which might require saving
  206. }
  207. procedure saveusedintregisters(list:Taasmoutput;
  208. var saved:Tpushedsavedint;
  209. const s:Tsupregset);virtual;
  210. procedure saveusedotherregisters(list:Taasmoutput;
  211. var saved:Tpushedsaved;
  212. const s:Tregisterset);virtual;
  213. {# Restores the registers which were saved with a call
  214. to @var(saveusedregisters).
  215. On processors which have instructions which manipulate the stack,
  216. this routine should be overriden for performance reasons.
  217. }
  218. procedure restoreusedintregisters(list:Taasmoutput;
  219. const saved:Tpushedsavedint);virtual;
  220. procedure restoreusedotherregisters(list:Taasmoutput;
  221. const saved:Tpushedsaved);virtual;
  222. { used when deciding which registers to use for regvars }
  223. procedure incrementintregisterpushed(const s:Tsupregset);
  224. procedure incrementotherregisterpushed(const s: tregisterset);
  225. procedure clearregistercount;
  226. procedure resetusableregisters;virtual;
  227. procedure makeregvarint(reg:Tnewregister);
  228. procedure makeregvarother(reg:Tregister);
  229. procedure saveStateForInline(var state: pointer);virtual;
  230. procedure restoreStateAfterInline(var state: pointer);virtual;
  231. procedure saveUnusedState(var state: pointer);virtual;
  232. procedure restoreUnusedState(var state: pointer);virtual;
  233. {$ifdef newra}
  234. procedure writegraph;
  235. {$endif}
  236. protected
  237. {$ifdef newra}
  238. igraph:Tinterferencegraph;
  239. movelist:array[Tsuperregister] of Tlinkedlist;
  240. worklistmoves:Tlinkedlist;
  241. {$endif}
  242. { the following two contain the common (generic) code for all }
  243. { get- and ungetregisterxxx functions/procedures }
  244. function getregistergen(list: taasmoutput; const lowreg, highreg: Toldregister;
  245. var unusedregs:Tregisterset; var countunusedregs: byte): tregister;
  246. function getregistergenint(list:Taasmoutput;subreg:Tsubregister;
  247. const lowreg,highreg:Tsuperregister;
  248. var fusedinproc,fusedbyproc,unusedregs:Tsupregset;
  249. var countunusedregs:byte):Tregister;
  250. procedure ungetregistergen(list: taasmoutput; const r: tregister;
  251. const usableregs: tregisterset; var unusedregs: tregisterset; var countunusedregs: byte);
  252. procedure ungetregistergenint(list:taasmoutput;const r:Tregister;
  253. const usableregs:Tsupregset;
  254. var unusedregs:Tsupregset;
  255. var countunusedregs:byte);
  256. {$ifdef TEMPREGDEBUG}
  257. reg_user : regvar_ptreearray;
  258. reg_releaser : regvar_ptreearray;
  259. {$endif TEMPREGDEBUG}
  260. {$ifdef TEMPREGDEBUG}
  261. procedure testregisters;
  262. {$endif TEMPREGDEBUGx}
  263. {$ifdef newra}
  264. procedure add_edge(u,v:Tsuperregister);
  265. procedure add_edges_used(u:Tsuperregister);
  266. {$endif}
  267. end;
  268. const
  269. {# This value is used in tsaved. If the array value is equal
  270. to this, then this means that this register is not used.
  271. }
  272. reg_not_saved = $7fffffff;
  273. var
  274. {# This is the class instance used to access the register allocator class }
  275. rg: trgobj;
  276. { trerefence handling }
  277. {# Clear to zero a treference }
  278. procedure reference_reset(var ref : treference);
  279. procedure reference_reset_old(var ref : treference);
  280. {# Clear to zero a treference, and set is base address
  281. to base register.
  282. }
  283. procedure reference_reset_base(var ref : treference;base : tregister;offset : longint);
  284. procedure reference_reset_symbol(var ref : treference;sym : tasmsymbol;offset : longint);
  285. procedure reference_release(list: taasmoutput; const ref : treference);
  286. { This routine verifies if two references are the same, and
  287. if so, returns TRUE, otherwise returns false.
  288. }
  289. function references_equal(sref : treference;dref : treference) : boolean;
  290. { tlocation handling }
  291. procedure location_reset(var l : tlocation;lt:TLoc;lsize:TCGSize);
  292. procedure location_release(list: taasmoutput; const l : tlocation);
  293. procedure location_freetemp(list: taasmoutput; const l : tlocation);
  294. procedure location_copy(var destloc,sourceloc : tlocation);
  295. procedure location_swap(var destloc,sourceloc : tlocation);
  296. type
  297. psavedstate = ^tsavedstate;
  298. tsavedstate = record
  299. unusedregsint,usableregsint : Tsupregset;
  300. unusedregsaddr,usableregsaddr : Tsupregset;
  301. unusedregsfpu,usableregsfpu : tregisterset;
  302. unusedregsmm,usableregsmm : tregisterset;
  303. countunusedregsint,
  304. countunusedregsaddr,
  305. countunusedregsfpu,
  306. countunusedregsmm : byte;
  307. countusableregsint,
  308. countusableregsfpu,
  309. countusableregsmm : byte;
  310. { contains the registers which are really used by the proc itself }
  311. usedbyproc,
  312. usedinproc : tregisterset;
  313. reg_pushes : regvar_longintarray;
  314. is_reg_var : regvar_booleanarray;
  315. is_reg_var_int : Tsupregset;
  316. regvar_loaded: regvar_booleanarray;
  317. regvar_loaded_int: Tsupregset;
  318. {$ifdef TEMPREGDEBUG}
  319. reg_user : regvar_ptreearray;
  320. reg_releaser : regvar_ptreearray;
  321. {$endif TEMPREGDEBUG}
  322. end;
  323. punusedstate = ^tunusedstate;
  324. tunusedstate = record
  325. unusedregsint : Tsupregset;
  326. unusedregsaddr : Tsupregset;
  327. unusedregsfpu : tregisterset;
  328. unusedregsmm : tregisterset;
  329. countunusedregsint,
  330. countunusedregsaddr,
  331. countunusedregsfpu,
  332. countunusedregsmm : byte;
  333. end;
  334. implementation
  335. uses
  336. systems,
  337. globals,verbose,
  338. cgobj,tgobj,regvars;
  339. constructor trgobj.create;
  340. begin
  341. usedinproc := [];
  342. usedbyproc:=[];
  343. t_times := 0;
  344. resetusableregisters;
  345. lastintreg:=0;
  346. {$ifdef TEMPREGDEBUG}
  347. fillchar(reg_user,sizeof(reg_user),0);
  348. fillchar(reg_releaser,sizeof(reg_releaser),0);
  349. {$endif TEMPREGDEBUG}
  350. {$ifdef newra}
  351. fillchar(igraph,sizeof(igraph),0);
  352. fillchar(movelist,sizeof(movelist),0);
  353. worklistmoves.create;
  354. {$endif}
  355. end;
  356. function trgobj.getregistergen(list: taasmoutput; const lowreg, highreg: Toldregister;
  357. var unusedregs: tregisterset; var countunusedregs: byte): tregister;
  358. var
  359. i: Toldregister;
  360. r: Tregister;
  361. begin
  362. for i:=lowreg to highreg do
  363. begin
  364. if i in unusedregs then
  365. begin
  366. exclude(unusedregs,i);
  367. include(usedinproc,i);
  368. include(usedbyproc,i);
  369. dec(countunusedregs);
  370. r.enum:=i;
  371. list.concat(tai_regalloc.alloc(r));
  372. result := r;
  373. exit;
  374. end;
  375. end;
  376. internalerror(10);
  377. end;
  378. function Trgobj.getregistergenint(list:Taasmoutput;
  379. subreg:Tsubregister;
  380. const lowreg,highreg:Tsuperregister;
  381. var fusedinproc,fusedbyproc,unusedregs:Tsupregset;
  382. var countunusedregs:byte):Tregister;
  383. var i:Tsuperregister;
  384. r:Tregister;
  385. begin
  386. if not (lastintreg in [lowreg..highreg]) then
  387. lastintreg:=lowreg;
  388. i:=lastintreg;
  389. repeat
  390. if i=highreg then
  391. i:=lowreg
  392. else
  393. inc(i);
  394. if i in unusedregs then
  395. begin
  396. exclude(unusedregs,i);
  397. include(fusedinproc,i);
  398. include(fusedbyproc,i);
  399. dec(countunusedregs);
  400. r.enum:=R_INTREGISTER;
  401. r.number:=i shl 8 or subreg;
  402. list.concat(Tai_regalloc.alloc(r));
  403. result:=r;
  404. lastintreg:=i;
  405. {$ifdef newra}
  406. add_edges_used(i);
  407. {$endif}
  408. exit;
  409. end;
  410. until i=lastintreg;
  411. internalerror(10);
  412. end;
  413. procedure trgobj.ungetregistergen(list: taasmoutput; const r: tregister;
  414. const usableregs: tregisterset; var unusedregs: tregisterset; var countunusedregs: byte);
  415. begin
  416. if r.enum>lastreg then
  417. internalerror(2003010801);
  418. { takes much time }
  419. if not(r.enum in usableregs) then
  420. exit;
  421. {$ifdef TEMPREGDEBUG}
  422. if (r.enum in unusedregs) then
  423. {$ifdef EXTTEMPREGDEBUG}
  424. begin
  425. Comment(V_Debug,'register freed twice '+std_reg2str[r.enum]);
  426. testregisters32;
  427. exit;
  428. end
  429. {$else EXTTEMPREGDEBUG}
  430. exit
  431. {$endif EXTTEMPREGDEBUG}
  432. else
  433. {$endif TEMPREGDEBUG}
  434. inc(countunusedregs);
  435. include(unusedregs,r.enum);
  436. list.concat(tai_regalloc.dealloc(r));
  437. end;
  438. procedure trgobj.ungetregistergenint(list:taasmoutput;const r:Tregister;
  439. const usableregs:Tsupregset;
  440. var unusedregs:Tsupregset;
  441. var countunusedregs:byte);
  442. var supreg:Tsuperregister;
  443. begin
  444. if r.enum<=lastreg then
  445. internalerror(2003010803);
  446. supreg:=r.number shr 8;
  447. { takes much time }
  448. {$ifndef newra}
  449. if not(supreg in usableregs) then
  450. exit;
  451. {$endif}
  452. {$ifdef TEMPREGDEBUG}
  453. if (supreg in unusedregs) then
  454. {$ifdef EXTTEMPREGDEBUG}
  455. begin
  456. comment(v_debug,'register freed twice '+supreg_name(supreg));
  457. testregisters32;
  458. exit;
  459. end
  460. {$else EXTTEMPREGDEBUG}
  461. exit
  462. {$endif EXTTEMPREGDEBUG}
  463. else
  464. {$endif TEMPREGDEBUG}
  465. inc(countunusedregs);
  466. include(unusedregs,supreg);
  467. list.concat(tai_regalloc.dealloc(r));
  468. {$ifdef newra}
  469. add_edges_used(supreg);
  470. {$endif newra}
  471. end;
  472. function trgobj.getregisterint(list:taasmoutput;size:Tcgsize):Tregister;
  473. var subreg:Tsubregister;
  474. begin
  475. if countunusedregsint=0 then
  476. internalerror(10);
  477. {$ifdef TEMPREGDEBUG}
  478. if curptree^^.usableregs-countunusedregsint>curptree^^.registers32 then
  479. internalerror(10);
  480. {$endif TEMPREGDEBUG}
  481. {$ifdef EXTTEMPREGDEBUG}
  482. if curptree^^.usableregs-countunusedregsint>curptree^^.reallyusedregs then
  483. curptree^^.reallyusedregs:=curptree^^.usableregs-countunusedregsint;
  484. {$endif EXTTEMPREGDEBUG}
  485. subreg:=cgsize2subreg(size);
  486. result:=getregistergenint(list,
  487. subreg,
  488. {$ifdef newra}
  489. first_imreg,
  490. last_imreg,
  491. {$else}
  492. first_supreg,
  493. last_supreg,
  494. {$endif}
  495. usedintbyproc,
  496. usedintinproc,
  497. unusedregsint,
  498. countunusedregsint);
  499. {$ifdef TEMPREGDEBUG}
  500. reg_user[result]:=curptree^;
  501. testregisters32;
  502. {$endif TEMPREGDEBUG}
  503. end;
  504. procedure trgobj.ungetregisterint(list : taasmoutput; r : tregister);
  505. begin
  506. ungetregistergenint(list,r,usableregsint,unusedregsint,
  507. countunusedregsint);
  508. {$ifdef TEMPREGDEBUG}
  509. reg_releaser[r]:=curptree^;
  510. testregisters32;
  511. {$endif TEMPREGDEBUG}
  512. end;
  513. { tries to allocate the passed register, if possible }
  514. function trgobj.getexplicitregisterint(list:Taasmoutput;r:Tnewregister):Tregister;
  515. var r2:Tregister;
  516. begin
  517. if (r shr 8) in unusedregsint then
  518. begin
  519. dec(countunusedregsint);
  520. {$ifdef TEMPREGDEBUG}
  521. if curptree^^.usableregs-countunusedregsint>curptree^^.registers32 then
  522. internalerror(10);
  523. reg_user[r shr 8]:=curptree^;
  524. {$endif TEMPREGDEBUG}
  525. exclude(unusedregsint,r shr 8);
  526. include(usedintinproc,r shr 8);
  527. include(usedintbyproc,r shr 8);
  528. r2.enum:=R_INTREGISTER;
  529. r2.number:=r;
  530. list.concat(tai_regalloc.alloc(r2));
  531. {$ifdef TEMPREGDEBUG}
  532. testregisters32;
  533. {$endif TEMPREGDEBUG}
  534. end
  535. else
  536. internalerror(200301103);
  537. getexplicitregisterint:=r2;
  538. end;
  539. { tries to allocate the passed register, if possible }
  540. function trgobj.getexplicitregisterfpu(list : taasmoutput; r : Toldregister) : tregister;
  541. var r2:Tregister;
  542. begin
  543. if r in unusedregsfpu then
  544. begin
  545. dec(countunusedregsfpu);
  546. {$ifdef TEMPREGDEBUG}
  547. if curptree^^.usableregs-countunusedregsint>curptree^^.registers32 then
  548. internalerror(10);
  549. reg_user[r]:=curptree^;
  550. {$endif TEMPREGDEBUG}
  551. exclude(unusedregsfpu,r);
  552. include(usedinproc,r);
  553. include(usedbyproc,r);
  554. r2.enum:=r;
  555. list.concat(tai_regalloc.alloc(r2));
  556. getexplicitregisterfpu:=r2;
  557. {$ifdef TEMPREGDEBUG}
  558. testregisters32;
  559. {$endif TEMPREGDEBUG}
  560. end
  561. else
  562. getexplicitregisterfpu:=getregisterfpu(list);
  563. end;
  564. function trgobj.getregisterfpu(list: taasmoutput) : tregister;
  565. begin
  566. if countunusedregsfpu=0 then
  567. internalerror(10);
  568. result := getregistergen(list,firstsavefpureg,lastsavefpureg,
  569. unusedregsfpu,countunusedregsfpu);
  570. end;
  571. procedure trgobj.ungetregisterfpu(list : taasmoutput; r : tregister);
  572. begin
  573. ungetregistergen(list,r,usableregsfpu,unusedregsfpu,
  574. countunusedregsfpu);
  575. end;
  576. function trgobj.getregistermm(list: taasmoutput) : tregister;
  577. begin
  578. if countunusedregsmm=0 then
  579. internalerror(10);
  580. result := getregistergen(list,firstsavemmreg,lastsavemmreg,
  581. unusedregsmm,countunusedregsmm);
  582. end;
  583. procedure trgobj.ungetregistermm(list: taasmoutput; r: tregister);
  584. begin
  585. ungetregistergen(list,r,usableregsmm,unusedregsmm,
  586. countunusedregsmm);
  587. end;
  588. function trgobj.getaddressregister(list:Taasmoutput): tregister;
  589. begin
  590. {An address register is OS_INT per definition.}
  591. result := getregisterint(list,OS_INT);
  592. end;
  593. procedure trgobj.ungetaddressregister(list: taasmoutput; r: tregister);
  594. begin
  595. ungetregisterint(list,r);
  596. end;
  597. function trgobj.isaddressregister(reg: tregister): boolean;
  598. begin
  599. result := true;
  600. end;
  601. procedure trgobj.ungetregister(list: taasmoutput; r : tregister);
  602. begin
  603. if r.enum=R_NO then
  604. exit;
  605. if r.enum>lastreg then
  606. internalerror(200301081);
  607. if r.enum in intregs then
  608. ungetregisterint(list,r)
  609. else if r.enum in fpuregs then
  610. ungetregisterfpu(list,r)
  611. else if r.enum in mmregs then
  612. ungetregistermm(list,r)
  613. else if r.enum in addrregs then
  614. ungetaddressregister(list,r)
  615. else internalerror(2002070602);
  616. end;
  617. procedure Trgobj.cleartempgen;
  618. {$ifdef newra}
  619. var i:Tsuperregister;
  620. {$endif newra}
  621. begin
  622. countunusedregsint:=countusableregsint;
  623. countunusedregsfpu:=countusableregsfpu;
  624. countunusedregsmm:=countusableregsmm;
  625. {$ifdef newra}
  626. unusedregsint:=[0..255];
  627. {$else}
  628. unusedregsint:=usableregsint;
  629. {$endif}
  630. unusedregsfpu:=usableregsfpu;
  631. unusedregsmm:=usableregsmm;
  632. {$ifdef newra}
  633. for i:=low(Tsuperregister) to high(Tsuperregister) do
  634. begin
  635. if igraph.adjlist[i]<>nil then
  636. dispose(igraph.adjlist[i]);
  637. if movelist[i]<>nil then
  638. movelist[i].destroy;
  639. end;
  640. fillchar(igraph,sizeof(igraph),0);
  641. worklistmoves.destroy;
  642. {$endif}
  643. end;
  644. procedure trgobj.ungetreference(list : taasmoutput; const ref : treference);
  645. begin
  646. if ref.base.number<>NR_NO then
  647. ungetregisterint(list,ref.base);
  648. if ref.index.number<>NR_NO then
  649. ungetregisterint(list,ref.index);
  650. end;
  651. procedure trgobj.saveintregvars(list:Taasmoutput;const s:Tsupregset);
  652. var r:Tsuperregister;
  653. begin
  654. if not(cs_regalloc in aktglobalswitches) then
  655. exit;
  656. for r:=firstsaveintreg to lastsaveintreg do
  657. if (r in is_reg_var_int) and
  658. (r in s) then
  659. store_regvar_int(list,r);
  660. end;
  661. procedure trgobj.saveotherregvars(list: taasmoutput; const s: tregisterset);
  662. var
  663. r: Tregister;
  664. begin
  665. if not(cs_regalloc in aktglobalswitches) then
  666. exit;
  667. if firstsavefpureg <> R_NO then
  668. for r.enum := firstsavefpureg to lastsavefpureg do
  669. if is_reg_var[r.enum] and
  670. (r.enum in s) then
  671. store_regvar(list,r);
  672. if firstsavemmreg <> R_NO then
  673. for r.enum := firstsavemmreg to lastsavemmreg do
  674. if is_reg_var[r.enum] and
  675. (r.enum in s) then
  676. store_regvar(list,r);
  677. end;
  678. procedure trgobj.saveusedintregisters(list:Taasmoutput;
  679. var saved:Tpushedsavedint;
  680. const s:Tsupregset);
  681. var r:Tsuperregister;
  682. r2:Tregister;
  683. hr : treference;
  684. begin
  685. usedintinproc:=usedintinproc+s;
  686. for r:=firstsaveintreg to lastsaveintreg do
  687. begin
  688. saved[r].ofs:=reg_not_saved;
  689. { if the register is used by the calling subroutine and if }
  690. { it's not a regvar (those are handled separately) }
  691. if not (r in is_reg_var_int) and
  692. (r in s) and
  693. { and is present in use }
  694. not(r in unusedregsint) then
  695. begin
  696. { then save it }
  697. tg.GetTemp(list,sizeof(aword),tt_persistant,hr);
  698. saved[r].ofs:=hr.offset;
  699. r2.enum:=R_INTREGISTER;
  700. r2.number:=r shl 8 or R_SUBWHOLE;
  701. cg.a_load_reg_ref(list,OS_INT,r2,hr);
  702. cg.a_reg_dealloc(list,r2);
  703. include(unusedregsint,r);
  704. inc(countunusedregsint);
  705. end;
  706. end;
  707. {$ifdef TEMPREGDEBUG}
  708. testregisters32;
  709. {$endif TEMPREGDEBUG}
  710. end;
  711. procedure trgobj.saveusedotherregisters(list: taasmoutput;
  712. var saved : tpushedsaved; const s: tregisterset);
  713. var
  714. r : tregister;
  715. hr : treference;
  716. begin
  717. usedinproc:=usedinproc + s;
  718. { don't try to save the fpu registers if not desired (e.g. for }
  719. { the 80x86) }
  720. if firstsavefpureg <> R_NO then
  721. for r.enum:=firstsavefpureg to lastsavefpureg do
  722. begin
  723. saved[r.enum].ofs:=reg_not_saved;
  724. { if the register is used by the calling subroutine and if }
  725. { it's not a regvar (those are handled separately) }
  726. if not is_reg_var[r.enum] and
  727. (r.enum in s) and
  728. { and is present in use }
  729. not(r.enum in unusedregsfpu) then
  730. begin
  731. { then save it }
  732. tg.GetTemp(list,extended_size,tt_persistant,hr);
  733. saved[r.enum].ofs:=hr.offset;
  734. cg.a_loadfpu_reg_ref(list,OS_FLOAT,r,hr);
  735. cg.a_reg_dealloc(list,r);
  736. include(unusedregsfpu,r.enum);
  737. inc(countunusedregsfpu);
  738. end;
  739. end;
  740. { don't save the vector registers if there's no support for them }
  741. if firstsavemmreg <> R_NO then
  742. for r.enum:=firstsavemmreg to lastsavemmreg do
  743. begin
  744. saved[r.enum].ofs:=reg_not_saved;
  745. { if the register is in use and if it's not a regvar (those }
  746. { are handled separately), save it }
  747. if not is_reg_var[r.enum] and
  748. (r.enum in s) and
  749. { and is present in use }
  750. not(r.enum in unusedregsmm) then
  751. begin
  752. { then save it }
  753. tg.GetTemp(list,mmreg_size,tt_persistant,hr);
  754. saved[r.enum].ofs:=hr.offset;
  755. cg.a_loadmm_reg_ref(list,r,hr);
  756. cg.a_reg_dealloc(list,r);
  757. include(unusedregsmm,r.enum);
  758. inc(countunusedregsmm);
  759. end;
  760. end;
  761. {$ifdef TEMPREGDEBUG}
  762. testregisters32;
  763. {$endif TEMPREGDEBUG}
  764. end;
  765. procedure trgobj.restoreusedintregisters(list:Taasmoutput;
  766. const saved:Tpushedsavedint);
  767. var r:Tsuperregister;
  768. r2:Tregister;
  769. hr:Treference;
  770. begin
  771. for r:=lastsaveintreg downto firstsaveintreg do
  772. begin
  773. if saved[r].ofs <> reg_not_saved then
  774. begin
  775. r2.enum:=R_INTREGISTER;
  776. r2.number:=NR_FRAME_POINTER_REG;
  777. reference_reset_base(hr,r2,saved[r].ofs);
  778. r2.enum:=R_INTREGISTER;
  779. r2.number:=r shl 8 or R_SUBWHOLE;
  780. cg.a_reg_alloc(list,r2);
  781. cg.a_load_ref_reg(list,OS_INT,hr,r2);
  782. if not (r in unusedregsint) then
  783. { internalerror(10)
  784. in n386cal we always save/restore the reg *state*
  785. using save/restoreunusedstate -> the current state
  786. may not be real (JM) }
  787. else
  788. begin
  789. dec(countunusedregsint);
  790. exclude(unusedregsint,r);
  791. end;
  792. tg.UnGetTemp(list,hr);
  793. end;
  794. end;
  795. {$ifdef TEMPREGDEBUG}
  796. testregisters32;
  797. {$endif TEMPREGDEBUG}
  798. end;
  799. procedure trgobj.restoreusedotherregisters(list : taasmoutput;
  800. const saved : tpushedsaved);
  801. var
  802. r,r2 : tregister;
  803. hr : treference;
  804. begin
  805. if firstsavemmreg <> R_NO then
  806. for r.enum:=lastsavemmreg downto firstsavemmreg do
  807. begin
  808. if saved[r.enum].ofs <> reg_not_saved then
  809. begin
  810. r2.enum:=R_INTREGISTER;
  811. r2.number:=NR_FRAME_POINTER_REG;
  812. reference_reset_base(hr,r2,saved[r.enum].ofs);
  813. cg.a_reg_alloc(list,r);
  814. cg.a_loadmm_ref_reg(list,hr,r);
  815. if not (r.enum in unusedregsmm) then
  816. { internalerror(10)
  817. in n386cal we always save/restore the reg *state*
  818. using save/restoreunusedstate -> the current state
  819. may not be real (JM) }
  820. else
  821. begin
  822. dec(countunusedregsmm);
  823. exclude(unusedregsmm,r.enum);
  824. end;
  825. tg.UnGetTemp(list,hr);
  826. end;
  827. end;
  828. if firstsavefpureg <> R_NO then
  829. for r.enum:=lastsavefpureg downto firstsavefpureg do
  830. begin
  831. if saved[r.enum].ofs <> reg_not_saved then
  832. begin
  833. r2.enum:=R_INTREGISTER;
  834. r2.number:=NR_FRAME_POINTER_REG;
  835. reference_reset_base(hr,r2,saved[r.enum].ofs);
  836. cg.a_reg_alloc(list,r);
  837. cg.a_loadfpu_ref_reg(list,OS_FLOAT,hr,r);
  838. if not (r.enum in unusedregsfpu) then
  839. { internalerror(10)
  840. in n386cal we always save/restore the reg *state*
  841. using save/restoreunusedstate -> the current state
  842. may not be real (JM) }
  843. else
  844. begin
  845. dec(countunusedregsfpu);
  846. exclude(unusedregsfpu,r.enum);
  847. end;
  848. tg.UnGetTemp(list,hr);
  849. end;
  850. end;
  851. {$ifdef TEMPREGDEBUG}
  852. testregisters32;
  853. {$endif TEMPREGDEBUG}
  854. end;
  855. procedure trgobj.incrementintregisterpushed(const s:Tsupregset);
  856. var regi:Tsuperregister;
  857. begin
  858. for regi:=firstsaveintreg to lastsaveintreg do
  859. begin
  860. if (regi in s) then
  861. inc(reg_pushes_int[regi],t_times*2);
  862. end;
  863. end;
  864. procedure trgobj.incrementotherregisterpushed(const s:Tregisterset);
  865. var
  866. regi : Toldregister;
  867. begin
  868. if firstsavefpureg <> R_NO then
  869. for regi:=firstsavefpureg to lastsavefpureg do
  870. begin
  871. if (regi in s) then
  872. inc(reg_pushes[regi],t_times*2);
  873. end;
  874. if firstsavemmreg <> R_NO then
  875. for regi:=firstsavemmreg to lastsavemmreg do
  876. begin
  877. if (regi in s) then
  878. inc(reg_pushes[regi],t_times*2);
  879. end;
  880. end;
  881. procedure trgobj.clearregistercount;
  882. begin
  883. fillchar(reg_pushes,sizeof(reg_pushes),0);
  884. fillchar(is_reg_var,sizeof(is_reg_var),false);
  885. is_reg_var_int:=[];
  886. fillchar(regvar_loaded,sizeof(regvar_loaded),false);
  887. regvar_loaded_int:=[];
  888. end;
  889. procedure trgobj.resetusableregisters;
  890. begin
  891. { initialize fields with constant values from cpubase }
  892. countusableregsint := cpubase.c_countusableregsint;
  893. countusableregsfpu := cpubase.c_countusableregsfpu;
  894. countusableregsmm := cpubase.c_countusableregsmm;
  895. usableregsint := cpubase.usableregsint;
  896. usableregsfpu := cpubase.usableregsfpu;
  897. usableregsmm := cpubase.usableregsmm;
  898. clearregistercount;
  899. end;
  900. procedure trgobj.makeregvarint(reg:Tnewregister);
  901. var supreg:Tsuperregister;
  902. begin
  903. supreg:=reg shr 8;
  904. dec(countusableregsint);
  905. dec(countunusedregsint);
  906. exclude(usableregsint,reg);
  907. exclude(unusedregsint,reg);
  908. include(is_reg_var_int,supreg);
  909. end;
  910. procedure trgobj.makeregvarother(reg: tregister);
  911. begin
  912. if reg.enum>lastreg then
  913. internalerror(200301081);
  914. if reg.enum in intregs then
  915. internalerror(200301151)
  916. else if reg.enum in fpuregs then
  917. begin
  918. dec(countusableregsfpu);
  919. dec(countunusedregsfpu);
  920. exclude(usableregsfpu,reg.enum);
  921. exclude(unusedregsfpu,reg.enum);
  922. end
  923. else if reg.enum in mmregs then
  924. begin
  925. dec(countusableregsmm);
  926. dec(countunusedregsmm);
  927. exclude(usableregsmm,reg.enum);
  928. exclude(unusedregsmm,reg.enum);
  929. end;
  930. is_reg_var[reg.enum]:=true;
  931. end;
  932. {$ifdef TEMPREGDEBUG}
  933. procedure trgobj.testregisters;
  934. var
  935. r: tregister;
  936. test : byte;
  937. begin
  938. test:=0;
  939. for r := firstsaveintreg to lastsaveintreg do
  940. inc(test,ord(r in unusedregsint));
  941. if test<>countunusedregsint then
  942. internalerror(10);
  943. end;
  944. {$endif TEMPREGDEBUG}
  945. procedure trgobj.saveStateForInline(var state: pointer);
  946. begin
  947. new(psavedstate(state));
  948. psavedstate(state)^.unusedregsint := unusedregsint;
  949. psavedstate(state)^.usableregsint := usableregsint;
  950. psavedstate(state)^.unusedregsfpu := unusedregsfpu;
  951. psavedstate(state)^.usableregsfpu := usableregsfpu;
  952. psavedstate(state)^.unusedregsmm := unusedregsmm;
  953. psavedstate(state)^.usableregsmm := usableregsmm;
  954. psavedstate(state)^.countunusedregsint := countunusedregsint;
  955. psavedstate(state)^.countunusedregsfpu := countunusedregsfpu;
  956. psavedstate(state)^.countunusedregsmm := countunusedregsmm;
  957. psavedstate(state)^.countusableregsint := countusableregsint;
  958. psavedstate(state)^.countusableregsfpu := countusableregsfpu;
  959. psavedstate(state)^.countusableregsmm := countusableregsmm;
  960. psavedstate(state)^.usedinproc := usedinproc;
  961. psavedstate(state)^.usedbyproc := usedbyproc;
  962. psavedstate(state)^.reg_pushes := reg_pushes;
  963. psavedstate(state)^.is_reg_var := is_reg_var;
  964. psavedstate(state)^.is_reg_var_int := is_reg_var_int;
  965. psavedstate(state)^.regvar_loaded := regvar_loaded;
  966. psavedstate(state)^.regvar_loaded_int := regvar_loaded_int;
  967. {$ifdef TEMPREGDEBUG}
  968. psavedstate(state)^.reg_user := reg_user;
  969. psavedstate(state)^.reg_releaser := reg_releaser;
  970. {$endif TEMPREGDEBUG}
  971. end;
  972. procedure trgobj.restoreStateAfterInline(var state: pointer);
  973. begin
  974. unusedregsint := psavedstate(state)^.unusedregsint;
  975. usableregsint := psavedstate(state)^.usableregsint;
  976. unusedregsfpu := psavedstate(state)^.unusedregsfpu;
  977. usableregsfpu := psavedstate(state)^.usableregsfpu;
  978. unusedregsmm := psavedstate(state)^.unusedregsmm;
  979. usableregsmm := psavedstate(state)^.usableregsmm;
  980. countunusedregsint := psavedstate(state)^.countunusedregsint;
  981. countunusedregsfpu := psavedstate(state)^.countunusedregsfpu;
  982. countunusedregsmm := psavedstate(state)^.countunusedregsmm;
  983. countusableregsint := psavedstate(state)^.countusableregsint;
  984. countusableregsfpu := psavedstate(state)^.countusableregsfpu;
  985. countusableregsmm := psavedstate(state)^.countusableregsmm;
  986. usedinproc := psavedstate(state)^.usedinproc;
  987. usedbyproc := psavedstate(state)^.usedbyproc;
  988. reg_pushes := psavedstate(state)^.reg_pushes;
  989. is_reg_var := psavedstate(state)^.is_reg_var;
  990. is_reg_var_int := psavedstate(state)^.is_reg_var_int;
  991. regvar_loaded := psavedstate(state)^.regvar_loaded;
  992. regvar_loaded_int := psavedstate(state)^.regvar_loaded_int;
  993. {$ifdef TEMPREGDEBUG}
  994. reg_user := psavedstate(state)^.reg_user;
  995. reg_releaser := psavedstate(state)^.reg_releaser;
  996. {$endif TEMPREGDEBUG}
  997. dispose(psavedstate(state));
  998. state := nil;
  999. end;
  1000. procedure trgobj.saveUnusedState(var state: pointer);
  1001. begin
  1002. new(punusedstate(state));
  1003. punusedstate(state)^.unusedregsint := unusedregsint;
  1004. punusedstate(state)^.unusedregsfpu := unusedregsfpu;
  1005. punusedstate(state)^.unusedregsmm := unusedregsmm;
  1006. punusedstate(state)^.countunusedregsint := countunusedregsint;
  1007. punusedstate(state)^.countunusedregsfpu := countunusedregsfpu;
  1008. punusedstate(state)^.countunusedregsmm := countunusedregsmm;
  1009. end;
  1010. procedure trgobj.restoreUnusedState(var state: pointer);
  1011. begin
  1012. unusedregsint := punusedstate(state)^.unusedregsint;
  1013. unusedregsfpu := punusedstate(state)^.unusedregsfpu;
  1014. unusedregsmm := punusedstate(state)^.unusedregsmm;
  1015. countunusedregsint := punusedstate(state)^.countunusedregsint;
  1016. countunusedregsfpu := punusedstate(state)^.countunusedregsfpu;
  1017. countunusedregsmm := punusedstate(state)^.countunusedregsmm;
  1018. dispose(punusedstate(state));
  1019. state := nil;
  1020. end;
  1021. {$ifdef newra}
  1022. procedure Trgobj.add_edge(u,v:Tsuperregister);
  1023. {This procedure will add an edge to the virtual interference graph.}
  1024. procedure addadj(u,v:Tsuperregister);
  1025. begin
  1026. if igraph.adjlist[u]=nil then
  1027. begin
  1028. getmem(igraph.adjlist[u],16);
  1029. igraph.adjlist[u]^:='';
  1030. end
  1031. else if (length(igraph.adjlist[u]^) and 15)=15 then
  1032. reallocmem(igraph.adjlist[u],length(igraph.adjlist[u]^)+16);
  1033. igraph.adjlist[u]^:=igraph.adjlist[u]^+char(v);
  1034. end;
  1035. begin
  1036. if (u<>v) and not(v in igraph.bitmap[u]) then
  1037. begin
  1038. include(igraph.bitmap[u],v);
  1039. include(igraph.bitmap[v],u);
  1040. {Precoloured nodes are not stored in the interference graph.}
  1041. if not(u in [first_supreg..last_supreg]) then
  1042. addadj(u,v);
  1043. if not(v in [first_supreg..last_supreg]) then
  1044. addadj(v,u);
  1045. end;
  1046. end;
  1047. procedure Trgobj.add_edges_used(u:Tsuperregister);
  1048. var i:Tsuperregister;
  1049. begin
  1050. for i:=1 to 255 do
  1051. if not(i in unusedregsint) then
  1052. add_edge(u,i);
  1053. end;
  1054. procedure Trgobj.writegraph;
  1055. var f:text;
  1056. i,j:Tsuperregister;
  1057. begin
  1058. assign(f,'igraph');
  1059. rewrite(f);
  1060. writeln(f,'Interference graph');
  1061. writeln(f);
  1062. write(f,' ');
  1063. for i:=0 to 15 do
  1064. for j:=0 to 15 do
  1065. write(f,hexstr(i,1));
  1066. writeln(f);
  1067. write(f,' ');
  1068. for i:=0 to 15 do
  1069. write(f,'0123456789ABCDEF');
  1070. writeln(f);
  1071. for i:=0 to 255 do
  1072. begin
  1073. write(f,hexstr(i,2):4);
  1074. for j:=0 to 255 do
  1075. if j in igraph.bitmap[i] then
  1076. write(f,'*')
  1077. else
  1078. write(f,'-');
  1079. writeln(f);
  1080. end;
  1081. close(f);
  1082. end;
  1083. {$endif}
  1084. {****************************************************************************
  1085. TReference
  1086. ****************************************************************************}
  1087. procedure reference_reset(var ref : treference);
  1088. begin
  1089. FillChar(ref,sizeof(treference),0);
  1090. ref.base.enum:=R_INTREGISTER;
  1091. ref.index.enum:=R_INTREGISTER;
  1092. {$ifdef i386}
  1093. ref.segment.enum:=R_INTREGISTER;
  1094. {$endif}
  1095. end;
  1096. procedure reference_reset_old(var ref : treference);
  1097. begin
  1098. FillChar(ref,sizeof(treference),0);
  1099. end;
  1100. procedure reference_reset_base(var ref : treference;base : tregister;offset : longint);
  1101. begin
  1102. reference_reset(ref);
  1103. ref.base:=base;
  1104. ref.offset:=offset;
  1105. end;
  1106. procedure reference_reset_symbol(var ref : treference;sym : tasmsymbol;offset : longint);
  1107. begin
  1108. reference_reset(ref);
  1109. ref.symbol:=sym;
  1110. ref.offset:=offset;
  1111. end;
  1112. procedure reference_release(list: taasmoutput; const ref : treference);
  1113. begin
  1114. rg.ungetreference(list,ref);
  1115. end;
  1116. function references_equal(sref : treference;dref : treference):boolean;
  1117. begin
  1118. references_equal:=CompareByte(sref,dref,sizeof(treference))=0;
  1119. end;
  1120. { on most processors , this routine does nothing, overriden currently }
  1121. { only by 80x86 processor. }
  1122. function trgobj.makeregsize(reg: tregister; size: tcgsize): tregister;
  1123. begin
  1124. makeregsize := reg;
  1125. end;
  1126. {****************************************************************************
  1127. TLocation
  1128. ****************************************************************************}
  1129. procedure location_reset(var l : tlocation;lt:TLoc;lsize:TCGSize);
  1130. begin
  1131. FillChar(l,sizeof(tlocation),0);
  1132. l.loc:=lt;
  1133. l.size:=lsize;
  1134. case l.loc of
  1135. LOC_REGISTER,LOC_CREGISTER:
  1136. begin
  1137. l.register.enum:=R_INTREGISTER;
  1138. l.registerhigh.enum:=R_INTREGISTER;
  1139. end;
  1140. LOC_REFERENCE,LOC_CREFERENCE:
  1141. begin
  1142. l.reference.base.enum:=R_INTREGISTER;
  1143. l.reference.index.enum:=R_INTREGISTER;
  1144. {$ifdef i386}
  1145. l.reference.segment.enum:=R_INTREGISTER;
  1146. {$endif}
  1147. end;
  1148. end;
  1149. end;
  1150. procedure location_release(list: taasmoutput; const l : tlocation);
  1151. begin
  1152. case l.loc of
  1153. LOC_REGISTER,LOC_CREGISTER :
  1154. begin
  1155. rg.ungetregisterint(list,l.register);
  1156. if l.size in [OS_64,OS_S64] then
  1157. rg.ungetregisterint(list,l.registerhigh);
  1158. end;
  1159. LOC_CREFERENCE,LOC_REFERENCE :
  1160. rg.ungetreference(list, l.reference);
  1161. end;
  1162. end;
  1163. procedure location_freetemp(list:taasmoutput; const l : tlocation);
  1164. begin
  1165. if (l.loc in [LOC_REFERENCE,LOC_CREFERENCE]) then
  1166. tg.ungetiftemp(list,l.reference);
  1167. end;
  1168. procedure location_copy(var destloc,sourceloc : tlocation);
  1169. begin
  1170. destloc:=sourceloc;
  1171. end;
  1172. procedure location_swap(var destloc,sourceloc : tlocation);
  1173. var
  1174. swapl : tlocation;
  1175. begin
  1176. swapl := destloc;
  1177. destloc := sourceloc;
  1178. sourceloc := swapl;
  1179. end;
  1180. initialization
  1181. ;
  1182. finalization
  1183. rg.free;
  1184. end.
  1185. {
  1186. $Log$
  1187. Revision 1.35 2003-04-21 19:16:49 peter
  1188. * count address regs separate
  1189. Revision 1.34 2003/04/17 16:48:21 daniel
  1190. * Added some code to keep track of move instructions in register
  1191. allocator
  1192. Revision 1.33 2003/04/17 07:50:24 daniel
  1193. * Some work on interference graph construction
  1194. Revision 1.32 2003/03/28 19:16:57 peter
  1195. * generic constructor working for i386
  1196. * remove fixed self register
  1197. * esi added as address register for i386
  1198. Revision 1.31 2003/03/11 21:46:24 jonas
  1199. * lots of new regallocator fixes, both in generic and ppc-specific code
  1200. (ppc compiler still can't compile the linux system unit though)
  1201. Revision 1.30 2003/03/09 21:18:59 olle
  1202. + added cutils to the uses clause
  1203. Revision 1.29 2003/03/08 20:36:41 daniel
  1204. + Added newra version of Ti386shlshrnode
  1205. + Added interference graph construction code
  1206. Revision 1.28 2003/03/08 13:59:16 daniel
  1207. * Work to handle new register notation in ag386nsm
  1208. + Added newra version of Ti386moddivnode
  1209. Revision 1.27 2003/03/08 10:53:48 daniel
  1210. * Created newra version of secondmul in n386add.pas
  1211. Revision 1.26 2003/03/08 08:59:07 daniel
  1212. + $define newra will enable new register allocator
  1213. + getregisterint will return imaginary registers with $newra
  1214. + -sr switch added, will skip register allocation so you can see
  1215. the direct output of the code generator before register allocation
  1216. Revision 1.25 2003/02/26 20:50:45 daniel
  1217. * Fixed ungetreference
  1218. Revision 1.24 2003/02/19 22:39:56 daniel
  1219. * Fixed a few issues
  1220. Revision 1.23 2003/02/19 22:00:14 daniel
  1221. * Code generator converted to new register notation
  1222. - Horribily outdated todo.txt removed
  1223. Revision 1.22 2003/02/02 19:25:54 carl
  1224. * Several bugfixes for m68k target (register alloc., opcode emission)
  1225. + VIS target
  1226. + Generic add more complete (still not verified)
  1227. Revision 1.21 2003/01/08 18:43:57 daniel
  1228. * Tregister changed into a record
  1229. Revision 1.20 2002/10/05 12:43:28 carl
  1230. * fixes for Delphi 6 compilation
  1231. (warning : Some features do not work under Delphi)
  1232. Revision 1.19 2002/08/23 16:14:49 peter
  1233. * tempgen cleanup
  1234. * tt_noreuse temp type added that will be used in genentrycode
  1235. Revision 1.18 2002/08/17 22:09:47 florian
  1236. * result type handling in tcgcal.pass_2 overhauled
  1237. * better tnode.dowrite
  1238. * some ppc stuff fixed
  1239. Revision 1.17 2002/08/17 09:23:42 florian
  1240. * first part of procinfo rewrite
  1241. Revision 1.16 2002/08/06 20:55:23 florian
  1242. * first part of ppc calling conventions fix
  1243. Revision 1.15 2002/08/05 18:27:48 carl
  1244. + more more more documentation
  1245. + first version include/exclude (can't test though, not enough scratch for i386 :()...
  1246. Revision 1.14 2002/08/04 19:06:41 carl
  1247. + added generic exception support (still does not work!)
  1248. + more documentation
  1249. Revision 1.13 2002/07/07 09:52:32 florian
  1250. * powerpc target fixed, very simple units can be compiled
  1251. * some basic stuff for better callparanode handling, far from being finished
  1252. Revision 1.12 2002/07/01 18:46:26 peter
  1253. * internal linker
  1254. * reorganized aasm layer
  1255. Revision 1.11 2002/05/18 13:34:17 peter
  1256. * readded missing revisions
  1257. Revision 1.10 2002/05/16 19:46:44 carl
  1258. + defines.inc -> fpcdefs.inc to avoid conflicts if compiling by hand
  1259. + try to fix temp allocation (still in ifdef)
  1260. + generic constructor calls
  1261. + start of tassembler / tmodulebase class cleanup
  1262. Revision 1.8 2002/04/21 15:23:03 carl
  1263. + makeregsize
  1264. + changeregsize is now a local routine
  1265. Revision 1.7 2002/04/20 21:32:25 carl
  1266. + generic FPC_CHECKPOINTER
  1267. + first parameter offset in stack now portable
  1268. * rename some constants
  1269. + move some cpu stuff to other units
  1270. - remove unused constents
  1271. * fix stacksize for some targets
  1272. * fix generic size problems which depend now on EXTEND_SIZE constant
  1273. Revision 1.6 2002/04/15 19:03:31 carl
  1274. + reg2str -> std_reg2str()
  1275. Revision 1.5 2002/04/06 18:13:01 jonas
  1276. * several powerpc-related additions and fixes
  1277. Revision 1.4 2002/04/04 19:06:04 peter
  1278. * removed unused units
  1279. * use tlocation.size in cg.a_*loc*() routines
  1280. Revision 1.3 2002/04/02 17:11:29 peter
  1281. * tlocation,treference update
  1282. * LOC_CONSTANT added for better constant handling
  1283. * secondadd splitted in multiple routines
  1284. * location_force_reg added for loading a location to a register
  1285. of a specified size
  1286. * secondassignment parses now first the right and then the left node
  1287. (this is compatible with Kylix). This saves a lot of push/pop especially
  1288. with string operations
  1289. * adapted some routines to use the new cg methods
  1290. Revision 1.2 2002/04/01 19:24:25 jonas
  1291. * fixed different parameter name in interface and implementation
  1292. declaration of a method (only 1.0.x detected this)
  1293. Revision 1.1 2002/03/31 20:26:36 jonas
  1294. + a_loadfpu_* and a_loadmm_* methods in tcg
  1295. * register allocation is now handled by a class and is mostly processor
  1296. independent (+rgobj.pas and i386/rgcpu.pas)
  1297. * temp allocation is now handled by a class (+tgobj.pas, -i386\tgcpu.pas)
  1298. * some small improvements and fixes to the optimizer
  1299. * some register allocation fixes
  1300. * some fpuvaroffset fixes in the unary minus node
  1301. * push/popusedregisters is now called rg.save/restoreusedregisters and
  1302. (for i386) uses temps instead of push/pop's when using -Op3 (that code is
  1303. also better optimizable)
  1304. * fixed and optimized register saving/restoring for new/dispose nodes
  1305. * LOC_FPU locations now also require their "register" field to be set to
  1306. R_ST, not R_ST0 (the latter is used for LOC_CFPUREGISTER locations only)
  1307. - list field removed of the tnode class because it's not used currently
  1308. and can cause hard-to-find bugs
  1309. }