regvars.pas 31 KB

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