regvars.pas 35 KB

123456789101112131415161718192021222324252627282930313233343536373839404142434445464748495051525354555657585960616263646566676869707172737475767778798081828384858687888990919293949596979899100101102103104105106107108109110111112113114115116117118119120121122123124125126127128129130131132133134135136137138139140141142143144145146147148149150151152153154155156157158159160161162163164165166167168169170171172173174175176177178179180181182183184185186187188189190191192193194195196197198199200201202203204205206207208209210211212213214215216217218219220221222223224225226227228229230231232233234235236237238239240241242243244245246247248249250251252253254255256257258259260261262263264265266267268269270271272273274275276277278279280281282283284285286287288289290291292293294295296297298299300301302303304305306307308309310311312313314315316317318319320321322323324325326327328329330331332333334335336337338339340341342343344345346347348349350351352353354355356357358359360361362363364365366367368369370371372373374375376377378379380381382383384385386387388389390391392393394395396397398399400401402403404405406407408409410411412413414415416417418419420421422423424425426427428429430431432433434435436437438439440441442443444445446447448449450451452453454455456457458459460461462463464465466467468469470471472473474475476477478479480481482483484485486487488489490491492493494495496497498499500501502503504505506507508509510511512513514515516517518519520521522523524525526527528529530531532533534535536537538539540541542543544545546547548549550551552553554555556557558559560561562563564565566567568569570571572573574575576577578579580581582583584585586587588589590591592593594595596597598599600601602603604605606607608609610611612613614615616617618619620621622623624625626627628629630631632633634635636637638639640641642643644645646647648649650651652653654655656657658659660661662663664665666667668669670671672673674675676677678679680681682683684685686687688689690691692693694695696697698699700701702703704705706707708709710711712713714715716717718719720721722723724725726727728729730731732733734735736737738739740741742743744745746747748749750751752753754755756757758759760761762763764765766767768769770771772773774775776777778779780781782783784785786787788789790791792793794795796797798799800801802803804805806807808809810811812813814815816817818819820821822823824825826827828829830831832833834835836837838839840841842843844845846847848849850851852853854855856857858859860861862863864865866867868869870871872873874875876877878879880881882883884885886887888889890891892893894895896897898899900901902903904905906907908
  1. {
  2. $Id$
  3. Copyright (c) 1998-2002 by Florian Klaempfl and Jonas Maebe
  4. This unit handles register variable allocation
  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. unit regvars;
  19. {$i fpcdefs.inc}
  20. interface
  21. uses
  22. aasmbase,aasmtai,aasmcpu,
  23. node,
  24. symsym,
  25. cpubase, cginfo, tgobj, rgobj;
  26. procedure assign_regvars(p: tnode);
  27. procedure load_regvars(asml: TAAsmoutput; p: tnode);
  28. procedure cleanup_regvars(asml: TAAsmoutput);
  29. procedure store_regvar(asml: TAAsmoutput; reg: tregister);
  30. procedure load_regvar(asml: TAAsmoutput; vsym: tvarsym);
  31. procedure load_regvar_reg(asml: TAAsmoutput; reg: tregister);
  32. procedure load_all_regvars(asml: TAAsmoutput);
  33. {$ifdef newra}
  34. procedure free_regvars(list: taasmoutput);
  35. procedure translate_regvars(list: taasmoutput; const table:Ttranstable);
  36. {$endif newra}
  37. {$ifdef i386}
  38. procedure sync_regvars_other(list1, list2: taasmoutput; const regvarsloaded1,
  39. regvarsloaded2: regvarother_booleanarray);
  40. procedure sync_regvars_int(list1, list2: taasmoutput; const regvarsloaded1,
  41. regvarsloaded2: Tsupregset);
  42. {$endif i386}
  43. implementation
  44. uses
  45. globtype,systems,comphook,
  46. cutils,cclasses,verbose,globals,
  47. psub,
  48. symconst,symbase,symtype,symdef,paramgr,defutil,
  49. cpuinfo,cgbase,cgobj,rgcpu;
  50. procedure searchregvars(p : tnamedindexitem;arg:pointer);
  51. var
  52. i,j,k : longint;
  53. parasym : boolean;
  54. begin
  55. parasym:=pboolean(arg)^;
  56. if (tsym(p).typ=varsym) and (vo_regable in tvarsym(p).varoptions) then
  57. begin
  58. j:=tvarsym(p).refs;
  59. { parameter get a less value }
  60. if parasym then
  61. begin
  62. if cs_littlesize in aktglobalswitches then
  63. dec(j,1)
  64. else
  65. dec(j,100);
  66. end;
  67. { walk through all momentary register variables }
  68. for i:=1 to maxvarregs do
  69. begin
  70. with pregvarinfo(current_procinfo.procdef.regvarinfo)^ do
  71. if ((regvars[i]=nil) or (j>regvars_refs[i])) and (j>0) then
  72. begin
  73. for k:=maxvarregs-1 downto i do
  74. begin
  75. regvars[k+1]:=regvars[k];
  76. regvars_para[k+1]:=regvars_para[k];
  77. regvars_refs[k+1]:=regvars_refs[k];
  78. end;
  79. { calc the new refs
  80. tvarsym(p).refs:=j; }
  81. regvars[i]:=tvarsym(p);
  82. regvars_para[i]:=parasym;
  83. regvars_refs[i]:=j;
  84. break;
  85. end;
  86. end;
  87. end;
  88. end;
  89. procedure searchfpuregvars(p : tnamedindexitem;arg:pointer);
  90. var
  91. i,j,k : longint;
  92. parasym : boolean;
  93. begin
  94. parasym:=pboolean(arg)^;
  95. if (tsym(p).typ=varsym) and (vo_fpuregable in tvarsym(p).varoptions) then
  96. begin
  97. j:=tvarsym(p).refs;
  98. { parameter get a less value }
  99. if parasym then
  100. begin
  101. if cs_littlesize in aktglobalswitches then
  102. dec(j,1)
  103. else
  104. dec(j,100);
  105. end;
  106. { walk through all momentary register variables }
  107. for i:=1 to maxfpuvarregs do
  108. begin
  109. with pregvarinfo(current_procinfo.procdef.regvarinfo)^ do
  110. if ((fpuregvars[i]=nil) or (j>fpuregvars_refs[i])) and (j>0) then
  111. begin
  112. for k:=maxfpuvarregs-1 downto i do
  113. begin
  114. fpuregvars[k+1]:=fpuregvars[k];
  115. fpuregvars_para[k+1]:=fpuregvars_para[k];
  116. fpuregvars_refs[k+1]:=fpuregvars_refs[k];
  117. end;
  118. { calc the new refs
  119. tvarsym(p).refs:=j; }
  120. fpuregvars[i]:=tvarsym(p);
  121. fpuregvars_para[i]:=parasym;
  122. fpuregvars_refs[i]:=j;
  123. break;
  124. end;
  125. end;
  126. end;
  127. end;
  128. procedure assign_regvars(p: tnode);
  129. { register variables }
  130. var
  131. {$ifndef i386}
  132. hp: tparaitem;
  133. {$endif i386}
  134. regvarinfo: pregvarinfo;
  135. i: longint;
  136. parasym : boolean;
  137. r : Tregister;
  138. siz : tcgsize;
  139. begin
  140. { max. optimizations }
  141. { only if no asm is used }
  142. { and no try statement }
  143. if (cs_regvars in aktglobalswitches) and
  144. {$ifndef i386}
  145. { we have to store regvars back to memory in this case! }
  146. (tcgprocinfo(current_procinfo).nestedprocs.count = 0) and
  147. {$endif i386}
  148. not(pi_uses_asm in current_procinfo.flags) and
  149. not(pi_uses_exceptions in current_procinfo.flags) then
  150. begin
  151. new(regvarinfo);
  152. fillchar(regvarinfo^,sizeof(regvarinfo^),0);
  153. current_procinfo.procdef.regvarinfo := regvarinfo;
  154. if (p.registers32<maxvarregs) then
  155. begin
  156. parasym:=false;
  157. symtablestack.foreach_static({$ifdef FPCPROCVAR}@{$endif}searchregvars,@parasym);
  158. { copy parameter into a register ? }
  159. parasym:=true;
  160. {$ifndef newra}
  161. {$ifndef i386}
  162. if (pi_do_call in current_procinfo.flags) then
  163. {$endif not i386}
  164. {$endif not newra}
  165. begin
  166. symtablestack.next.foreach_static({$ifdef FPCPROCVAR}@{$endif}searchregvars,@parasym);
  167. end
  168. {$ifndef newra}
  169. {$ifndef i386}
  170. else
  171. begin
  172. hp:=tparaitem(current_procinfo.procdef.para.first);
  173. while assigned(hp) do
  174. begin
  175. if (hp.paraloc[calleeside].loc in [LOC_REGISTER,LOC_FPUREGISTER,
  176. LOC_CREGISTER,LOC_CFPUREGISTER]) and
  177. (TCGSize2Size[hp.paraloc[calleeside].size] <= sizeof(aword)) then
  178. begin
  179. tvarsym(hp.parasym).reg := hp.paraloc[calleeside].register;
  180. if (hp.paraloc[calleeside].loc in [LOC_REGISTER,LOC_CREGISTER]) then
  181. rg.makeregvarint(hp.paraloc[calleeside].register.number shr 8)
  182. else
  183. rg.makeregvarother(hp.paraloc[calleeside].register);
  184. end
  185. else
  186. begin
  187. searchregvars(hp.parasym,@parasym);
  188. searchfpuregvars(hp.parasym,@parasym);
  189. end;
  190. hp := tparaitem(hp.next);
  191. end;
  192. end
  193. {$endif not i386}
  194. {$endif not newra}
  195. ;
  196. { hold needed registers free }
  197. for i:=maxvarregs downto maxvarregs-p.registers32+1{$ifdef newra}-maxintscratchregs{$endif newra} do
  198. begin
  199. regvarinfo^.regvars[i]:=nil;
  200. regvarinfo^.regvars_para[i] := false;
  201. end;
  202. { now assign register }
  203. for i:=1 to maxvarregs-p.registers32{$ifdef newra}-maxintscratchregs{$endif newra} do
  204. begin
  205. if assigned(regvarinfo^.regvars[i]) and
  206. {$ifdef newra}
  207. { currently we assume we can use volatile registers for all }
  208. { regvars if procedure does no call }
  209. (not(pi_do_call in current_procinfo.flags) or
  210. { otherwise, demand some (arbitrary) minimum usage }
  211. (regvarinfo^.regvars[i].refs > 100)) then
  212. {$else newra}
  213. (rg.reg_pushes_int[varregs[i]] < regvarinfo^.regvars[i].refs) then
  214. {$endif newra}
  215. begin
  216. { register is no longer available for }
  217. { expressions }
  218. { search the register which is the most }
  219. { unused }
  220. {$ifndef newra}
  221. rg.makeregvarint(varregs[i]);
  222. {$endif newra}
  223. { call by reference/const ? }
  224. if (regvarinfo^.regvars[i].varspez in [vs_var,vs_out]) or
  225. ((regvarinfo^.regvars[i].varspez=vs_const) and
  226. paramanager.push_addr_param(regvarinfo^.regvars[i].vartype.def,current_procinfo.procdef.proccalloption)) then
  227. siz:=OS_32
  228. else
  229. if (regvarinfo^.regvars[i].vartype.def.deftype in [orddef,enumdef]) and
  230. (regvarinfo^.regvars[i].vartype.def.size=1) then
  231. siz:=OS_8
  232. else
  233. if (regvarinfo^.regvars[i].vartype.def.deftype in [orddef,enumdef]) and
  234. (regvarinfo^.regvars[i].vartype.def.size=2) then
  235. siz:=OS_16
  236. else
  237. siz:=OS_32;
  238. {$ifdef newra}
  239. { allocate a register for this regvar }
  240. regvarinfo^.regvars[i].reg:=rg.getregisterint(exprasmlist,siz);
  241. { and make sure it can't be freed }
  242. rg.makeregvarint(regvarinfo^.regvars[i].reg.number shr 8);
  243. {$else newra}
  244. regvarinfo^.regvars[i].reg.enum:=R_INTREGISTER;
  245. regvarinfo^.regvars[i].reg.number:=(varregs[i] shl 8) or cgsize2subreg(siz);
  246. {$ifdef i386}
  247. { procedure uses this register }
  248. include(rg.used_in_proc_int,varregs[i]);
  249. {$endif i386}
  250. {$endif newra}
  251. end
  252. else
  253. begin
  254. regvarinfo^.regvars[i] := nil;
  255. regvarinfo^.regvars_para[i] := false;
  256. end;
  257. end;
  258. end;
  259. if ((p.registersfpu+1)<maxfpuvarregs) then
  260. begin
  261. parasym:=false;
  262. symtablestack.foreach_static({$ifdef FPCPROCVAR}@{$endif}searchfpuregvars,@parasym);
  263. {$ifdef dummy}
  264. { this code should be never enabled because }
  265. { 1. the caller loads parameters into registers }
  266. { 2. (later) the CSE loads a parameter into a }
  267. { register, if necessary }
  268. { (FK) }
  269. { copy parameter into a register ? }
  270. parasym:=true;
  271. symtablestack.next.foreach_static({$ifdef FPCPROCVAR}@{$endif}searchregvars);
  272. {$endif dummy}
  273. { hold needed registers free }
  274. { in non leaf procedures we must be very careful }
  275. { with assigning registers }
  276. if aktmaxfpuregisters=-1 then
  277. begin
  278. if (pi_do_call in current_procinfo.flags) then
  279. begin
  280. for i:=maxfpuvarregs downto 2 do
  281. regvarinfo^.fpuregvars[i]:=nil;
  282. end
  283. else
  284. begin
  285. for i:=maxfpuvarregs downto maxfpuvarregs-p.registersfpu do
  286. regvarinfo^.fpuregvars[i]:=nil;
  287. end;
  288. end
  289. else
  290. begin
  291. for i:=aktmaxfpuregisters+1 to maxfpuvarregs do
  292. regvarinfo^.fpuregvars[i]:=nil;
  293. end;
  294. { now assign register }
  295. for i:=1 to maxfpuvarregs do
  296. begin
  297. if assigned(regvarinfo^.fpuregvars[i]) then
  298. begin
  299. {$ifdef i386}
  300. { reserve place on the FPU stack }
  301. r.enum:=R_ST0;
  302. regvarinfo^.fpuregvars[i].reg:=trgcpu(rg).correct_fpuregister(r,i);
  303. {$else i386}
  304. regvarinfo^.fpuregvars[i].reg.enum:=fpuvarregs[i];
  305. rg.makeregvarother(regvarinfo^.fpuregvars[i].reg);
  306. {$endif i386}
  307. end;
  308. end;
  309. end;
  310. end;
  311. end;
  312. procedure store_regvar(asml: TAAsmoutput; reg: tregister);
  313. var
  314. i: longint;
  315. cgsize : tcgsize;
  316. r : tregister;
  317. hr: treference;
  318. regvarinfo: pregvarinfo;
  319. vsym: tvarsym;
  320. begin
  321. {$ifdef i386}
  322. regvarinfo := pregvarinfo(current_procinfo.procdef.regvarinfo);
  323. if not assigned(regvarinfo) then
  324. exit;
  325. if reg.enum=R_INTREGISTER then
  326. begin
  327. for i := 1 to maxvarregs do
  328. if assigned(regvarinfo^.regvars[i]) and
  329. (regvarinfo^.regvars[i].reg.number shr 8 = reg.number shr 8) then
  330. begin
  331. if (reg.number shr 8) in rg.regvar_loaded_int then
  332. begin
  333. vsym := tvarsym(regvarinfo^.regvars[i]);
  334. { we only have to store the regvar back to memory if it's }
  335. { possible that it's been modified (JM) }
  336. if not(vsym.varspez in [vs_const,vs_var,vs_out]) then
  337. begin
  338. reference_reset_base(hr,current_procinfo.framepointer,vsym.adjusted_address);
  339. cgsize:=def_cgsize(vsym.vartype.def);
  340. cg.a_load_reg_ref(asml,cgsize,cgsize,vsym.reg,hr);
  341. end;
  342. asml.concat(tai_regalloc.dealloc(vsym.reg));
  343. exclude(rg.regvar_loaded_int,reg.number shr 8);
  344. end;
  345. break;
  346. end;
  347. end
  348. else
  349. begin
  350. for i := 1 to maxvarregs do
  351. if assigned(regvarinfo^.regvars[i]) then
  352. begin
  353. r:=rg.makeregsize(regvarinfo^.regvars[i].reg,OS_INT);
  354. if (r.enum = reg.enum) then
  355. begin
  356. if rg.regvar_loaded_other[r.enum] then
  357. begin
  358. vsym := tvarsym(regvarinfo^.regvars[i]);
  359. { we only have to store the regvar back to memory if it's }
  360. { possible that it's been modified (JM) }
  361. if not(vsym.varspez in [vs_const,vs_var,vs_out]) then
  362. begin
  363. reference_reset_base(hr,current_procinfo.framepointer,vsym.adjusted_address);
  364. cgsize:=def_cgsize(vsym.vartype.def);
  365. cg.a_load_reg_ref(asml,cgsize,cgsize,vsym.reg,hr);
  366. end;
  367. asml.concat(tai_regalloc.dealloc(vsym.reg));
  368. rg.regvar_loaded_other[r.enum] := false;
  369. end;
  370. break;
  371. end;
  372. end;
  373. end;
  374. {$endif i386}
  375. end;
  376. procedure load_regvar(asml: TAAsmoutput; vsym: tvarsym);
  377. var
  378. hr: treference;
  379. opsize: tcgsize;
  380. r,
  381. reg : tregister;
  382. begin
  383. {$ifndef i386}
  384. exit;
  385. {$endif i386}
  386. reg:=vsym.reg;
  387. if reg.enum=R_INTREGISTER then
  388. begin
  389. if not((reg.number shr 8) in rg.regvar_loaded_int) then
  390. begin
  391. asml.concat(tai_regalloc.alloc(reg));
  392. reference_reset_base(hr,current_procinfo.framepointer,vsym.adjusted_address);
  393. if (vsym.varspez in [vs_var,vs_out]) or
  394. ((vsym.varspez=vs_const) and
  395. paramanager.push_addr_param(vsym.vartype.def,current_procinfo.procdef.proccalloption)) then
  396. opsize := OS_ADDR
  397. else
  398. opsize := def_cgsize(vsym.vartype.def);
  399. cg.a_load_ref_reg(asml,opsize,opsize,hr,reg);
  400. include(rg.regvar_loaded_int,reg.number shr 8);
  401. end;
  402. end
  403. else
  404. begin
  405. r:=rg.makeregsize(reg,OS_INT);
  406. if not rg.regvar_loaded_other[r.enum] then
  407. begin
  408. asml.concat(tai_regalloc.alloc(reg));
  409. reference_reset_base(hr,current_procinfo.framepointer,vsym.adjusted_address);
  410. if (vsym.varspez in [vs_var,vs_out]) or
  411. ((vsym.varspez=vs_const) and
  412. paramanager.push_addr_param(vsym.vartype.def,current_procinfo.procdef.proccalloption)) then
  413. opsize := OS_ADDR
  414. else
  415. opsize := def_cgsize(vsym.vartype.def);
  416. cg.a_load_ref_reg(asml,opsize,opsize,hr,reg);
  417. rg.regvar_loaded_other[r.enum] := true;
  418. end;
  419. end;
  420. end;
  421. procedure load_regvar_reg(asml: TAAsmoutput; reg: tregister);
  422. var
  423. i: longint;
  424. regvarinfo: pregvarinfo;
  425. reg_spare : tregister;
  426. begin
  427. regvarinfo := pregvarinfo(current_procinfo.procdef.regvarinfo);
  428. if not assigned(regvarinfo) then
  429. exit;
  430. if reg.enum=R_INTREGISTER then
  431. begin
  432. for i := 1 to maxvarregs do
  433. if assigned(regvarinfo^.regvars[i]) and
  434. (regvarinfo^.regvars[i].reg.number shr 8 = reg.number shr 8) then
  435. load_regvar(asml,tvarsym(regvarinfo^.regvars[i]))
  436. end
  437. else
  438. begin
  439. reg_spare := rg.makeregsize(reg,OS_INT);
  440. if reg_spare.enum>lastreg then
  441. internalerror(2003010801);
  442. for i := 1 to maxvarregs do
  443. if assigned(regvarinfo^.regvars[i]) and
  444. (rg.makeregsize(regvarinfo^.regvars[i].reg,OS_INT).enum = reg_spare.enum) then
  445. load_regvar(asml,tvarsym(regvarinfo^.regvars[i]))
  446. end;
  447. end;
  448. procedure load_all_regvars(asml: TAAsmoutput);
  449. var
  450. i: longint;
  451. regvarinfo: pregvarinfo;
  452. begin
  453. regvarinfo := pregvarinfo(current_procinfo.procdef.regvarinfo);
  454. if not assigned(regvarinfo) then
  455. exit;
  456. for i := 1 to maxvarregs do
  457. if assigned(regvarinfo^.regvars[i]) then
  458. load_regvar(asml,tvarsym(regvarinfo^.regvars[i]))
  459. end;
  460. procedure load_regvars(asml: TAAsmoutput; p: tnode);
  461. var
  462. i: longint;
  463. regvarinfo: pregvarinfo;
  464. r:Tregister;
  465. begin
  466. if (cs_regvars in aktglobalswitches) and
  467. not(pi_uses_asm in current_procinfo.flags) and
  468. not(pi_uses_exceptions in current_procinfo.flags) then
  469. begin
  470. regvarinfo := pregvarinfo(current_procinfo.procdef.regvarinfo);
  471. { can happen when inlining assembler procedures (JM) }
  472. if not assigned(regvarinfo) then
  473. exit;
  474. {$ifndef newra}
  475. for i:=1 to maxvarregs do
  476. begin
  477. if assigned(regvarinfo^.regvars[i]) then
  478. begin
  479. r:=regvarinfo^.regvars[i].reg;
  480. convert_register_to_enum(r);
  481. if cs_asm_source in aktglobalswitches then
  482. asml.insert(tai_comment.Create(strpnew(regvarinfo^.regvars[i].name+
  483. ' with weight '+tostr(regvarinfo^.regvars[i].refs)+' assigned to register '+
  484. std_reg2str[r.enum])));
  485. Message3(cg_d_register_weight,std_reg2str[r.enum],
  486. tostr(regvarinfo^.regvars[i].refs),regvarinfo^.regvars[i].name);
  487. end;
  488. end;
  489. {$endif newra}
  490. for i:=1 to maxfpuvarregs do
  491. begin
  492. if assigned(regvarinfo^.fpuregvars[i]) then
  493. begin
  494. {$ifdef i386}
  495. r.enum:=R_ST0;
  496. { reserve place on the FPU stack }
  497. regvarinfo^.fpuregvars[i].reg:=trgcpu(rg).correct_fpuregister(r,i-1);
  498. asml.concat(Taicpu.op_none(A_FLDZ,S_NO));
  499. {$endif i386}
  500. end;
  501. end;
  502. {$ifdef i386}
  503. if assigned(p) then
  504. if cs_asm_source in aktglobalswitches then
  505. asml.insert(tai_comment.Create(strpnew(tostr(p.registersfpu)+
  506. ' registers on FPU stack used by temp. expressions')));
  507. {$endif i386}
  508. for i:=1 to maxfpuvarregs do
  509. begin
  510. if assigned(regvarinfo^.fpuregvars[i]) then
  511. begin
  512. if cs_asm_source in aktglobalswitches then
  513. asml.insert(tai_comment.Create(strpnew(regvarinfo^.fpuregvars[i].name+
  514. ' with weight '+tostr(regvarinfo^.fpuregvars[i].refs)+' assigned to register '+
  515. std_reg2str[regvarinfo^.fpuregvars[i].reg.enum])));
  516. if (status.verbosity and v_debug)=v_debug then
  517. Message3(cg_d_register_weight,std_reg2str[regvarinfo^.fpuregvars[i].reg.enum],
  518. tostr(regvarinfo^.fpuregvars[i].refs),regvarinfo^.fpuregvars[i].name);
  519. end;
  520. end;
  521. if cs_asm_source in aktglobalswitches then
  522. asml.insert(tai_comment.Create(strpnew('Register variable assignment:')));
  523. end;
  524. end;
  525. {$ifdef i386}
  526. procedure sync_regvars_other(list1, list2: taasmoutput; const regvarsloaded1,
  527. regvarsloaded2: regvarother_booleanarray);
  528. var
  529. counter: tregister;
  530. begin
  531. for counter.enum := low(rg.regvar_loaded_other) to high(rg.regvar_loaded_other) do
  532. begin
  533. rg.regvar_loaded_other[counter.enum] := regvarsloaded1[counter.enum] and
  534. regvarsloaded2[counter.enum];
  535. if regvarsloaded1[counter.enum] xor regvarsloaded2[counter.enum] then
  536. if regvarsloaded1[counter.enum] then
  537. load_regvar_reg(list2,counter)
  538. else
  539. load_regvar_reg(list1,counter);
  540. end;
  541. end;
  542. procedure sync_regvars_int(list1, list2: taasmoutput; const regvarsloaded1,
  543. regvarsloaded2: Tsupregset);
  544. var
  545. i : longint;
  546. r : tregister;
  547. begin
  548. for i:=1 to maxvarregs do
  549. begin
  550. r.enum:=R_INTREGISTER;
  551. r.number:=varregs[i] shl 8;
  552. if (varregs[i] in regvarsloaded1) and
  553. not(varregs[i] in regvarsloaded2) then
  554. load_regvar_reg(list2,r)
  555. else
  556. if (varregs[i] in regvarsloaded2) and
  557. not(varregs[i] in regvarsloaded1) then
  558. load_regvar_reg(list1,r);
  559. end;
  560. end;
  561. {$endif i386}
  562. procedure cleanup_regvars(asml: TAAsmoutput);
  563. var
  564. i: longint;
  565. r,reg : tregister;
  566. begin
  567. { can happen when inlining assembler procedures (JM) }
  568. if not assigned(current_procinfo.procdef.regvarinfo) then
  569. exit;
  570. if (cs_regvars in aktglobalswitches) and
  571. not(pi_uses_asm in current_procinfo.flags) and
  572. not(pi_uses_exceptions in current_procinfo.flags) then
  573. with pregvarinfo(current_procinfo.procdef.regvarinfo)^ do
  574. begin
  575. {$ifdef i386}
  576. r.enum:=R_ST0;
  577. for i:=1 to maxfpuvarregs do
  578. if assigned(fpuregvars[i]) then
  579. { ... and clean it up }
  580. asml.concat(Taicpu.op_reg(A_FSTP,S_NO,r));
  581. {$endif i386}
  582. for i := 1 to maxvarregs do
  583. begin
  584. if assigned(regvars[i]) then
  585. begin
  586. reg:=regvars[i].reg;
  587. if reg.enum=R_INTREGISTER then
  588. begin
  589. {$ifndef newra}
  590. if (reg.number shr 8 in rg.regvar_loaded_int) then
  591. asml.concat(tai_regalloc.dealloc(reg));
  592. {$endif newra}
  593. end
  594. else
  595. begin
  596. reg.number:=(reg.number and not $ff) or cgsize2subreg(OS_INT);
  597. r:=reg;
  598. convert_register_to_enum(r);
  599. {$ifndef notranslation}
  600. if r.enum>lastreg then
  601. internalerror(200201081);
  602. if (rg.regvar_loaded_other[r.enum]) then
  603. asml.concat(tai_regalloc.dealloc(reg));
  604. {$endif notranslation}
  605. end;
  606. end;
  607. end;
  608. end;
  609. end;
  610. {$ifdef newra}
  611. procedure free_regvars(list: taasmoutput);
  612. var
  613. i: longint;
  614. begin
  615. if not assigned(current_procinfo.procdef.regvarinfo) then
  616. exit;
  617. with pregvarinfo(current_procinfo.procdef.regvarinfo)^ do
  618. for i := 1 to maxvarregs do
  619. if assigned(regvars[i]) { and
  620. (regvars[i] <> tvarsym(current_procinfo.procdef.funcretsym))} then
  621. begin
  622. { make sure the unget isn't just a nop }
  623. exclude(rg.is_reg_var_int,regvars[i].reg.number shr 8);
  624. rg.ungetregisterint(list,regvars[i].reg);
  625. end;
  626. end;
  627. procedure translate_regvars(list: taasmoutput; const table:Ttranstable);
  628. var
  629. i: longint;
  630. r: tregister;
  631. begin
  632. {$ifndef notranslation}
  633. if not assigned(current_procinfo.procdef.regvarinfo) then
  634. exit;
  635. with pregvarinfo(current_procinfo.procdef.regvarinfo)^ do
  636. for i := 1 to maxvarregs do
  637. if assigned(regvars[i]) { and
  638. (regvars[i] <> tvarsym(current_procinfo.procdef.funcretsym))} then
  639. begin
  640. regvars[i].reg.number :=
  641. (regvars[i].reg.number and $ff) or
  642. (table[regvars[i].reg.number shr 8] shl 8);
  643. r:=regvars[i].reg;
  644. convert_register_to_enum(r);
  645. if cs_asm_source in aktglobalswitches then
  646. list.insert(tai_comment.Create(strpnew(regvars[i].name+
  647. ' with weight '+tostr(regvars[i].refs)+' assigned to register '+
  648. std_reg2str[r.enum])));
  649. Message3(cg_d_register_weight,std_reg2str[r.enum],
  650. tostr(regvars[i].refs),regvars[i].name);
  651. end;
  652. {$endif notranslation}
  653. end;
  654. {$endif newra}
  655. end.
  656. {
  657. $Log$
  658. Revision 1.61 2003-08-17 16:59:20 jonas
  659. * fixed regvars so they work with newra (at least for ppc)
  660. * fixed some volatile register bugs
  661. + -dnotranslation option for -dnewra, which causes the registers not to
  662. be translated from virtual to normal registers. Requires support in
  663. the assembler writer as well, which is only implemented in aggas/
  664. agppcgas currently
  665. Revision 1.60 2003/08/11 21:18:20 peter
  666. * start of sparc support for newra
  667. Revision 1.59 2003/08/09 18:56:54 daniel
  668. * cs_regalloc renamed to cs_regvars to avoid confusion with register
  669. allocator
  670. * Some preventive changes to i386 spillinh code
  671. Revision 1.58 2003/07/02 22:18:04 peter
  672. * paraloc splitted in callerparaloc,calleeparaloc
  673. * sparc calling convention updates
  674. Revision 1.57 2003/06/13 21:19:31 peter
  675. * current_procdef removed, use current_procinfo.procdef instead
  676. Revision 1.56 2003/06/07 18:57:04 jonas
  677. + added freeintparaloc
  678. * ppc get/freeintparaloc now check whether the parameter regs are
  679. properly allocated/deallocated (and get an extra list para)
  680. * ppc a_call_* now internalerrors if pi_do_call is not yet set
  681. * fixed lot of missing pi_do_call's
  682. Revision 1.55 2003/06/03 21:11:09 peter
  683. * cg.a_load_* get a from and to size specifier
  684. * makeregsize only accepts newregister
  685. * i386 uses generic tcgnotnode,tcgunaryminus
  686. Revision 1.54 2003/06/03 13:01:59 daniel
  687. * Register allocator finished
  688. Revision 1.53 2003/05/31 20:33:57 jonas
  689. * temp fix/hack for nested procedures (disable regvars in all procedures
  690. that have nested procedures)
  691. * leave register parameters in their own register (instead of storing
  692. them to memory or assigning them to another register) if the current
  693. procedure doesn't call any other procedures
  694. Revision 1.52 2003/05/30 18:55:21 jonas
  695. * fixed several regvar related bugs for non-i386. make cycle with -Or now
  696. works for ppc
  697. Revision 1.51 2003/05/23 14:27:35 peter
  698. * remove some unit dependencies
  699. * current_procinfo changes to store more info
  700. Revision 1.50 2003/05/16 14:33:31 peter
  701. * regvar fixes
  702. Revision 1.49 2003/05/15 18:58:53 peter
  703. * removed selfpointer_offset, vmtpointer_offset
  704. * tvarsym.adjusted_address
  705. * address in localsymtable is now in the real direction
  706. * removed some obsolete globals
  707. Revision 1.48 2003/05/12 17:22:00 jonas
  708. * fixed (last?) remaining -tvarsym(X).address to
  709. tg.direction*tvarsym(X).address...
  710. Revision 1.47 2003/04/27 11:21:34 peter
  711. * aktprocdef renamed to current_procinfo.procdef
  712. * procinfo renamed to current_procinfo
  713. * procinfo will now be stored in current_module so it can be
  714. cleaned up properly
  715. * gen_main_procsym changed to create_main_proc and release_main_proc
  716. to also generate a tprocinfo structure
  717. * fixed unit implicit initfinal
  718. Revision 1.46 2003/03/28 19:16:57 peter
  719. * generic constructor working for i386
  720. * remove fixed self register
  721. * esi added as address register for i386
  722. Revision 1.45 2003/02/19 22:00:14 daniel
  723. * Code generator converted to new register notation
  724. - Horribily outdated todo.txt removed
  725. Revision 1.44 2003/01/08 18:43:57 daniel
  726. * Tregister changed into a record
  727. Revision 1.43 2002/11/25 17:43:24 peter
  728. * splitted defbase in defutil,symutil,defcmp
  729. * merged isconvertable and is_equal into compare_defs(_ext)
  730. * made operator search faster by walking the list only once
  731. Revision 1.42 2002/11/18 17:31:59 peter
  732. * pass proccalloption to ret_in_xxx and push_xxx functions
  733. Revision 1.41 2002/08/25 19:25:20 peter
  734. * sym.insert_in_data removed
  735. * symtable.insertvardata/insertconstdata added
  736. * removed insert_in_data call from symtable.insert, it needs to be
  737. called separatly. This allows to deref the address calculation
  738. * procedures now calculate the parast addresses after the procedure
  739. directives are parsed. This fixes the cdecl parast problem
  740. * push_addr_param has an extra argument that specifies if cdecl is used
  741. or not
  742. Revision 1.40 2002/08/18 20:06:25 peter
  743. * inlining is now also allowed in interface
  744. * renamed write/load to ppuwrite/ppuload
  745. * tnode storing in ppu
  746. * nld,ncon,nbas are already updated for storing in ppu
  747. Revision 1.39 2002/08/17 09:23:41 florian
  748. * first part of procinfo rewrite
  749. Revision 1.38 2002/08/06 20:55:22 florian
  750. * first part of ppc calling conventions fix
  751. Revision 1.37 2002/07/20 11:57:57 florian
  752. * types.pas renamed to defbase.pas because D6 contains a types
  753. unit so this would conflicts if D6 programms are compiled
  754. + Willamette/SSE2 instructions to assembler added
  755. Revision 1.36 2002/07/11 14:41:30 florian
  756. * start of the new generic parameter handling
  757. Revision 1.35 2002/07/01 18:46:25 peter
  758. * internal linker
  759. * reorganized aasm layer
  760. Revision 1.34 2002/06/24 12:43:00 jonas
  761. * fixed errors found with new -CR code from Peter when cycling with -O2p3r
  762. Revision 1.33 2002/05/18 13:34:17 peter
  763. * readded missing revisions
  764. Revision 1.32 2002/05/16 19:46:44 carl
  765. + defines.inc -> fpcdefs.inc to avoid conflicts if compiling by hand
  766. + try to fix temp allocation (still in ifdef)
  767. + generic constructor calls
  768. + start of tassembler / tmodulebase class cleanup
  769. Revision 1.30 2002/05/12 16:53:10 peter
  770. * moved entry and exitcode to ncgutil and cgobj
  771. * foreach gets extra argument for passing local data to the
  772. iterator function
  773. * -CR checks also class typecasts at runtime by changing them
  774. into as
  775. * fixed compiler to cycle with the -CR option
  776. * fixed stabs with elf writer, finally the global variables can
  777. be watched
  778. * removed a lot of routines from cga unit and replaced them by
  779. calls to cgobj
  780. * u32bit-s32bit updates for and,or,xor nodes. When one element is
  781. u32bit then the other is typecasted also to u32bit without giving
  782. a rangecheck warning/error.
  783. * fixed pascal calling method with reversing also the high tree in
  784. the parast, detected by tcalcst3 test
  785. Revision 1.29 2002/04/21 15:23:34 carl
  786. + changeregsize -> makeregsize
  787. Revision 1.28 2002/04/19 15:46:03 peter
  788. * mangledname rewrite, tprocdef.mangledname is now created dynamicly
  789. in most cases and not written to the ppu
  790. * add mangeledname_prefix() routine to generate the prefix of
  791. manglednames depending on the current procedure, object and module
  792. * removed static procprefix since the mangledname is now build only
  793. on demand from tprocdef.mangledname
  794. Revision 1.27 2002/04/15 19:44:19 peter
  795. * fixed stackcheck that would be called recursively when a stack
  796. error was found
  797. * generic changeregsize(reg,size) for i386 register resizing
  798. * removed some more routines from cga unit
  799. * fixed returnvalue handling
  800. * fixed default stacksize of linux and go32v2, 8kb was a bit small :-)
  801. Revision 1.26 2002/04/15 19:04:04 carl
  802. + reg2str -> std_reg2str()
  803. Revision 1.25 2002/04/06 18:13:01 jonas
  804. * several powerpc-related additions and fixes
  805. Revision 1.24 2002/04/02 17:11:29 peter
  806. * tlocation,treference update
  807. * LOC_CONSTANT added for better constant handling
  808. * secondadd splitted in multiple routines
  809. * location_force_reg added for loading a location to a register
  810. of a specified size
  811. * secondassignment parses now first the right and then the left node
  812. (this is compatible with Kylix). This saves a lot of push/pop especially
  813. with string operations
  814. * adapted some routines to use the new cg methods
  815. Revision 1.23 2002/03/31 20:26:36 jonas
  816. + a_loadfpu_* and a_loadmm_* methods in tcg
  817. * register allocation is now handled by a class and is mostly processor
  818. independent (+rgobj.pas and i386/rgcpu.pas)
  819. * temp allocation is now handled by a class (+tgobj.pas, -i386\tgcpu.pas)
  820. * some small improvements and fixes to the optimizer
  821. * some register allocation fixes
  822. * some fpuvaroffset fixes in the unary minus node
  823. * push/popusedregisters is now called rg.save/restoreusedregisters and
  824. (for i386) uses temps instead of push/pop's when using -Op3 (that code is
  825. also better optimizable)
  826. * fixed and optimized register saving/restoring for new/dispose nodes
  827. * LOC_FPU locations now also require their "register" field to be set to
  828. R_ST, not R_ST0 (the latter is used for LOC_CFPUREGISTER locations only)
  829. - list field removed of the tnode class because it's not used currently
  830. and can cause hard-to-find bugs
  831. }