rgobj.pas 64 KB

1234567891011121314151617181920212223242526272829303132333435363738394041424344454647484950515253545556575859606162636465666768697071727374757677787980818283848586878889909192939495969798991001011021031041051061071081091101111121131141151161171181191201211221231241251261271281291301311321331341351361371381391401411421431441451461471481491501511521531541551561571581591601611621631641651661671681691701711721731741751761771781791801811821831841851861871881891901911921931941951961971981992002012022032042052062072082092102112122132142152162172182192202212222232242252262272282292302312322332342352362372382392402412422432442452462472482492502512522532542552562572582592602612622632642652662672682692702712722732742752762772782792802812822832842852862872882892902912922932942952962972982993003013023033043053063073083093103113123133143153163173183193203213223233243253263273283293303313323333343353363373383393403413423433443453463473483493503513523533543553563573583593603613623633643653663673683693703713723733743753763773783793803813823833843853863873883893903913923933943953963973983994004014024034044054064074084094104114124134144154164174184194204214224234244254264274284294304314324334344354364374384394404414424434444454464474484494504514524534544554564574584594604614624634644654664674684694704714724734744754764774784794804814824834844854864874884894904914924934944954964974984995005015025035045055065075085095105115125135145155165175185195205215225235245255265275285295305315325335345355365375385395405415425435445455465475485495505515525535545555565575585595605615625635645655665675685695705715725735745755765775785795805815825835845855865875885895905915925935945955965975985996006016026036046056066076086096106116126136146156166176186196206216226236246256266276286296306316326336346356366376386396406416426436446456466476486496506516526536546556566576586596606616626636646656666676686696706716726736746756766776786796806816826836846856866876886896906916926936946956966976986997007017027037047057067077087097107117127137147157167177187197207217227237247257267277287297307317327337347357367377387397407417427437447457467477487497507517527537547557567577587597607617627637647657667677687697707717727737747757767777787797807817827837847857867877887897907917927937947957967977987998008018028038048058068078088098108118128138148158168178188198208218228238248258268278288298308318328338348358368378388398408418428438448458468478488498508518528538548558568578588598608618628638648658668678688698708718728738748758768778788798808818828838848858868878888898908918928938948958968978988999009019029039049059069079089099109119129139149159169179189199209219229239249259269279289299309319329339349359369379389399409419429439449459469479489499509519529539549559569579589599609619629639649659669679689699709719729739749759769779789799809819829839849859869879889899909919929939949959969979989991000100110021003100410051006100710081009101010111012101310141015101610171018101910201021102210231024102510261027102810291030103110321033103410351036103710381039104010411042104310441045104610471048104910501051105210531054105510561057105810591060106110621063106410651066106710681069107010711072107310741075107610771078107910801081108210831084108510861087108810891090109110921093109410951096109710981099110011011102110311041105110611071108110911101111111211131114111511161117111811191120112111221123112411251126112711281129113011311132113311341135113611371138113911401141114211431144114511461147114811491150115111521153115411551156115711581159116011611162116311641165116611671168116911701171117211731174117511761177117811791180118111821183118411851186118711881189119011911192119311941195119611971198119912001201120212031204120512061207120812091210121112121213121412151216121712181219122012211222122312241225122612271228122912301231123212331234123512361237123812391240124112421243124412451246124712481249125012511252125312541255125612571258125912601261126212631264126512661267126812691270127112721273127412751276127712781279128012811282128312841285128612871288128912901291129212931294129512961297129812991300130113021303130413051306130713081309131013111312131313141315131613171318131913201321132213231324132513261327132813291330133113321333133413351336133713381339134013411342134313441345134613471348134913501351135213531354135513561357135813591360136113621363136413651366136713681369137013711372137313741375137613771378137913801381138213831384138513861387138813891390139113921393139413951396139713981399140014011402140314041405140614071408140914101411141214131414141514161417141814191420142114221423142414251426142714281429143014311432143314341435143614371438143914401441144214431444144514461447144814491450145114521453145414551456145714581459146014611462146314641465146614671468146914701471147214731474147514761477147814791480148114821483148414851486148714881489149014911492149314941495149614971498149915001501150215031504150515061507150815091510151115121513151415151516151715181519152015211522152315241525152615271528152915301531153215331534153515361537153815391540154115421543154415451546154715481549155015511552155315541555155615571558155915601561156215631564156515661567156815691570157115721573157415751576157715781579158015811582158315841585158615871588158915901591159215931594159515961597159815991600160116021603160416051606160716081609161016111612161316141615161616171618161916201621162216231624162516261627162816291630163116321633163416351636163716381639164016411642164316441645164616471648164916501651165216531654165516561657165816591660166116621663166416651666166716681669167016711672167316741675167616771678167916801681168216831684168516861687168816891690169116921693169416951696169716981699170017011702170317041705170617071708170917101711171217131714171517161717171817191720172117221723172417251726172717281729173017311732173317341735173617371738173917401741174217431744174517461747174817491750175117521753175417551756175717581759176017611762176317641765176617671768176917701771177217731774177517761777177817791780178117821783178417851786178717881789179017911792179317941795179617971798179918001801180218031804180518061807180818091810181118121813181418151816181718181819182018211822182318241825182618271828182918301831183218331834183518361837183818391840184118421843184418451846184718481849185018511852185318541855185618571858185918601861186218631864186518661867186818691870187118721873187418751876187718781879188018811882188318841885188618871888188918901891189218931894189518961897189818991900190119021903190419051906190719081909191019111912191319141915191619171918191919201921192219231924192519261927192819291930193119321933193419351936193719381939194019411942194319441945194619471948194919501951195219531954195519561957195819591960196119621963196419651966196719681969197019711972197319741975197619771978197919801981198219831984198519861987198819891990199119921993199419951996199719981999200020012002200320042005200620072008200920102011201220132014201520162017201820192020202120222023
  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. { Allow duplicate allocations, can be used to get the .s file written }
  20. { $define ALLOWDUPREG}
  21. unit rgobj;
  22. interface
  23. uses
  24. cutils, cpubase,
  25. aasmbase,aasmtai,aasmcpu,
  26. cclasses,globtype,cgbase,node,
  27. {$ifdef delphi}
  28. dmisc,
  29. {$endif}
  30. cpuinfo
  31. ;
  32. type
  33. {
  34. regvarother_longintarray = array[tregisterindex] of longint;
  35. regvarother_booleanarray = array[tregisterindex] of boolean;
  36. regvarint_longintarray = array[first_int_supreg..last_int_supreg] of longint;
  37. regvarint_ptreearray = array[first_int_supreg..last_int_supreg] of tnode;
  38. }
  39. {
  40. The interference bitmap contains of 2 layers:
  41. layer 1 - 256*256 blocks with pointers to layer 2 blocks
  42. layer 2 - blocks of 32*256 (32 bytes = 256 bits)
  43. }
  44. Tinterferencebitmap2 = array[byte] of set of byte;
  45. Pinterferencebitmap2 = ^Tinterferencebitmap2;
  46. Tinterferencebitmap1 = array[byte] of Pinterferencebitmap2;
  47. pinterferencebitmap1 = ^tinterferencebitmap1;
  48. Tinterferencebitmap=class
  49. private
  50. maxx1,
  51. maxy1 : byte;
  52. fbitmap : pinterferencebitmap1;
  53. function getbitmap(x,y:tsuperregister):boolean;
  54. procedure setbitmap(x,y:tsuperregister;b:boolean);
  55. public
  56. constructor create;
  57. destructor destroy;override;
  58. property bitmap[x,y:tsuperregister]:boolean read getbitmap write setbitmap;default;
  59. end;
  60. Tmovelistheader=record
  61. count,
  62. maxcount,
  63. sorted_until : cardinal;
  64. end;
  65. Tmovelist=record
  66. header : Tmovelistheader;
  67. data : array[tsuperregister] of Tlinkedlistitem;
  68. end;
  69. Pmovelist=^Tmovelist;
  70. {In the register allocator we keep track of move instructions.
  71. These instructions are moved between five linked lists. There
  72. is also a linked list per register to keep track about the moves
  73. it is associated with. Because we need to determine quickly in
  74. which of the five lists it is we add anu enumeradtion to each
  75. move instruction.}
  76. Tmoveset=(ms_coalesced_moves,ms_constrained_moves,ms_frozen_moves,
  77. ms_worklist_moves,ms_active_moves);
  78. Tmoveins=class(Tlinkedlistitem)
  79. moveset:Tmoveset;
  80. x,y:Tsuperregister;
  81. end;
  82. Treginfoflag=(ri_coalesced,ri_selected);
  83. Treginfoflagset=set of Treginfoflag;
  84. Treginfo=record
  85. live_start,
  86. live_end : Tai;
  87. subreg : tsubregister;
  88. alias : Tsuperregister;
  89. { The register allocator assigns each register a colour }
  90. colour : Tsuperregister;
  91. movelist : Pmovelist;
  92. adjlist : Psuperregisterworklist;
  93. degree : TSuperregister;
  94. flags : Treginfoflagset;
  95. end;
  96. Preginfo=^TReginfo;
  97. tspillreginfo = record
  98. spillreg : tregister;
  99. orgreg : tsuperregister;
  100. tempreg : tregister;
  101. regread,regwritten, mustbespilled: boolean;
  102. end;
  103. tspillregsinfo = array[0..2] of tspillreginfo;
  104. {#------------------------------------------------------------------
  105. This class implements the default register allocator. It is used by the
  106. code generator to allocate and free registers which might be valid
  107. across nodes. It also contains utility routines related to registers.
  108. Some of the methods in this class should be overriden
  109. by cpu-specific implementations.
  110. --------------------------------------------------------------------}
  111. trgobj=class
  112. preserved_by_proc : tcpuregisterset;
  113. used_in_proc : tcpuregisterset;
  114. // is_reg_var : Tsuperregisterset; {old regvars}
  115. // reg_var_loaded:Tsuperregisterset; {old regvars}
  116. constructor create(Aregtype:Tregistertype;
  117. Adefaultsub:Tsubregister;
  118. const Ausable:array of tsuperregister;
  119. Afirst_imaginary:Tsuperregister;
  120. Apreserved_by_proc:Tcpuregisterset);
  121. destructor destroy;override;
  122. {# Allocate a register. An internalerror will be generated if there is
  123. no more free registers which can be allocated.}
  124. function getregister(list:Taasmoutput;subreg:Tsubregister):Tregister;virtual;
  125. {# Get the register specified.}
  126. procedure getexplicitregister(list:Taasmoutput;r:Tregister);virtual;
  127. {# Get multiple registers specified.}
  128. procedure allocexplicitregisters(list:Taasmoutput;r:Tcpuregisterset);virtual;
  129. {# Free multiple registers specified.}
  130. procedure deallocexplicitregisters(list:Taasmoutput;r:Tcpuregisterset);virtual;
  131. function uses_registers:boolean;virtual;
  132. {# Deallocate any kind of register }
  133. procedure ungetregister(list:Taasmoutput;r:Tregister);virtual;
  134. procedure add_reg_instruction(instr:Tai;r:tregister);
  135. procedure add_move_instruction(instr:Taicpu);
  136. {# Do the register allocation.}
  137. procedure do_register_allocation(list:Taasmoutput;headertai:tai);virtual;
  138. { Adds an interference edge.
  139. don't move this to the protected section, the arm cg requires to access this (FK) }
  140. procedure add_edge(u,v:Tsuperregister);
  141. protected
  142. regtype : Tregistertype;
  143. { default subregister used }
  144. defaultsub : tsubregister;
  145. live_registers:Tsuperregisterworklist;
  146. { can be overriden to add cpu specific interferences }
  147. procedure add_cpu_interferences(p : tai);virtual;
  148. function get_insert_pos(p:Tai;huntfor1,huntfor2,huntfor3:Tsuperregister):Tai;
  149. procedure forward_allocation(pfrom,pto:Tai);
  150. procedure getregisterinline(list:Taasmoutput;position:Tai;subreg:Tsubregister;var result:Tregister);
  151. procedure ungetregisterinline(list:Taasmoutput;position:Tai;r:Tregister);
  152. procedure add_constraints(reg:Tregister);virtual;
  153. function get_spill_subreg(r : tregister) : tsubregister;virtual;
  154. procedure do_spill_read(list:Taasmoutput;instr:Taicpu;
  155. pos:Tai;regidx:word;
  156. const spilltemplist:Tspill_temp_list;
  157. const regs:Tspillregsinfo);virtual;
  158. procedure do_spill_written(list:Taasmoutput;instr:Taicpu;
  159. pos:Tai;regidx:word;
  160. const spilltemplist:Tspill_temp_list;
  161. const regs:Tspillregsinfo);virtual;
  162. procedure do_spill_readwritten(list:Taasmoutput;instr:Taicpu;
  163. pos:Tai;regidx:word;
  164. const spilltemplist:Tspill_temp_list;
  165. const regs:Tspillregsinfo);virtual;
  166. function instr_spill_register(list:Taasmoutput;
  167. instr:taicpu;
  168. const r:Tsuperregisterset;
  169. const spilltemplist:Tspill_temp_list): boolean;virtual;
  170. private
  171. {# First imaginary register.}
  172. first_imaginary : Tsuperregister;
  173. {# Highest register allocated until now.}
  174. reginfo : PReginfo;
  175. maxreginfo,
  176. maxreginfoinc,
  177. maxreg : Tsuperregister;
  178. usable_registers_cnt : word;
  179. usable_registers : array[0..maxcpuregister-1] of tsuperregister;
  180. ibitmap : Tinterferencebitmap;
  181. spillednodes,
  182. simplifyworklist,
  183. freezeworklist,
  184. spillworklist,
  185. coalescednodes,
  186. selectstack : tsuperregisterworklist;
  187. worklist_moves,
  188. active_moves,
  189. frozen_moves,
  190. coalesced_moves,
  191. constrained_moves : Tlinkedlist;
  192. {$ifdef EXTDEBUG}
  193. procedure writegraph(loopidx:longint);
  194. {$endif EXTDEBUG}
  195. {# Disposes of the reginfo array.}
  196. procedure dispose_reginfo;
  197. {# Prepare the register colouring.}
  198. procedure prepare_colouring;
  199. {# Clean up after register colouring.}
  200. procedure epilogue_colouring;
  201. {# Colour the registers; that is do the register allocation.}
  202. procedure colour_registers;
  203. {# Spills certain registers in the specified assembler list.}
  204. procedure insert_regalloc_info(list:Taasmoutput;headertai:tai);
  205. procedure generate_interference_graph(list:Taasmoutput;headertai:tai);
  206. procedure translate_registers(list:Taasmoutput);
  207. function spill_registers(list:Taasmoutput;headertai:tai):boolean;virtual;
  208. function getnewreg(subreg:tsubregister):tsuperregister;
  209. procedure add_edges_used(u:Tsuperregister);
  210. procedure add_to_movelist(u:Tsuperregister;data:Tlinkedlistitem);
  211. function move_related(n:Tsuperregister):boolean;
  212. procedure make_work_list;
  213. procedure sort_simplify_worklist;
  214. procedure enable_moves(n:Tsuperregister);
  215. procedure decrement_degree(m:Tsuperregister);
  216. procedure simplify;
  217. function get_alias(n:Tsuperregister):Tsuperregister;
  218. procedure add_worklist(u:Tsuperregister);
  219. function adjacent_ok(u,v:Tsuperregister):boolean;
  220. function conservative(u,v:Tsuperregister):boolean;
  221. procedure combine(u,v:Tsuperregister);
  222. procedure coalesce;
  223. procedure freeze_moves(u:Tsuperregister);
  224. procedure freeze;
  225. procedure select_spill;
  226. procedure assign_colours;
  227. procedure clear_interferences(u:Tsuperregister);
  228. end;
  229. const
  230. first_reg = 0;
  231. last_reg = high(tsuperregister)-1;
  232. maxspillingcounter = 20;
  233. implementation
  234. uses
  235. systems,
  236. globals,verbose,tgobj,procinfo;
  237. procedure sort_movelist(ml:Pmovelist);
  238. {Ok, sorting pointers is silly, but it does the job to make Trgobj.combine
  239. faster.}
  240. var h,i,p:word;
  241. t:Tlinkedlistitem;
  242. begin
  243. with ml^ do
  244. begin
  245. if header.count<2 then
  246. exit;
  247. p:=1;
  248. while 2*p<header.count do
  249. p:=2*p;
  250. while p<>0 do
  251. begin
  252. for h:=p to header.count-1 do
  253. begin
  254. i:=h;
  255. t:=data[i];
  256. repeat
  257. if ptrint(data[i-p])<=ptrint(t) then
  258. break;
  259. data[i]:=data[i-p];
  260. dec(i,p);
  261. until i<p;
  262. data[i]:=t;
  263. end;
  264. p:=p shr 1;
  265. end;
  266. header.sorted_until:=header.count-1;
  267. end;
  268. end;
  269. {******************************************************************************
  270. tinterferencebitmap
  271. ******************************************************************************}
  272. constructor tinterferencebitmap.create;
  273. begin
  274. inherited create;
  275. maxx1:=1;
  276. getmem(fbitmap,sizeof(tinterferencebitmap1)*2);
  277. fillchar(fbitmap^,sizeof(tinterferencebitmap1)*2,0);
  278. end;
  279. destructor tinterferencebitmap.destroy;
  280. var i,j:byte;
  281. begin
  282. for i:=0 to maxx1 do
  283. for j:=0 to maxy1 do
  284. if assigned(fbitmap[i,j]) then
  285. dispose(fbitmap[i,j]);
  286. freemem(fbitmap);
  287. end;
  288. function tinterferencebitmap.getbitmap(x,y:tsuperregister):boolean;
  289. var
  290. page : pinterferencebitmap2;
  291. begin
  292. result:=false;
  293. if (x shr 8>maxx1) then
  294. exit;
  295. page:=fbitmap[x shr 8,y shr 8];
  296. result:=assigned(page) and
  297. ((x and $ff) in page^[y and $ff]);
  298. end;
  299. procedure tinterferencebitmap.setbitmap(x,y:tsuperregister;b:boolean);
  300. var
  301. x1,y1 : byte;
  302. begin
  303. x1:=x shr 8;
  304. y1:=y shr 8;
  305. if x1>maxx1 then
  306. begin
  307. reallocmem(fbitmap,sizeof(tinterferencebitmap1)*(x1+1));
  308. fillchar(fbitmap[maxx1+1],sizeof(tinterferencebitmap1)*(x1-maxx1),0);
  309. maxx1:=x1;
  310. end;
  311. if not assigned(fbitmap[x1,y1]) then
  312. begin
  313. if y1>maxy1 then
  314. maxy1:=y1;
  315. new(fbitmap[x1,y1]);
  316. fillchar(fbitmap[x1,y1]^,sizeof(tinterferencebitmap2),0);
  317. end;
  318. if b then
  319. include(fbitmap[x1,y1]^[y and $ff],(x and $ff))
  320. else
  321. exclude(fbitmap[x1,y1]^[y and $ff],(x and $ff));
  322. end;
  323. {******************************************************************************
  324. trgobj
  325. ******************************************************************************}
  326. constructor trgobj.create(Aregtype:Tregistertype;
  327. Adefaultsub:Tsubregister;
  328. const Ausable:array of tsuperregister;
  329. Afirst_imaginary:Tsuperregister;
  330. Apreserved_by_proc:Tcpuregisterset);
  331. var
  332. i : Tsuperregister;
  333. begin
  334. { empty super register sets can cause very strange problems }
  335. if high(Ausable)=0 then
  336. internalerror(200210181);
  337. first_imaginary:=Afirst_imaginary;
  338. maxreg:=Afirst_imaginary;
  339. regtype:=Aregtype;
  340. defaultsub:=Adefaultsub;
  341. preserved_by_proc:=Apreserved_by_proc;
  342. used_in_proc:=[];
  343. live_registers.init;
  344. { Get reginfo for CPU registers }
  345. maxreginfo:=first_imaginary;
  346. maxreginfoinc:=16;
  347. worklist_moves:=Tlinkedlist.create;
  348. reginfo:=allocmem(first_imaginary*sizeof(treginfo));
  349. for i:=0 to first_imaginary-1 do
  350. begin
  351. reginfo[i].degree:=high(tsuperregister);
  352. reginfo[i].alias:=RS_INVALID;
  353. end;
  354. { Usable registers }
  355. fillchar(usable_registers,sizeof(usable_registers),0);
  356. for i:=low(Ausable) to high(Ausable) do
  357. usable_registers[i]:=Ausable[i];
  358. usable_registers_cnt:=high(Ausable)+1;
  359. { Initialize Worklists }
  360. spillednodes.init;
  361. simplifyworklist.init;
  362. freezeworklist.init;
  363. spillworklist.init;
  364. coalescednodes.init;
  365. selectstack.init;
  366. end;
  367. destructor trgobj.destroy;
  368. begin
  369. spillednodes.done;
  370. simplifyworklist.done;
  371. freezeworklist.done;
  372. spillworklist.done;
  373. coalescednodes.done;
  374. selectstack.done;
  375. live_registers.done;
  376. worklist_moves.free;
  377. dispose_reginfo;
  378. end;
  379. procedure Trgobj.dispose_reginfo;
  380. var i:Tsuperregister;
  381. begin
  382. if reginfo<>nil then
  383. begin
  384. for i:=0 to maxreg-1 do
  385. with reginfo[i] do
  386. begin
  387. if adjlist<>nil then
  388. dispose(adjlist,done);
  389. if movelist<>nil then
  390. dispose(movelist);
  391. end;
  392. freemem(reginfo);
  393. reginfo:=nil;
  394. end;
  395. end;
  396. function trgobj.getnewreg(subreg:tsubregister):tsuperregister;
  397. var
  398. oldmaxreginfo : tsuperregister;
  399. begin
  400. result:=maxreg;
  401. inc(maxreg);
  402. if maxreg>=last_reg then
  403. internalerror(200310146);
  404. if maxreg>=maxreginfo then
  405. begin
  406. oldmaxreginfo:=maxreginfo;
  407. inc(maxreginfo,maxreginfoinc);
  408. if maxreginfoinc<256 then
  409. maxreginfoinc:=maxreginfoinc*2;
  410. reallocmem(reginfo,maxreginfo*sizeof(treginfo));
  411. { Do we really need it to clear it ? At least for 1.0.x (PFV) }
  412. fillchar(reginfo[oldmaxreginfo],(maxreginfo-oldmaxreginfo)*sizeof(treginfo),0);
  413. end;
  414. reginfo[result].subreg:=subreg;
  415. end;
  416. function trgobj.getregister(list:Taasmoutput;subreg:Tsubregister):Tregister;
  417. begin
  418. {$ifdef EXTDEBUG}
  419. if reginfo=nil then
  420. InternalError(2004020901);
  421. {$endif EXTDEBUG}
  422. if defaultsub=R_SUBNONE then
  423. result:=newreg(regtype,getnewreg(R_SUBNONE),R_SUBNONE)
  424. else
  425. result:=newreg(regtype,getnewreg(subreg),subreg);
  426. end;
  427. function trgobj.uses_registers:boolean;
  428. begin
  429. result:=(maxreg>first_imaginary);
  430. end;
  431. procedure trgobj.ungetregister(list:Taasmoutput;r:Tregister);
  432. begin
  433. {$ifdef EXTDEBUG}
  434. if (reginfo=nil) and (getsupreg(r)>=first_imaginary) then
  435. InternalError(2004020901);
  436. {$endif EXTDEBUG}
  437. { Only explicit allocs insert regalloc info }
  438. if getsupreg(r)<first_imaginary then
  439. list.concat(Tai_regalloc.dealloc(r));
  440. end;
  441. procedure trgobj.getexplicitregister(list:Taasmoutput;r:Tregister);
  442. var
  443. supreg:Tsuperregister;
  444. begin
  445. supreg:=getsupreg(r);
  446. if supreg>=first_imaginary then
  447. internalerror(2003121503);
  448. include(used_in_proc,supreg);
  449. list.concat(Tai_regalloc.alloc(r));
  450. end;
  451. procedure trgobj.allocexplicitregisters(list:Taasmoutput;r:Tcpuregisterset);
  452. var i:Tsuperregister;
  453. begin
  454. for i:=0 to first_imaginary-1 do
  455. if i in r then
  456. getexplicitregister(list,newreg(regtype,i,defaultsub));
  457. end;
  458. procedure trgobj.deallocexplicitregisters(list:Taasmoutput;r:Tcpuregisterset);
  459. var i:Tsuperregister;
  460. begin
  461. for i:=0 to first_imaginary-1 do
  462. if i in r then
  463. ungetregister(list,newreg(regtype,i,defaultsub));
  464. end;
  465. procedure trgobj.do_register_allocation(list:Taasmoutput;headertai:tai);
  466. var
  467. spillingcounter:byte;
  468. endspill:boolean;
  469. i:Tsuperregister;
  470. begin
  471. { Insert regalloc info for imaginary registers }
  472. insert_regalloc_info(list,headertai);
  473. ibitmap:=tinterferencebitmap.create;
  474. generate_interference_graph(list,headertai);
  475. { Don't do the real allocation when -sr is passed }
  476. if (cs_no_regalloc in aktglobalswitches) then
  477. exit;
  478. {Do register allocation.}
  479. spillingcounter:=0;
  480. repeat
  481. prepare_colouring;
  482. colour_registers;
  483. epilogue_colouring;
  484. endspill:=true;
  485. if spillednodes.length<>0 then
  486. begin
  487. inc(spillingcounter);
  488. if spillingcounter>maxspillingcounter then
  489. internalerror(200309041);
  490. endspill:=not spill_registers(list,headertai);
  491. end;
  492. until endspill;
  493. ibitmap.free;
  494. translate_registers(list);
  495. dispose_reginfo;
  496. end;
  497. procedure trgobj.add_constraints(reg:Tregister);
  498. begin
  499. end;
  500. procedure trgobj.add_edge(u,v:Tsuperregister);
  501. {This procedure will add an edge to the virtual interference graph.}
  502. procedure addadj(u,v:Tsuperregister);
  503. begin
  504. with reginfo[u] do
  505. begin
  506. if adjlist=nil then
  507. new(adjlist,init);
  508. adjlist^.add(v);
  509. end;
  510. end;
  511. begin
  512. if (u<>v) and not(ibitmap[v,u]) then
  513. begin
  514. ibitmap[v,u]:=true;
  515. ibitmap[u,v]:=true;
  516. {Precoloured nodes are not stored in the interference graph.}
  517. if (u>=first_imaginary) then
  518. addadj(u,v);
  519. if (v>=first_imaginary) then
  520. addadj(v,u);
  521. end;
  522. end;
  523. procedure trgobj.add_edges_used(u:Tsuperregister);
  524. var i:word;
  525. begin
  526. with live_registers do
  527. if length>0 then
  528. for i:=0 to length-1 do
  529. add_edge(u,buf^[i]);
  530. end;
  531. {$ifdef EXTDEBUG}
  532. procedure trgobj.writegraph(loopidx:longint);
  533. {This procedure writes out the current interference graph in the
  534. register allocator.}
  535. var f:text;
  536. i,j:Tsuperregister;
  537. begin
  538. assign(f,'igraph'+tostr(loopidx));
  539. rewrite(f);
  540. writeln(f,'Interference graph');
  541. writeln(f);
  542. write(f,' ');
  543. for i:=0 to 15 do
  544. for j:=0 to 15 do
  545. write(f,hexstr(i,1));
  546. writeln(f);
  547. write(f,' ');
  548. for i:=0 to 15 do
  549. write(f,'0123456789ABCDEF');
  550. writeln(f);
  551. for i:=0 to maxreg-1 do
  552. begin
  553. write(f,hexstr(i,2):4);
  554. for j:=0 to maxreg-1 do
  555. if ibitmap[i,j] then
  556. write(f,'*')
  557. else
  558. write(f,'-');
  559. writeln(f);
  560. end;
  561. close(f);
  562. end;
  563. {$endif EXTDEBUG}
  564. procedure trgobj.add_to_movelist(u:Tsuperregister;data:Tlinkedlistitem);
  565. begin
  566. with reginfo[u] do
  567. begin
  568. if movelist=nil then
  569. begin
  570. getmem(movelist,sizeof(tmovelistheader)+60*sizeof(pointer));
  571. movelist^.header.maxcount:=60;
  572. movelist^.header.count:=0;
  573. movelist^.header.sorted_until:=0;
  574. end
  575. else
  576. begin
  577. if movelist^.header.count>=movelist^.header.maxcount then
  578. begin
  579. movelist^.header.maxcount:=movelist^.header.maxcount*2;
  580. reallocmem(movelist,sizeof(tmovelistheader)+movelist^.header.maxcount*sizeof(pointer));
  581. end;
  582. end;
  583. movelist^.data[movelist^.header.count]:=data;
  584. inc(movelist^.header.count);
  585. end;
  586. end;
  587. procedure trgobj.add_reg_instruction(instr:Tai;r:tregister);
  588. var
  589. supreg : tsuperregister;
  590. begin
  591. supreg:=getsupreg(r);
  592. if supreg>=first_imaginary then
  593. with reginfo[supreg] do
  594. begin
  595. if not assigned(live_start) then
  596. live_start:=instr;
  597. live_end:=instr;
  598. end;
  599. end;
  600. procedure trgobj.add_move_instruction(instr:Taicpu);
  601. {This procedure notifies a certain as a move instruction so the
  602. register allocator can try to eliminate it.}
  603. var i:Tmoveins;
  604. ssupreg,dsupreg:Tsuperregister;
  605. begin
  606. {$ifdef extdebug}
  607. if (instr.oper[O_MOV_SOURCE]^.typ<>top_reg) or
  608. (instr.oper[O_MOV_DEST]^.typ<>top_reg) then
  609. internalerror(200311291);
  610. {$endif}
  611. i:=Tmoveins.create;
  612. i.moveset:=ms_worklist_moves;
  613. worklist_moves.insert(i);
  614. ssupreg:=getsupreg(instr.oper[O_MOV_SOURCE]^.reg);
  615. add_to_movelist(ssupreg,i);
  616. dsupreg:=getsupreg(instr.oper[O_MOV_DEST]^.reg);
  617. if ssupreg<>dsupreg then
  618. {Avoid adding the same move instruction twice to a single register.}
  619. add_to_movelist(dsupreg,i);
  620. i.x:=ssupreg;
  621. i.y:=dsupreg;
  622. end;
  623. function trgobj.move_related(n:Tsuperregister):boolean;
  624. var i:cardinal;
  625. begin
  626. move_related:=false;
  627. with reginfo[n] do
  628. if movelist<>nil then
  629. with movelist^ do
  630. for i:=0 to header.count-1 do
  631. if Tmoveins(data[i]).moveset in [ms_worklist_moves,ms_active_moves] then
  632. begin
  633. move_related:=true;
  634. break;
  635. end;
  636. end;
  637. procedure Trgobj.sort_simplify_worklist;
  638. {Sorts the simplifyworklist by the number of interferences the
  639. registers in it cause. This allows simplify to execute in
  640. constant time.}
  641. var p,h,i,leni,lent:word;
  642. t:Tsuperregister;
  643. adji,adjt:Psuperregisterworklist;
  644. begin
  645. with simplifyworklist do
  646. begin
  647. if length<2 then
  648. exit;
  649. p:=1;
  650. while 2*p<length do
  651. p:=2*p;
  652. while p<>0 do
  653. begin
  654. for h:=p to length-1 do
  655. begin
  656. i:=h;
  657. t:=buf^[i];
  658. adjt:=reginfo[buf^[i]].adjlist;
  659. lent:=0;
  660. if adjt<>nil then
  661. lent:=adjt^.length;
  662. repeat
  663. adji:=reginfo[buf^[i-p]].adjlist;
  664. leni:=0;
  665. if adji<>nil then
  666. leni:=adji^.length;
  667. if leni<=lent then
  668. break;
  669. buf^[i]:=buf^[i-p];
  670. dec(i,p)
  671. until i<p;
  672. buf^[i]:=t;
  673. end;
  674. p:=p shr 1;
  675. end;
  676. end;
  677. end;
  678. procedure trgobj.make_work_list;
  679. var n:Tsuperregister;
  680. begin
  681. {If we have 7 cpu registers, and the degree of a node is 7, we cannot
  682. assign it to any of the registers, thus it is significant.}
  683. for n:=first_imaginary to maxreg-1 do
  684. with reginfo[n] do
  685. begin
  686. if adjlist=nil then
  687. degree:=0
  688. else
  689. degree:=adjlist^.length;
  690. if degree>=usable_registers_cnt then
  691. spillworklist.add(n)
  692. else if move_related(n) then
  693. freezeworklist.add(n)
  694. else
  695. simplifyworklist.add(n);
  696. end;
  697. sort_simplify_worklist;
  698. end;
  699. procedure trgobj.prepare_colouring;
  700. var i:word;
  701. begin
  702. make_work_list;
  703. active_moves:=Tlinkedlist.create;
  704. frozen_moves:=Tlinkedlist.create;
  705. coalesced_moves:=Tlinkedlist.create;
  706. constrained_moves:=Tlinkedlist.create;
  707. selectstack.clear;
  708. end;
  709. procedure trgobj.enable_moves(n:Tsuperregister);
  710. var m:Tlinkedlistitem;
  711. i:cardinal;
  712. begin
  713. with reginfo[n] do
  714. if movelist<>nil then
  715. for i:=0 to movelist^.header.count-1 do
  716. begin
  717. m:=movelist^.data[i];
  718. if Tmoveins(m).moveset in [ms_worklist_moves,ms_active_moves] then
  719. if Tmoveins(m).moveset=ms_active_moves then
  720. begin
  721. {Move m from the set active_moves to the set worklist_moves.}
  722. active_moves.remove(m);
  723. Tmoveins(m).moveset:=ms_worklist_moves;
  724. worklist_moves.concat(m);
  725. end;
  726. end;
  727. end;
  728. procedure Trgobj.decrement_degree(m:Tsuperregister);
  729. var adj : Psuperregisterworklist;
  730. n : tsuperregister;
  731. d,i : word;
  732. begin
  733. with reginfo[m] do
  734. begin
  735. d:=degree;
  736. if d=0 then
  737. internalerror(200312151);
  738. dec(degree);
  739. if d=usable_registers_cnt then
  740. begin
  741. {Enable moves for m.}
  742. enable_moves(m);
  743. {Enable moves for adjacent.}
  744. adj:=adjlist;
  745. if adj<>nil then
  746. for i:=1 to adj^.length do
  747. begin
  748. n:=adj^.buf^[i-1];
  749. if reginfo[n].flags*[ri_selected,ri_coalesced]<>[] then
  750. enable_moves(n);
  751. end;
  752. {Remove the node from the spillworklist.}
  753. if not spillworklist.delete(m) then
  754. internalerror(200310145);
  755. if move_related(m) then
  756. freezeworklist.add(m)
  757. else
  758. simplifyworklist.add(m);
  759. end;
  760. end;
  761. end;
  762. procedure trgobj.simplify;
  763. var adj : Psuperregisterworklist;
  764. m,n : Tsuperregister;
  765. i : word;
  766. begin
  767. {We take the element with the least interferences out of the
  768. simplifyworklist. Since the simplifyworklist is now sorted, we
  769. no longer need to search, but we can simply take the first element.}
  770. m:=simplifyworklist.get;
  771. {Push it on the selectstack.}
  772. selectstack.add(m);
  773. with reginfo[m] do
  774. begin
  775. include(flags,ri_selected);
  776. adj:=adjlist;
  777. end;
  778. if adj<>nil then
  779. for i:=1 to adj^.length do
  780. begin
  781. n:=adj^.buf^[i-1];
  782. if (n>=first_imaginary) and
  783. (reginfo[n].flags*[ri_selected,ri_coalesced]=[]) then
  784. decrement_degree(n);
  785. end;
  786. end;
  787. function trgobj.get_alias(n:Tsuperregister):Tsuperregister;
  788. begin
  789. while ri_coalesced in reginfo[n].flags do
  790. n:=reginfo[n].alias;
  791. get_alias:=n;
  792. end;
  793. procedure trgobj.add_worklist(u:Tsuperregister);
  794. begin
  795. if (u>=first_imaginary) and
  796. (not move_related(u)) and
  797. (reginfo[u].degree<usable_registers_cnt) then
  798. begin
  799. if not freezeworklist.delete(u) then
  800. internalerror(200308161); {must be found}
  801. simplifyworklist.add(u);
  802. end;
  803. end;
  804. function trgobj.adjacent_ok(u,v:Tsuperregister):boolean;
  805. {Check wether u and v should be coalesced. u is precoloured.}
  806. function ok(t,r:Tsuperregister):boolean;
  807. begin
  808. ok:=(t<first_imaginary) or
  809. (reginfo[t].degree<usable_registers_cnt) or
  810. ibitmap[r,t];
  811. end;
  812. var adj : Psuperregisterworklist;
  813. i : word;
  814. n : tsuperregister;
  815. begin
  816. with reginfo[v] do
  817. begin
  818. adjacent_ok:=true;
  819. adj:=adjlist;
  820. if adj<>nil then
  821. for i:=1 to adj^.length do
  822. begin
  823. n:=adj^.buf^[i-1];
  824. if (flags*[ri_coalesced,ri_selected]=[]) and not ok(n,u) then
  825. begin
  826. adjacent_ok:=false;
  827. break;
  828. end;
  829. end;
  830. end;
  831. end;
  832. function trgobj.conservative(u,v:Tsuperregister):boolean;
  833. var adj : Psuperregisterworklist;
  834. done : Tsuperregisterset; {To prevent that we count nodes twice.}
  835. i,k:word;
  836. n : tsuperregister;
  837. begin
  838. k:=0;
  839. supregset_reset(done,false,maxreg);
  840. with reginfo[u] do
  841. begin
  842. adj:=adjlist;
  843. if adj<>nil then
  844. for i:=1 to adj^.length do
  845. begin
  846. n:=adj^.buf^[i-1];
  847. if flags*[ri_coalesced,ri_selected]=[] then
  848. begin
  849. supregset_include(done,n);
  850. if reginfo[n].degree>=usable_registers_cnt then
  851. inc(k);
  852. end;
  853. end;
  854. end;
  855. adj:=reginfo[v].adjlist;
  856. if adj<>nil then
  857. for i:=1 to adj^.length do
  858. begin
  859. n:=adj^.buf^[i-1];
  860. if not supregset_in(done,n) and
  861. (reginfo[n].degree>=usable_registers_cnt) and
  862. (reginfo[u].flags*[ri_coalesced,ri_selected]=[]) then
  863. inc(k);
  864. end;
  865. conservative:=(k<usable_registers_cnt);
  866. end;
  867. procedure trgobj.combine(u,v:Tsuperregister);
  868. var adj : Psuperregisterworklist;
  869. i,n,p,q:cardinal;
  870. t : tsuperregister;
  871. searched:Tlinkedlistitem;
  872. label l1;
  873. begin
  874. if not freezeworklist.delete(v) then
  875. spillworklist.delete(v);
  876. coalescednodes.add(v);
  877. include(reginfo[v].flags,ri_coalesced);
  878. reginfo[v].alias:=u;
  879. {Combine both movelists. Since the movelists are sets, only add
  880. elements that are not already present. The movelists cannot be
  881. empty by definition; nodes are only coalesced if there is a move
  882. between them. To prevent quadratic time blowup (movelists of
  883. especially machine registers can get very large because of moves
  884. generated during calls) we need to go into disgusting complexity.
  885. (See webtbs/tw2242 for an example that stresses this.)
  886. We want to sort the movelist to be able to search logarithmically.
  887. Unfortunately, sorting the movelist every time before searching
  888. is counter-productive, since the movelist usually grows with a few
  889. items at a time. Therefore, we split the movelist into a sorted
  890. and an unsorted part and search through both. If the unsorted part
  891. becomes too large, we sort.}
  892. if assigned(reginfo[u].movelist) then
  893. begin
  894. {We have to weigh the cost of sorting the list against searching
  895. the cost of the unsorted part. I use factor of 8 here; if the
  896. number of items is less than 8 times the numer of unsorted items,
  897. we'll sort the list.}
  898. with reginfo[u].movelist^ do
  899. if header.count<8*(header.count-header.sorted_until) then
  900. sort_movelist(reginfo[u].movelist);
  901. if assigned(reginfo[v].movelist) then
  902. begin
  903. for n:=0 to reginfo[v].movelist^.header.count-1 do
  904. begin
  905. {Binary search the sorted part of the list.}
  906. searched:=reginfo[v].movelist^.data[n];
  907. p:=0;
  908. q:=reginfo[u].movelist^.header.sorted_until;
  909. i:=0;
  910. if q<>0 then
  911. repeat
  912. i:=(p+q) shr 1;
  913. if ptrint(searched)>ptrint(reginfo[u].movelist^.data[i]) then
  914. p:=i+1
  915. else
  916. q:=i;
  917. until p=q;
  918. with reginfo[u].movelist^ do
  919. if searched<>data[i] then
  920. begin
  921. {Linear search the unsorted part of the list.}
  922. for i:=header.sorted_until+1 to header.count-1 do
  923. if searched=data[i] then
  924. goto l1;
  925. {Not found -> add}
  926. add_to_movelist(u,searched);
  927. l1:
  928. end;
  929. end;
  930. end;
  931. end;
  932. enable_moves(v);
  933. adj:=reginfo[v].adjlist;
  934. if adj<>nil then
  935. for i:=1 to adj^.length do
  936. begin
  937. t:=adj^.buf^[i-1];
  938. with reginfo[t] do
  939. if not(ri_coalesced in flags) then
  940. begin
  941. {t has a connection to v. Since we are adding v to u, we
  942. need to connect t to u. However, beware if t was already
  943. connected to u...}
  944. if (ibitmap[t,u]) and not (ri_selected in flags) then
  945. {... because in that case, we are actually removing an edge
  946. and the degree of t decreases.}
  947. decrement_degree(t)
  948. else
  949. begin
  950. add_edge(t,u);
  951. {We have added an edge to t and u. So their degree increases.
  952. However, v is added to u. That means its neighbours will
  953. no longer point to v, but to u instead. Therefore, only the
  954. degree of u increases.}
  955. if (u>=first_imaginary) and not (ri_selected in flags) then
  956. inc(reginfo[u].degree);
  957. end;
  958. end;
  959. end;
  960. if (reginfo[u].degree>=usable_registers_cnt) and freezeworklist.delete(u) then
  961. spillworklist.add(u);
  962. end;
  963. procedure trgobj.coalesce;
  964. var m:Tmoveins;
  965. x,y,u,v:Tsuperregister;
  966. begin
  967. m:=Tmoveins(worklist_moves.getfirst);
  968. x:=get_alias(m.x);
  969. y:=get_alias(m.y);
  970. if (y<first_imaginary) then
  971. begin
  972. u:=y;
  973. v:=x;
  974. end
  975. else
  976. begin
  977. u:=x;
  978. v:=y;
  979. end;
  980. if (u=v) then
  981. begin
  982. m.moveset:=ms_coalesced_moves; {Already coalesced.}
  983. coalesced_moves.insert(m);
  984. add_worklist(u);
  985. end
  986. {Do u and v interfere? In that case the move is constrained. Two
  987. precoloured nodes interfere allways. If v is precoloured, by the above
  988. code u is precoloured, thus interference...}
  989. else if (v<first_imaginary) or ibitmap[u,v] then
  990. begin
  991. m.moveset:=ms_constrained_moves; {Cannot coalesce yet...}
  992. constrained_moves.insert(m);
  993. add_worklist(u);
  994. add_worklist(v);
  995. end
  996. {Next test: is it possible and a good idea to coalesce??}
  997. else if ((u<first_imaginary) and adjacent_ok(u,v)) or
  998. ((u>=first_imaginary) and conservative(u,v)) then
  999. begin
  1000. m.moveset:=ms_coalesced_moves; {Move coalesced!}
  1001. coalesced_moves.insert(m);
  1002. combine(u,v);
  1003. add_worklist(u);
  1004. end
  1005. else
  1006. begin
  1007. m.moveset:=ms_active_moves;
  1008. active_moves.insert(m);
  1009. end;
  1010. end;
  1011. procedure trgobj.freeze_moves(u:Tsuperregister);
  1012. var i:cardinal;
  1013. m:Tlinkedlistitem;
  1014. v,x,y:Tsuperregister;
  1015. begin
  1016. if reginfo[u].movelist<>nil then
  1017. for i:=0 to reginfo[u].movelist^.header.count-1 do
  1018. begin
  1019. m:=reginfo[u].movelist^.data[i];
  1020. if Tmoveins(m).moveset in [ms_worklist_moves,ms_active_moves] then
  1021. begin
  1022. x:=Tmoveins(m).x;
  1023. y:=Tmoveins(m).y;
  1024. if get_alias(y)=get_alias(u) then
  1025. v:=get_alias(x)
  1026. else
  1027. v:=get_alias(y);
  1028. {Move m from active_moves/worklist_moves to frozen_moves.}
  1029. if Tmoveins(m).moveset=ms_active_moves then
  1030. active_moves.remove(m)
  1031. else
  1032. worklist_moves.remove(m);
  1033. Tmoveins(m).moveset:=ms_frozen_moves;
  1034. frozen_moves.insert(m);
  1035. if (v>=first_imaginary) and not(move_related(v)) and
  1036. (reginfo[v].degree<usable_registers_cnt) then
  1037. begin
  1038. freezeworklist.delete(v);
  1039. simplifyworklist.add(v);
  1040. end;
  1041. end;
  1042. end;
  1043. end;
  1044. procedure trgobj.freeze;
  1045. var n:Tsuperregister;
  1046. begin
  1047. { We need to take a random element out of the freezeworklist. We take
  1048. the last element. Dirty code! }
  1049. n:=freezeworklist.get;
  1050. {Add it to the simplifyworklist.}
  1051. simplifyworklist.add(n);
  1052. freeze_moves(n);
  1053. end;
  1054. procedure trgobj.select_spill;
  1055. var
  1056. n : tsuperregister;
  1057. adj : psuperregisterworklist;
  1058. max,p,i:word;
  1059. begin
  1060. { We must look for the element with the most interferences in the
  1061. spillworklist. This is required because those registers are creating
  1062. the most conflicts and keeping them in a register will not reduce the
  1063. complexity and even can cause the help registers for the spilling code
  1064. to get too much conflicts with the result that the spilling code
  1065. will never converge (PFV) }
  1066. max:=0;
  1067. p:=0;
  1068. with spillworklist do
  1069. begin
  1070. {Safe: This procedure is only called if length<>0}
  1071. for i:=0 to length-1 do
  1072. begin
  1073. adj:=reginfo[buf^[i]].adjlist;
  1074. if assigned(adj) and (adj^.length>max) then
  1075. begin
  1076. p:=i;
  1077. max:=adj^.length;
  1078. end;
  1079. end;
  1080. n:=buf^[p];
  1081. deleteidx(p);
  1082. end;
  1083. simplifyworklist.add(n);
  1084. freeze_moves(n);
  1085. end;
  1086. procedure trgobj.assign_colours;
  1087. {Assign_colours assigns the actual colours to the registers.}
  1088. var adj : Psuperregisterworklist;
  1089. i,j,k : word;
  1090. n,a,c : Tsuperregister;
  1091. colourednodes : Tsuperregisterset;
  1092. adj_colours:set of 0..255;
  1093. found : boolean;
  1094. begin
  1095. spillednodes.clear;
  1096. {Reset colours}
  1097. for n:=0 to maxreg-1 do
  1098. reginfo[n].colour:=n;
  1099. {Colour the cpu registers...}
  1100. supregset_reset(colourednodes,false,maxreg);
  1101. for n:=0 to first_imaginary-1 do
  1102. supregset_include(colourednodes,n);
  1103. {Now colour the imaginary registers on the select-stack.}
  1104. for i:=selectstack.length downto 1 do
  1105. begin
  1106. n:=selectstack.buf^[i-1];
  1107. {Create a list of colours that we cannot assign to n.}
  1108. adj_colours:=[];
  1109. adj:=reginfo[n].adjlist;
  1110. if adj<>nil then
  1111. for j:=0 to adj^.length-1 do
  1112. begin
  1113. a:=get_alias(adj^.buf^[j]);
  1114. if supregset_in(colourednodes,a) then
  1115. include(adj_colours,reginfo[a].colour);
  1116. end;
  1117. include(adj_colours,RS_STACK_POINTER_REG);
  1118. {Assume a spill by default...}
  1119. found:=false;
  1120. {Search for a colour not in this list.}
  1121. for k:=0 to usable_registers_cnt-1 do
  1122. begin
  1123. c:=usable_registers[k];
  1124. if not(c in adj_colours) then
  1125. begin
  1126. reginfo[n].colour:=c;
  1127. found:=true;
  1128. supregset_include(colourednodes,n);
  1129. include(used_in_proc,c);
  1130. break;
  1131. end;
  1132. end;
  1133. if not found then
  1134. spillednodes.add(n);
  1135. end;
  1136. {Finally colour the nodes that were coalesced.}
  1137. for i:=1 to coalescednodes.length do
  1138. begin
  1139. n:=coalescednodes.buf^[i-1];
  1140. k:=get_alias(n);
  1141. reginfo[n].colour:=reginfo[k].colour;
  1142. if reginfo[k].colour<maxcpuregister then
  1143. include(used_in_proc,reginfo[k].colour);
  1144. end;
  1145. end;
  1146. procedure trgobj.colour_registers;
  1147. begin
  1148. repeat
  1149. if simplifyworklist.length<>0 then
  1150. simplify
  1151. else if not(worklist_moves.empty) then
  1152. coalesce
  1153. else if freezeworklist.length<>0 then
  1154. freeze
  1155. else if spillworklist.length<>0 then
  1156. select_spill;
  1157. until (simplifyworklist.length=0) and
  1158. worklist_moves.empty and
  1159. (freezeworklist.length=0) and
  1160. (spillworklist.length=0);
  1161. assign_colours;
  1162. end;
  1163. procedure trgobj.epilogue_colouring;
  1164. var
  1165. i : Tsuperregister;
  1166. begin
  1167. worklist_moves.clear;
  1168. active_moves.destroy;
  1169. active_moves:=nil;
  1170. frozen_moves.destroy;
  1171. frozen_moves:=nil;
  1172. coalesced_moves.destroy;
  1173. coalesced_moves:=nil;
  1174. constrained_moves.destroy;
  1175. constrained_moves:=nil;
  1176. for i:=0 to maxreg-1 do
  1177. with reginfo[i] do
  1178. if movelist<>nil then
  1179. begin
  1180. dispose(movelist);
  1181. movelist:=nil;
  1182. end;
  1183. end;
  1184. procedure trgobj.clear_interferences(u:Tsuperregister);
  1185. {Remove node u from the interference graph and remove all collected
  1186. move instructions it is associated with.}
  1187. var i : word;
  1188. v : Tsuperregister;
  1189. adj,adj2 : Psuperregisterworklist;
  1190. begin
  1191. adj:=reginfo[u].adjlist;
  1192. if adj<>nil then
  1193. begin
  1194. for i:=1 to adj^.length do
  1195. begin
  1196. v:=adj^.buf^[i-1];
  1197. {Remove (u,v) and (v,u) from bitmap.}
  1198. ibitmap[u,v]:=false;
  1199. ibitmap[v,u]:=false;
  1200. {Remove (v,u) from adjacency list.}
  1201. adj2:=reginfo[v].adjlist;
  1202. if adj2<>nil then
  1203. begin
  1204. adj2^.delete(u);
  1205. if adj2^.length=0 then
  1206. begin
  1207. dispose(adj2,done);
  1208. reginfo[v].adjlist:=nil;
  1209. end;
  1210. end;
  1211. end;
  1212. {Remove ( u,* ) from adjacency list.}
  1213. dispose(adj,done);
  1214. reginfo[u].adjlist:=nil;
  1215. end;
  1216. end;
  1217. procedure trgobj.getregisterinline(list:Taasmoutput;
  1218. position:Tai;subreg:Tsubregister;var result:Tregister);
  1219. var p:Tsuperregister;
  1220. r:Tregister;
  1221. begin
  1222. p:=getnewreg(subreg);
  1223. live_registers.add(p);
  1224. r:=newreg(regtype,p,subreg);
  1225. if position=nil then
  1226. list.insert(Tai_regalloc.alloc(r))
  1227. else
  1228. list.insertafter(Tai_regalloc.alloc(r),position);
  1229. add_edges_used(p);
  1230. add_constraints(r);
  1231. result:=r;
  1232. end;
  1233. procedure trgobj.ungetregisterinline(list:Taasmoutput;
  1234. position:Tai;r:Tregister);
  1235. var supreg:Tsuperregister;
  1236. begin
  1237. supreg:=getsupreg(r);
  1238. live_registers.delete(supreg);
  1239. if position=nil then
  1240. list.insert(Tai_regalloc.dealloc(r))
  1241. else
  1242. list.insertafter(Tai_regalloc.dealloc(r),position);
  1243. end;
  1244. procedure trgobj.insert_regalloc_info(list:Taasmoutput;headertai:tai);
  1245. var
  1246. supreg : tsuperregister;
  1247. p : tai;
  1248. r : tregister;
  1249. begin
  1250. { Insert regallocs for all imaginary registers }
  1251. for supreg:=first_imaginary to maxreg-1 do
  1252. with reginfo[supreg] do
  1253. begin
  1254. r:=newreg(regtype,supreg,subreg);
  1255. if assigned(live_start) then
  1256. begin
  1257. {$ifdef EXTDEBUG}
  1258. if live_start=live_end then
  1259. Comment(V_Warning,'Register '+std_regname(r)+' is only used once');
  1260. {$endif EXTDEBUG}
  1261. list.insertbefore(Tai_regalloc.alloc(r),live_start);
  1262. { Insert live end deallocation before reg allocations
  1263. to reduce conflicts }
  1264. p:=live_end;
  1265. while assigned(p) and
  1266. assigned(p.previous) and
  1267. (tai(p.previous).typ=ait_regalloc) and
  1268. (tai_regalloc(p.previous).ratype=ra_alloc) and
  1269. (tai_regalloc(p.previous).reg<>r) do
  1270. p:=tai(p.previous);
  1271. list.insertbefore(Tai_regalloc.dealloc(r),p);
  1272. end
  1273. {$ifdef EXTDEBUG}
  1274. else
  1275. Comment(V_Warning,'Register '+std_regname(r)+' not used');
  1276. {$endif EXTDEBUG}
  1277. end;
  1278. end;
  1279. procedure trgobj.add_cpu_interferences(p : tai);
  1280. begin
  1281. end;
  1282. procedure trgobj.generate_interference_graph(list:Taasmoutput;headertai:tai);
  1283. var
  1284. p : tai;
  1285. i : integer;
  1286. supreg : tsuperregister;
  1287. begin
  1288. { All allocations are available. Now we can generate the
  1289. interference graph. Walk through all instructions, we can
  1290. start with the headertai, because before the header tai is
  1291. only symbols. }
  1292. live_registers.clear;
  1293. p:=headertai;
  1294. while assigned(p) do
  1295. begin
  1296. if p.typ=ait_regalloc then
  1297. with Tai_regalloc(p) do
  1298. begin
  1299. if (getregtype(reg)=regtype) then
  1300. begin
  1301. supreg:=getsupreg(reg);
  1302. case ratype of
  1303. ra_alloc :
  1304. begin
  1305. live_registers.add(supreg);
  1306. add_edges_used(supreg);
  1307. end;
  1308. ra_dealloc :
  1309. begin
  1310. live_registers.delete(supreg);
  1311. add_edges_used(supreg);
  1312. end;
  1313. end;
  1314. { constraints needs always to be updated }
  1315. add_constraints(reg);
  1316. end;
  1317. end;
  1318. add_cpu_interferences(p);
  1319. p:=Tai(p.next);
  1320. end;
  1321. {$ifdef EXTDEBUG}
  1322. if live_registers.length>0 then
  1323. begin
  1324. for i:=0 to live_registers.length-1 do
  1325. begin
  1326. { Only report for imaginary registers }
  1327. if live_registers.buf^[i]>=first_imaginary then
  1328. Comment(V_Warning,'Register '+std_regname(newreg(R_INTREGISTER,live_registers.buf^[i],defaultsub))+' not released');
  1329. end;
  1330. end;
  1331. {$endif}
  1332. end;
  1333. procedure Trgobj.translate_registers(list:taasmoutput);
  1334. var
  1335. hp,p,q:Tai;
  1336. i:shortint;
  1337. {$ifdef arm}
  1338. so:pshifterop;
  1339. {$endif arm}
  1340. begin
  1341. { Leave when no imaginary registers are used }
  1342. if maxreg<=first_imaginary then
  1343. exit;
  1344. p:=Tai(list.first);
  1345. while assigned(p) do
  1346. begin
  1347. case p.typ of
  1348. ait_regalloc:
  1349. with Tai_regalloc(p) do
  1350. begin
  1351. if (getregtype(reg)=regtype) then
  1352. setsupreg(reg,reginfo[getsupreg(reg)].colour);
  1353. {
  1354. Remove sequences of release and
  1355. allocation of the same register like:
  1356. # Register X released
  1357. # Register X allocated
  1358. }
  1359. if assigned(previous) and
  1360. (Tai(previous).typ=ait_regalloc) and
  1361. (Tai_regalloc(previous).reg=reg) and
  1362. { deallocation,allocation }
  1363. { note: do not remove allocation,deallocation, those }
  1364. { do have a real meaning }
  1365. (not(Tai_regalloc(previous).ratype=ra_alloc) and (ratype=ra_alloc)) then
  1366. begin
  1367. q:=Tai(next);
  1368. hp:=tai(previous);
  1369. list.remove(hp);
  1370. hp.free;
  1371. list.remove(p);
  1372. p.free;
  1373. p:=q;
  1374. continue;
  1375. end;
  1376. end;
  1377. ait_instruction:
  1378. with Taicpu(p) do
  1379. begin
  1380. for i:=0 to ops-1 do
  1381. with oper[i]^ do
  1382. case typ of
  1383. Top_reg:
  1384. if (getregtype(reg)=regtype) then
  1385. setsupreg(reg,reginfo[getsupreg(reg)].colour);
  1386. Top_ref:
  1387. begin
  1388. if regtype=R_INTREGISTER then
  1389. with ref^ do
  1390. begin
  1391. if base<>NR_NO then
  1392. setsupreg(base,reginfo[getsupreg(base)].colour);
  1393. if index<>NR_NO then
  1394. setsupreg(index,reginfo[getsupreg(index)].colour);
  1395. end;
  1396. end;
  1397. {$ifdef arm}
  1398. Top_shifterop:
  1399. begin
  1400. so:=shifterop;
  1401. if so^.rs<>NR_NO then
  1402. setsupreg(so^.rs,reginfo[getsupreg(so^.rs)].colour);
  1403. end;
  1404. {$endif arm}
  1405. end;
  1406. { Maybe the operation can be removed when
  1407. it is a move and both arguments are the same }
  1408. if is_same_reg_move(regtype) then
  1409. begin
  1410. q:=Tai(p.next);
  1411. list.remove(p);
  1412. p.free;
  1413. p:=q;
  1414. continue;
  1415. end;
  1416. end;
  1417. end;
  1418. p:=Tai(p.next);
  1419. end;
  1420. end;
  1421. function trgobj.get_insert_pos(p:Tai;huntfor1,huntfor2,huntfor3:Tsuperregister):Tai;
  1422. var
  1423. back : Tsuperregisterworklist;
  1424. supreg : tsuperregister;
  1425. begin
  1426. back.copyfrom(live_registers);
  1427. result:=p;
  1428. while (p<>nil) and (p.typ=ait_regalloc) do
  1429. begin
  1430. supreg:=getsupreg(Tai_regalloc(p).reg);
  1431. {Rewind the register allocation.}
  1432. if (Tai_regalloc(p).ratype=ra_alloc) then
  1433. live_registers.delete(supreg)
  1434. else
  1435. begin
  1436. live_registers.add(supreg);
  1437. if supreg=huntfor1 then
  1438. begin
  1439. get_insert_pos:=Tai(p.previous);
  1440. back.done;
  1441. back.copyfrom(live_registers);
  1442. end;
  1443. if supreg=huntfor2 then
  1444. begin
  1445. get_insert_pos:=Tai(p.previous);
  1446. back.done;
  1447. back.copyfrom(live_registers);
  1448. end;
  1449. if supreg=huntfor3 then
  1450. begin
  1451. get_insert_pos:=Tai(p.previous);
  1452. back.done;
  1453. back.copyfrom(live_registers);
  1454. end;
  1455. end;
  1456. p:=Tai(p.previous);
  1457. end;
  1458. live_registers.done;
  1459. live_registers:=back;
  1460. end;
  1461. procedure trgobj.forward_allocation(pfrom,pto:Tai);
  1462. var
  1463. p : tai;
  1464. begin
  1465. {Forward the register allocation again.}
  1466. p:=pfrom;
  1467. while (p<>pto) do
  1468. begin
  1469. if p.typ<>ait_regalloc then
  1470. internalerror(200305311);
  1471. case Tai_regalloc(p).ratype of
  1472. ra_alloc :
  1473. live_registers.add(getsupreg(Tai_regalloc(p).reg));
  1474. ra_dealloc :
  1475. live_registers.delete(getsupreg(Tai_regalloc(p).reg));
  1476. end;
  1477. p:=Tai(p.next);
  1478. end;
  1479. end;
  1480. function trgobj.spill_registers(list:Taasmoutput;headertai:tai):boolean;
  1481. { Returns true if any help registers have been used }
  1482. var
  1483. i : word;
  1484. t : tsuperregister;
  1485. p,q : Tai;
  1486. regs_to_spill_set:Tsuperregisterset;
  1487. spill_temps : ^Tspill_temp_list;
  1488. supreg : tsuperregister;
  1489. templist : taasmoutput;
  1490. begin
  1491. spill_registers:=false;
  1492. live_registers.clear;
  1493. for i:=first_imaginary to maxreg-1 do
  1494. exclude(reginfo[i].flags,ri_selected);
  1495. spill_temps:=allocmem(sizeof(treference)*maxreg);
  1496. supregset_reset(regs_to_spill_set,false,$ffff);
  1497. { Allocate temps and insert in front of the list }
  1498. templist:=taasmoutput.create;
  1499. {Safe: this procedure is only called if there are spilled nodes.}
  1500. with spillednodes do
  1501. for i:=0 to length-1 do
  1502. begin
  1503. t:=buf^[i];
  1504. {Alternative representation.}
  1505. supregset_include(regs_to_spill_set,t);
  1506. {Clear all interferences of the spilled register.}
  1507. clear_interferences(t);
  1508. {Get a temp for the spilled register}
  1509. tg.gettemp(templist,tcgsize2size[reg_cgsize(newreg(regtype,t,R_SUBWHOLE))],tt_noreuse,spill_temps^[t]);
  1510. end;
  1511. list.insertlistafter(headertai,templist);
  1512. templist.free;
  1513. { Walk through all instructions, we can start with the headertai,
  1514. because before the header tai is only symbols }
  1515. p:=headertai;
  1516. while assigned(p) do
  1517. begin
  1518. case p.typ of
  1519. ait_regalloc:
  1520. with Tai_regalloc(p) do
  1521. begin
  1522. if (getregtype(reg)=regtype) then
  1523. begin
  1524. {A register allocation of a spilled register can be removed.}
  1525. supreg:=getsupreg(reg);
  1526. if supregset_in(regs_to_spill_set,supreg) then
  1527. begin
  1528. q:=Tai(p.next);
  1529. list.remove(p);
  1530. p.free;
  1531. p:=q;
  1532. continue;
  1533. end
  1534. else
  1535. begin
  1536. case ratype of
  1537. ra_alloc :
  1538. live_registers.add(supreg);
  1539. ra_dealloc :
  1540. live_registers.delete(supreg);
  1541. end;
  1542. end;
  1543. end;
  1544. end;
  1545. ait_instruction:
  1546. with Taicpu(p) do
  1547. begin
  1548. aktfilepos:=fileinfo;
  1549. if instr_spill_register(list,taicpu(p),regs_to_spill_set,spill_temps^) then
  1550. spill_registers:=true;
  1551. end;
  1552. end;
  1553. p:=Tai(p.next);
  1554. end;
  1555. aktfilepos:=current_procinfo.exitpos;
  1556. {Safe: this procedure is only called if there are spilled nodes.}
  1557. with spillednodes do
  1558. for i:=0 to length-1 do
  1559. tg.ungettemp(list,spill_temps^[buf^[i]]);
  1560. freemem(spill_temps);
  1561. end;
  1562. procedure Trgobj.do_spill_read(list:Taasmoutput;instr:taicpu;
  1563. pos:Tai;regidx:word;
  1564. const spilltemplist:Tspill_temp_list;
  1565. const regs:Tspillregsinfo);
  1566. var helpins:Tai;
  1567. begin
  1568. with regs[regidx] do
  1569. begin
  1570. helpins:=spilling_create_load(spilltemplist[orgreg],tempreg);
  1571. if pos=nil then
  1572. list.insertafter(helpins,list.first)
  1573. else
  1574. list.insertafter(helpins,pos.next);
  1575. ungetregisterinline(list,instr,tempreg);
  1576. forward_allocation(tai(helpins.next),instr);
  1577. end;
  1578. end;
  1579. procedure Trgobj.do_spill_written(list:Taasmoutput;instr:taicpu;
  1580. pos:Tai;regidx:word;
  1581. const spilltemplist:Tspill_temp_list;
  1582. const regs:Tspillregsinfo);
  1583. var helpins:Tai;
  1584. begin
  1585. with regs[regidx] do
  1586. begin
  1587. helpins:=spilling_create_store(tempreg,spilltemplist[orgreg]);
  1588. list.insertafter(helpins,instr);
  1589. ungetregisterinline(list,helpins,tempreg);
  1590. end;
  1591. end;
  1592. procedure Trgobj.do_spill_readwritten(list:Taasmoutput;instr:taicpu;
  1593. pos:Tai;regidx:word;
  1594. const spilltemplist:Tspill_temp_list;
  1595. const regs:Tspillregsinfo);
  1596. var helpins1,helpins2:Tai;
  1597. begin
  1598. with regs[regidx] do
  1599. begin
  1600. helpins1:=spilling_create_load(spilltemplist[orgreg],tempreg);
  1601. if pos=nil then
  1602. list.insertafter(helpins1,list.first)
  1603. else
  1604. list.insertafter(helpins1,pos.next);
  1605. helpins2:=spilling_create_store(tempreg,spilltemplist[orgreg]);
  1606. list.insertafter(helpins2,instr);
  1607. ungetregisterinline(list,helpins2,tempreg);
  1608. forward_allocation(tai(helpins1.next),instr);
  1609. end;
  1610. end;
  1611. function trgobj.get_spill_subreg(r : tregister) : tsubregister;
  1612. begin
  1613. result:=defaultsub;
  1614. end;
  1615. function trgobj.instr_spill_register(list:Taasmoutput;
  1616. instr:taicpu;
  1617. const r:Tsuperregisterset;
  1618. const spilltemplist:Tspill_temp_list): boolean;
  1619. var
  1620. counter, regindex: longint;
  1621. pos: tai;
  1622. regs: tspillregsinfo;
  1623. spilled: boolean;
  1624. procedure addreginfo(reg: tregister; operation: topertype);
  1625. var
  1626. i, tmpindex: longint;
  1627. supreg : tsuperregister;
  1628. begin
  1629. tmpindex := regindex;
  1630. supreg:=getsupreg(reg);
  1631. // did we already encounter this register?
  1632. for i := 0 to pred(regindex) do
  1633. if (regs[i].orgreg = supreg) then
  1634. begin
  1635. tmpindex := i;
  1636. break;
  1637. end;
  1638. if tmpindex > high(regs) then
  1639. internalerror(2003120301);
  1640. regs[tmpindex].orgreg := supreg;
  1641. regs[tmpindex].spillreg:=reg;
  1642. if supregset_in(r,supreg) then
  1643. begin
  1644. // add/update info on this register
  1645. regs[tmpindex].mustbespilled := true;
  1646. case operation of
  1647. operand_read:
  1648. regs[tmpindex].regread := true;
  1649. operand_write:
  1650. regs[tmpindex].regwritten := true;
  1651. operand_readwrite:
  1652. begin
  1653. regs[tmpindex].regread := true;
  1654. regs[tmpindex].regwritten := true;
  1655. end;
  1656. end;
  1657. spilled := true;
  1658. end;
  1659. inc(regindex,ord(regindex=tmpindex));
  1660. end;
  1661. procedure tryreplacereg(var reg: tregister);
  1662. var
  1663. i: longint;
  1664. supreg: tsuperregister;
  1665. begin
  1666. supreg := getsupreg(reg);
  1667. for i := 0 to pred(regindex) do
  1668. if (regs[i].mustbespilled) and
  1669. (regs[i].orgreg = supreg) then
  1670. begin
  1671. reg := regs[i].tempreg;
  1672. break;
  1673. end;
  1674. end;
  1675. begin
  1676. result := false;
  1677. fillchar(regs,sizeof(regs),0);
  1678. for counter := low(regs) to high(regs) do
  1679. regs[counter].orgreg := RS_INVALID;
  1680. spilled := false;
  1681. regindex := 0;
  1682. { check whether and if so which and how (read/written) this instructions contains
  1683. registers that must be spilled }
  1684. for counter := 0 to instr.ops-1 do
  1685. with instr.oper[counter]^ do
  1686. begin
  1687. case typ of
  1688. top_reg:
  1689. begin
  1690. if (getregtype(reg) = regtype) then
  1691. addreginfo(reg,instr.spilling_get_operation_type(counter));
  1692. end;
  1693. top_ref:
  1694. begin
  1695. if regtype in [R_INTREGISTER,R_ADDRESSREGISTER] then
  1696. with ref^ do
  1697. begin
  1698. if (base <> NR_NO) then
  1699. addreginfo(base,operand_read);
  1700. if (index <> NR_NO) then
  1701. addreginfo(index,operand_read);
  1702. end;
  1703. end;
  1704. {$ifdef ARM}
  1705. top_shifterop:
  1706. begin
  1707. if shifterop^.rs<>NR_NO then
  1708. addreginfo(shifterop^.rs,operand_read);
  1709. end;
  1710. {$endif ARM}
  1711. end;
  1712. end;
  1713. { if no spilling for this instruction we can leave }
  1714. if not spilled then
  1715. exit;
  1716. { generate the spilling code }
  1717. result := true;
  1718. for counter := 0 to pred(regindex) do
  1719. with regs[counter] do
  1720. begin
  1721. if mustbespilled then
  1722. begin
  1723. pos:=get_insert_pos(Tai(instr.previous),regs[0].orgreg,regs[1].orgreg,regs[2].orgreg);
  1724. getregisterinline(list,pos,get_spill_subreg(regs[counter].spillreg),tempreg);
  1725. if regread then
  1726. if regwritten then
  1727. do_spill_readwritten(list,instr,pos,counter,spilltemplist,regs)
  1728. else
  1729. do_spill_read(list,instr,pos,counter,spilltemplist,regs)
  1730. else
  1731. do_spill_written(list,instr,pos,counter,spilltemplist,regs)
  1732. end;
  1733. end;
  1734. { substitute registers }
  1735. for counter := 0 to instr.ops-1 do
  1736. with instr.oper[counter]^ do
  1737. begin
  1738. case typ of
  1739. top_reg:
  1740. begin
  1741. tryreplacereg(reg);
  1742. end;
  1743. top_ref:
  1744. begin
  1745. tryreplacereg(ref^.base);
  1746. tryreplacereg(ref^.index);
  1747. end;
  1748. {$ifdef ARM}
  1749. top_shifterop:
  1750. begin
  1751. tryreplacereg(shifterop^.rs);
  1752. end;
  1753. {$endif ARM}
  1754. end;
  1755. end;
  1756. end;
  1757. end.
  1758. {
  1759. $Log$
  1760. Revision 1.132 2004-07-08 09:57:55 daniel
  1761. * Use a normal pascal set in assign_colours, since it only will contain
  1762. real registers
  1763. Revision 1.131 2004/07/07 17:35:26 daniel
  1764. * supregset_reset clears 8kb of memory. However, it is being called in
  1765. inner loops, see for example colour_registers. According to profile data
  1766. this causes fillchar to be the most time consuming procedure.
  1767. Some modifications done to make it clear less than 8kb of memory each
  1768. call. Divides time spent in fillchar by two, but it still is the no.1
  1769. procedure.
  1770. Revision 1.130 2004/06/22 18:24:18 florian
  1771. * fixed arm compilation
  1772. Revision 1.129 2004/06/20 08:55:30 florian
  1773. * logs truncated
  1774. Revision 1.128 2004/06/20 08:47:33 florian
  1775. * spilling of doubles on sparc fixed
  1776. Revision 1.127 2004/06/16 20:07:09 florian
  1777. * dwarf branch merged
  1778. Revision 1.126 2004/05/22 23:34:28 peter
  1779. tai_regalloc.allocation changed to ratype to notify rgobj of register size changes
  1780. Revision 1.125 2004/04/26 19:57:50 jonas
  1781. * do not remove "allocation,deallocation" pairs, as those are important
  1782. for the optimizer
  1783. Revision 1.124.2.3 2004/06/13 10:51:16 florian
  1784. * fixed several register allocator problems (sparc/arm)
  1785. }