rgobj.pas 52 KB

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