regvars.pas 31 KB

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