regvars.pas 31 KB

123456789101112131415161718192021222324252627282930313233343536373839404142434445464748495051525354555657585960616263646566676869707172737475767778798081828384858687888990919293949596979899100101102103104105106107108109110111112113114115116117118119120121122123124125126127128129130131132133134135136137138139140141142143144145146147148149150151152153154155156157158159160161162163164165166167168169170171172173174175176177178179180181182183184185186187188189190191192193194195196197198199200201202203204205206207208209210211212213214215216217218219220221222223224225226227228229230231232233234235236237238239240241242243244245246247248249250251252253254255256257258259260261262263264265266267268269270271272273274275276277278279280281282283284285286287288289290291292293294295296297298299300301302303304305306307308309310311312313314315316317318319320321322323324325326327328329330331332333334335336337338339340341342343344345346347348349350351352353354355356357358359360361362363364365366367368369370371372373374375376377378379380381382383384385386387388389390391392393394395396397398399400401402403404405406407408409410411412413414415416417418419420421422423424425426427428429430431432433434435436437438439440441442443444445446447448449450451452453454455456457458459460461462463464465466467468469470471472473474475476477478479480481482483484485486487488489490491492493494495496497498499500501502503504505506507508509510511512513514515516517518519520521522523524525526527528529530531532533534535536537538539540541542543544545546547548549550551552553554555556557558559560561562563564565566567568569570571572573574575576577578579580581582583584585586587588589590591592593594595596597598599600601602603604605606607608609610611612613614615616617618619620621622623624625626627628629630631632633634635636637638639640641642643644645646647648649650651652653654655656657658659660661662663664665666667668669670671672673674675676677678679680681682683684685686687688689690691692693694695696697698699700701702703704705706707708709710711712713714715716717718719720721722723724725726727728729730731732733734735736737738739740741742743744745746747748749750751752753754755756757758759760761762763764765766767768769770771772773774775776777778779780781782783784785786787788789790791792793794795796797798799800801802803804805806807
  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_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_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_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_procdef.para.first);
  167. while assigned(hp) do
  168. begin
  169. if (hp.paraloc.loc in [LOC_REGISTER,LOC_FPUREGISTER,
  170. LOC_CREGISTER,LOC_CFPUREGISTER]) and
  171. (TCGSize2Size[hp.paraloc.size] <= sizeof(aword)) then
  172. begin
  173. tvarsym(hp.parasym).reg := hp.paraloc.register;
  174. if (hp.paraloc.loc in [LOC_REGISTER,LOC_CREGISTER]) then
  175. rg.makeregvarint(hp.paraloc.register.number shr 8)
  176. else
  177. rg.makeregvarother(hp.paraloc.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_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.usedintinproc,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_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_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_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_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_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_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_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_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.56 2003-06-07 18:57:04 jonas
  585. + added freeintparaloc
  586. * ppc get/freeintparaloc now check whether the parameter regs are
  587. properly allocated/deallocated (and get an extra list para)
  588. * ppc a_call_* now internalerrors if pi_do_call is not yet set
  589. * fixed lot of missing pi_do_call's
  590. Revision 1.55 2003/06/03 21:11:09 peter
  591. * cg.a_load_* get a from and to size specifier
  592. * makeregsize only accepts newregister
  593. * i386 uses generic tcgnotnode,tcgunaryminus
  594. Revision 1.54 2003/06/03 13:01:59 daniel
  595. * Register allocator finished
  596. Revision 1.53 2003/05/31 20:33:57 jonas
  597. * temp fix/hack for nested procedures (disable regvars in all procedures
  598. that have nested procedures)
  599. * leave register parameters in their own register (instead of storing
  600. them to memory or assigning them to another register) if the current
  601. procedure doesn't call any other procedures
  602. Revision 1.52 2003/05/30 18:55:21 jonas
  603. * fixed several regvar related bugs for non-i386. make cycle with -Or now
  604. works for ppc
  605. Revision 1.51 2003/05/23 14:27:35 peter
  606. * remove some unit dependencies
  607. * current_procinfo changes to store more info
  608. Revision 1.50 2003/05/16 14:33:31 peter
  609. * regvar fixes
  610. Revision 1.49 2003/05/15 18:58:53 peter
  611. * removed selfpointer_offset, vmtpointer_offset
  612. * tvarsym.adjusted_address
  613. * address in localsymtable is now in the real direction
  614. * removed some obsolete globals
  615. Revision 1.48 2003/05/12 17:22:00 jonas
  616. * fixed (last?) remaining -tvarsym(X).address to
  617. tg.direction*tvarsym(X).address...
  618. Revision 1.47 2003/04/27 11:21:34 peter
  619. * aktprocdef renamed to current_procdef
  620. * procinfo renamed to current_procinfo
  621. * procinfo will now be stored in current_module so it can be
  622. cleaned up properly
  623. * gen_main_procsym changed to create_main_proc and release_main_proc
  624. to also generate a tprocinfo structure
  625. * fixed unit implicit initfinal
  626. Revision 1.46 2003/03/28 19:16:57 peter
  627. * generic constructor working for i386
  628. * remove fixed self register
  629. * esi added as address register for i386
  630. Revision 1.45 2003/02/19 22:00:14 daniel
  631. * Code generator converted to new register notation
  632. - Horribily outdated todo.txt removed
  633. Revision 1.44 2003/01/08 18:43:57 daniel
  634. * Tregister changed into a record
  635. Revision 1.43 2002/11/25 17:43:24 peter
  636. * splitted defbase in defutil,symutil,defcmp
  637. * merged isconvertable and is_equal into compare_defs(_ext)
  638. * made operator search faster by walking the list only once
  639. Revision 1.42 2002/11/18 17:31:59 peter
  640. * pass proccalloption to ret_in_xxx and push_xxx functions
  641. Revision 1.41 2002/08/25 19:25:20 peter
  642. * sym.insert_in_data removed
  643. * symtable.insertvardata/insertconstdata added
  644. * removed insert_in_data call from symtable.insert, it needs to be
  645. called separatly. This allows to deref the address calculation
  646. * procedures now calculate the parast addresses after the procedure
  647. directives are parsed. This fixes the cdecl parast problem
  648. * push_addr_param has an extra argument that specifies if cdecl is used
  649. or not
  650. Revision 1.40 2002/08/18 20:06:25 peter
  651. * inlining is now also allowed in interface
  652. * renamed write/load to ppuwrite/ppuload
  653. * tnode storing in ppu
  654. * nld,ncon,nbas are already updated for storing in ppu
  655. Revision 1.39 2002/08/17 09:23:41 florian
  656. * first part of procinfo rewrite
  657. Revision 1.38 2002/08/06 20:55:22 florian
  658. * first part of ppc calling conventions fix
  659. Revision 1.37 2002/07/20 11:57:57 florian
  660. * types.pas renamed to defbase.pas because D6 contains a types
  661. unit so this would conflicts if D6 programms are compiled
  662. + Willamette/SSE2 instructions to assembler added
  663. Revision 1.36 2002/07/11 14:41:30 florian
  664. * start of the new generic parameter handling
  665. Revision 1.35 2002/07/01 18:46:25 peter
  666. * internal linker
  667. * reorganized aasm layer
  668. Revision 1.34 2002/06/24 12:43:00 jonas
  669. * fixed errors found with new -CR code from Peter when cycling with -O2p3r
  670. Revision 1.33 2002/05/18 13:34:17 peter
  671. * readded missing revisions
  672. Revision 1.32 2002/05/16 19:46:44 carl
  673. + defines.inc -> fpcdefs.inc to avoid conflicts if compiling by hand
  674. + try to fix temp allocation (still in ifdef)
  675. + generic constructor calls
  676. + start of tassembler / tmodulebase class cleanup
  677. Revision 1.30 2002/05/12 16:53:10 peter
  678. * moved entry and exitcode to ncgutil and cgobj
  679. * foreach gets extra argument for passing local data to the
  680. iterator function
  681. * -CR checks also class typecasts at runtime by changing them
  682. into as
  683. * fixed compiler to cycle with the -CR option
  684. * fixed stabs with elf writer, finally the global variables can
  685. be watched
  686. * removed a lot of routines from cga unit and replaced them by
  687. calls to cgobj
  688. * u32bit-s32bit updates for and,or,xor nodes. When one element is
  689. u32bit then the other is typecasted also to u32bit without giving
  690. a rangecheck warning/error.
  691. * fixed pascal calling method with reversing also the high tree in
  692. the parast, detected by tcalcst3 test
  693. Revision 1.29 2002/04/21 15:23:34 carl
  694. + changeregsize -> makeregsize
  695. Revision 1.28 2002/04/19 15:46:03 peter
  696. * mangledname rewrite, tprocdef.mangledname is now created dynamicly
  697. in most cases and not written to the ppu
  698. * add mangeledname_prefix() routine to generate the prefix of
  699. manglednames depending on the current procedure, object and module
  700. * removed static procprefix since the mangledname is now build only
  701. on demand from tprocdef.mangledname
  702. Revision 1.27 2002/04/15 19:44:19 peter
  703. * fixed stackcheck that would be called recursively when a stack
  704. error was found
  705. * generic changeregsize(reg,size) for i386 register resizing
  706. * removed some more routines from cga unit
  707. * fixed returnvalue handling
  708. * fixed default stacksize of linux and go32v2, 8kb was a bit small :-)
  709. Revision 1.26 2002/04/15 19:04:04 carl
  710. + reg2str -> std_reg2str()
  711. Revision 1.25 2002/04/06 18:13:01 jonas
  712. * several powerpc-related additions and fixes
  713. Revision 1.24 2002/04/02 17:11:29 peter
  714. * tlocation,treference update
  715. * LOC_CONSTANT added for better constant handling
  716. * secondadd splitted in multiple routines
  717. * location_force_reg added for loading a location to a register
  718. of a specified size
  719. * secondassignment parses now first the right and then the left node
  720. (this is compatible with Kylix). This saves a lot of push/pop especially
  721. with string operations
  722. * adapted some routines to use the new cg methods
  723. Revision 1.23 2002/03/31 20:26:36 jonas
  724. + a_loadfpu_* and a_loadmm_* methods in tcg
  725. * register allocation is now handled by a class and is mostly processor
  726. independent (+rgobj.pas and i386/rgcpu.pas)
  727. * temp allocation is now handled by a class (+tgobj.pas, -i386\tgcpu.pas)
  728. * some small improvements and fixes to the optimizer
  729. * some register allocation fixes
  730. * some fpuvaroffset fixes in the unary minus node
  731. * push/popusedregisters is now called rg.save/restoreusedregisters and
  732. (for i386) uses temps instead of push/pop's when using -Op3 (that code is
  733. also better optimizable)
  734. * fixed and optimized register saving/restoring for new/dispose nodes
  735. * LOC_FPU locations now also require their "register" field to be set to
  736. R_ST, not R_ST0 (the latter is used for LOC_CFPUREGISTER locations only)
  737. - list field removed of the tnode class because it's not used currently
  738. and can cause hard-to-find bugs
  739. }