regvars.pas 32 KB

123456789101112131415161718192021222324252627282930313233343536373839404142434445464748495051525354555657585960616263646566676869707172737475767778798081828384858687888990919293949596979899100101102103104105106107108109110111112113114115116117118119120121122123124125126127128129130131132133134135136137138139140141142143144145146147148149150151152153154155156157158159160161162163164165166167168169170171172173174175176177178179180181182183184185186187188189190191192193194195196197198199200201202203204205206207208209210211212213214215216217218219220221222223224225226227228229230231232233234235236237238239240241242243244245246247248249250251252253254255256257258259260261262263264265266267268269270271272273274275276277278279280281282283284285286287288289290291292293294295296297298299300301302303304305306307308309310311312313314315316317318319320321322323324325326327328329330331332333334335336337338339340341342343344345346347348349350351352353354355356357358359360361362363364365366367368369370371372373374375376377378379380381382383384385386387388389390391392393394395396397398399400401402403404405406407408409410411412413414415416417418419420421422423424425426427428429430431432433434435436437438439440441442443444445446447448449450451452453454455456457458459460461462463464465466467468469470471472473474475476477478479480481482483484485486487488489490491492493494495496497498499500501502503504505506507508509510511512513514515516517518519520521522523524525526527528529530531532533534535536537538539540541542543544545546547548549550551552553554555556557558559560561562563564565566567568569570571572573574575576577578579580581582583584585586587588589590591592593594595596597598599600601602603604605606607608609610611612613614615616617618619620621622623624625626627628629630631632633634635636637638639640641642643644645646647648649650651652653654655656657658659660661662663664665666667668669670671672673674675676677678679680681682683684685686687688689690691692693694695696697698699700701702703704705706707708709710711712713714715716717718719720721722723724725726727728729730731732733734735736737738739740741742743744745746747748749750751752753754755756757758759760761762763764765766767768769770771772773774775776777778779780781782783784785786787788789790791792793794795796797798799800801802803804805806807808809810811812813814815816817818819820821822823824
  1. {
  2. $Id$
  3. Copyright (c) 1998-2000 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 defines.inc}
  20. interface
  21. uses
  22. aasm,
  23. {$ifdef CG11}
  24. node
  25. {$else CG11}
  26. tree
  27. {$endif CG11}
  28. ;
  29. {$ifdef CG11}
  30. procedure assign_regvars(p: tnode);
  31. procedure load_regvars(asml: paasmoutput; p: tnode);
  32. {$else CG11}
  33. procedure assign_regvars(p: ptree);
  34. procedure load_regvars(asml: paasmoutput; p: ptree);
  35. {$endif CG11}
  36. procedure cleanup_regvars(asml: paasmoutput);
  37. implementation
  38. uses
  39. globtype,systems,comphook,
  40. cutils,cobjects,verbose,globals,
  41. symconst,symtable,types,
  42. hcodegen,temp_gen,cpubase,cpuasm
  43. {$ifndef newcg}
  44. {$ifndef CG11}
  45. ,tcflw
  46. {$endif}
  47. {$endif newcg}
  48. {$ifdef GDB}
  49. ,gdb
  50. {$endif}
  51. {$ifdef i386}
  52. ,tgeni386,cgai386
  53. {$endif}
  54. {$ifdef m68k}
  55. ,tgen68k,cga68k
  56. {$endif}
  57. ;
  58. type
  59. pregvarinfo = ^tregvarinfo;
  60. tregvarinfo = record
  61. regvars : array[1..maxvarregs] of pvarsym;
  62. regvars_para : array[1..maxvarregs] of boolean;
  63. regvars_refs : array[1..maxvarregs] of longint;
  64. fpuregvars : array[1..maxfpuvarregs] of pvarsym;
  65. fpuregvars_para : array[1..maxfpuvarregs] of boolean;
  66. fpuregvars_refs : array[1..maxfpuvarregs] of longint;
  67. end;
  68. var
  69. parasym : boolean;
  70. procedure searchregvars(p : pnamedindexobject);
  71. var
  72. i,j,k : longint;
  73. begin
  74. if (psym(p)^.typ=varsym) and (vo_regable in pvarsym(p)^.varoptions) then
  75. begin
  76. j:=pvarsym(p)^.refs;
  77. { parameter get a less value }
  78. if parasym then
  79. begin
  80. if cs_littlesize in aktglobalswitches then
  81. dec(j,1)
  82. else
  83. dec(j,100);
  84. end;
  85. { walk through all momentary register variables }
  86. for i:=1 to maxvarregs do
  87. begin
  88. with pregvarinfo(aktprocsym^.definition^.regvarinfo)^ do
  89. if ((regvars[i]=nil) or (j>regvars_refs[i])) and (j>0) then
  90. begin
  91. for k:=maxvarregs-1 downto i do
  92. begin
  93. regvars[k+1]:=regvars[k];
  94. regvars_para[k+1]:=regvars_para[k];
  95. regvars_refs[k+1]:=regvars_refs[k];
  96. end;
  97. { calc the new refs
  98. pvarsym(p)^.refs:=j; }
  99. regvars[i]:=pvarsym(p);
  100. regvars_para[i]:=parasym;
  101. regvars_refs[i]:=j;
  102. break;
  103. end;
  104. end;
  105. end;
  106. end;
  107. procedure searchfpuregvars(p : pnamedindexobject);
  108. var
  109. i,j,k : longint;
  110. begin
  111. if (psym(p)^.typ=varsym) and (vo_fpuregable in pvarsym(p)^.varoptions) then
  112. begin
  113. j:=pvarsym(p)^.refs;
  114. { parameter get a less value }
  115. if parasym then
  116. begin
  117. if cs_littlesize in aktglobalswitches then
  118. dec(j,1)
  119. else
  120. dec(j,100);
  121. end;
  122. { walk through all momentary register variables }
  123. for i:=1 to maxfpuvarregs do
  124. begin
  125. with pregvarinfo(aktprocsym^.definition^.regvarinfo)^ do
  126. if ((fpuregvars[i]=nil) or (j>fpuregvars_refs[i])) and (j>0) then
  127. begin
  128. for k:=maxfpuvarregs-1 downto i do
  129. begin
  130. fpuregvars[k+1]:=fpuregvars[k];
  131. fpuregvars_para[k+1]:=fpuregvars_para[k];
  132. fpuregvars_refs[k+1]:=fpuregvars_refs[k];
  133. end;
  134. { calc the new refs
  135. pvarsym(p)^.refs:=j; }
  136. fpuregvars[i]:=pvarsym(p);
  137. fpuregvars_para[i]:=parasym;
  138. fpuregvars_refs[i]:=j;
  139. break;
  140. end;
  141. end;
  142. end;
  143. end;
  144. {$ifdef i386}
  145. function reg32(reg: tregister): tregister;
  146. begin
  147. case regsize(reg) of
  148. S_B: reg32 := reg8toreg32(reg);
  149. S_W: reg32 := reg16toreg32(reg);
  150. S_L: reg32 := reg;
  151. end;
  152. end;
  153. {$else i386}
  154. function reg32(reg: tregister): tregister;
  155. begin
  156. reg32 := reg;
  157. end;
  158. {$endif i386}
  159. {$ifdef CG11}
  160. procedure assign_regvars(p: tnode);
  161. { register variables }
  162. var
  163. regvarinfo: pregvarinfo;
  164. i: longint;
  165. begin
  166. { max. optimizations }
  167. { only if no asm is used }
  168. { and no try statement }
  169. if (cs_regalloc in aktglobalswitches) and
  170. ((procinfo^.flags and (pi_uses_asm or pi_uses_exceptions))=0) then
  171. begin
  172. new(regvarinfo);
  173. fillchar(regvarinfo^,sizeof(regvarinfo^),0);
  174. aktprocsym^.definition^.regvarinfo := regvarinfo;
  175. if (p.registers32<4) then
  176. begin
  177. parasym:=false;
  178. symtablestack^.foreach({$ifdef FPCPROCVAR}@{$endif}searchregvars);
  179. { copy parameter into a register ? }
  180. parasym:=true;
  181. symtablestack^.next^.foreach({$ifdef FPCPROCVAR}@{$endif}searchregvars);
  182. { hold needed registers free }
  183. for i:=maxvarregs downto maxvarregs-p.registers32+1 do
  184. begin
  185. regvarinfo^.regvars[i]:=nil;
  186. regvarinfo^.regvars_para[i] := false;
  187. end;
  188. { now assign register }
  189. for i:=1 to maxvarregs-p.registers32 do
  190. begin
  191. if assigned(regvarinfo^.regvars[i]) and
  192. (reg_pushes[varregs[i]] < regvarinfo^.regvars[i]^.refs) then
  193. begin
  194. { register is no longer available for }
  195. { expressions }
  196. { search the register which is the most }
  197. { unused }
  198. usableregs:=usableregs-[varregs[i]];
  199. is_reg_var[varregs[i]]:=true;
  200. dec(c_usableregs);
  201. { possibly no 32 bit register are needed }
  202. { call by reference/const ? }
  203. if (regvarinfo^.regvars[i]^.varspez=vs_var) or
  204. ((regvarinfo^.regvars[i]^.varspez=vs_const) and
  205. push_addr_param(regvarinfo^.regvars[i]^.vartype.def)) then
  206. begin
  207. regvarinfo^.regvars[i]^.reg:=varregs[i];
  208. end
  209. else
  210. if (regvarinfo^.regvars[i]^.vartype.def^.deftype in [orddef,enumdef]) and
  211. (porddef(regvarinfo^.regvars[i]^.vartype.def)^.size=1) then
  212. begin
  213. {$ifdef i386}
  214. regvarinfo^.regvars[i]^.reg:=reg32toreg8(varregs[i]);
  215. {$endif}
  216. end
  217. else
  218. if (regvarinfo^.regvars[i]^.vartype.def^.deftype in [orddef,enumdef]) and
  219. (porddef(regvarinfo^.regvars[i]^.vartype.def)^.size=2) then
  220. begin
  221. {$ifdef i386}
  222. regvarinfo^.regvars[i]^.reg:=reg32toreg16(varregs[i]);
  223. {$endif}
  224. end
  225. else
  226. begin
  227. regvarinfo^.regvars[i]^.reg:=varregs[i];
  228. end;
  229. if regvarinfo^.regvars_para[i] then
  230. unused:=unused - [regvarinfo^.regvars[i]^.reg];
  231. { procedure uses this register }
  232. {$ifdef i386}
  233. usedinproc:=usedinproc or ($80 shr byte(varregs[i]));
  234. {$endif i386}
  235. {$ifdef m68k}
  236. usedinproc:=usedinproc or ($800 shr word(varregs[i]));
  237. {$endif m68k}
  238. end
  239. else
  240. begin
  241. regvarinfo^.regvars[i] := nil;
  242. regvarinfo^.regvars_para[i] := false;
  243. end;
  244. end;
  245. end;
  246. if ((p.registersfpu+1)<maxfpuvarregs) then
  247. begin
  248. parasym:=false;
  249. symtablestack^.foreach({$ifdef FPCPROCVAR}@{$endif}searchfpuregvars);
  250. {$ifdef dummy}
  251. { copy parameter into a register ? }
  252. parasym:=true;
  253. symtablestack^.next^.foreach({$ifdef FPCPROCVAR}@{$endif}searchregvars);
  254. {$endif dummy}
  255. { hold needed registers free }
  256. { in non leaf procedures we must be very careful }
  257. { with assigning registers }
  258. if aktmaxfpuregisters=-1 then
  259. begin
  260. if (procinfo^.flags and pi_do_call)<>0 then
  261. begin
  262. for i:=maxfpuvarregs downto 2 do
  263. regvarinfo^.fpuregvars[i]:=nil;
  264. end
  265. else
  266. begin
  267. for i:=maxfpuvarregs downto maxfpuvarregs-p.registersfpu do
  268. regvarinfo^.fpuregvars[i]:=nil;
  269. end;
  270. end
  271. else
  272. begin
  273. for i:=aktmaxfpuregisters+1 to maxfpuvarregs do
  274. regvarinfo^.fpuregvars[i]:=nil;
  275. end;
  276. { now assign register }
  277. for i:=1 to maxfpuvarregs do
  278. begin
  279. if assigned(regvarinfo^.fpuregvars[i]) then
  280. begin
  281. {$ifdef i386}
  282. { reserve place on the FPU stack }
  283. regvarinfo^.fpuregvars[i]^.reg:=correct_fpuregister(R_ST0,i-1);
  284. {$endif i386}
  285. {$ifdef m68k}
  286. regvarinfo^.fpuregvars[i]^.reg:=fpuvarregs[i];
  287. {$endif m68k}
  288. end;
  289. end;
  290. end;
  291. end;
  292. end;
  293. procedure load_regvars(asml: paasmoutput; p: tnode);
  294. var
  295. i: longint;
  296. hr : preference;
  297. regvarinfo: pregvarinfo;
  298. {$ifdef i386}
  299. opsize: topsize;
  300. opcode: tasmop;
  301. signed: boolean;
  302. {$endif i386}
  303. begin
  304. if (cs_regalloc in aktglobalswitches) and
  305. ((procinfo^.flags and (pi_uses_asm or pi_uses_exceptions))=0) then
  306. begin
  307. regvarinfo := pregvarinfo(aktprocsym^.definition^.regvarinfo);
  308. { can happen when inlining assembler procedures (JM) }
  309. if not assigned(regvarinfo) then
  310. exit;
  311. for i:=1 to maxvarregs do
  312. begin
  313. { parameter must be load }
  314. if regvarinfo^.regvars_para[i] then
  315. begin
  316. {$ifdef i386}
  317. asml^.concat(new(pairegalloc,alloc(reg32(regvarinfo^.regvars[i]^.reg))));
  318. {$endif i386}
  319. { procinfo is there actual, }
  320. { because we can't never be in a }
  321. { nested procedure }
  322. { when loading parameter to reg }
  323. new(hr);
  324. reset_reference(hr^);
  325. hr^.offset:=pvarsym(regvarinfo^.regvars[i])^.address+procinfo^.para_offset;
  326. hr^.base:=procinfo^.framepointer;
  327. {$ifdef i386}
  328. { zero the regvars because the upper 48bits must be clear }
  329. { for 8bits vars when using them with btrl (JM) }
  330. signed :=
  331. (pvarsym(regvarinfo^.regvars[i])^.vartype.def^.deftype =
  332. orddef) and
  333. is_signed(pvarsym(regvarinfo^.regvars[i])^.vartype.def);
  334. case regsize(regvarinfo^.regvars[i]^.reg) of
  335. S_L:
  336. begin
  337. opsize := S_L;
  338. opcode := A_MOV;
  339. end;
  340. S_W:
  341. begin
  342. opsize := S_WL;
  343. if signed then
  344. opcode := A_MOVSX
  345. else opcode := A_MOVZX;
  346. end;
  347. S_B:
  348. begin
  349. opsize := S_BL;
  350. if signed then
  351. opcode := A_MOVSX
  352. else opcode := A_MOVZX;
  353. end;
  354. end;
  355. asml^.concat(new(paicpu,op_ref_reg(opcode,opsize,
  356. hr,reg32(regvarinfo^.regvars[i]^.reg))));
  357. {$endif i386}
  358. {$ifdef m68k}
  359. asml^.concat(new(paicpu,op_ref_reg(A_MOVE,regsize(regvarinfo^.regvars[i]^.reg),
  360. hr,regvarinfo^.regvars[i]^.reg)));
  361. {$endif m68k}
  362. end
  363. end;
  364. for i:=1 to maxvarregs do
  365. begin
  366. if assigned(regvarinfo^.regvars[i]) then
  367. begin
  368. {$ifdef i386}
  369. if not(regvarinfo^.regvars_para[i]) then
  370. begin
  371. asml^.concat(new(pairegalloc,alloc(reg32(regvarinfo^.regvars[i]^.reg))));
  372. { zero the regvars because the upper 48bits must be clear }
  373. { for 8bits vars when using them with btrl (JM) }
  374. if (regsize(regvarinfo^.regvars[i]^.reg) in [S_B,S_W]) then
  375. asml^.concat(new(paicpu,op_reg_reg(A_XOR,S_L,
  376. reg32(regvarinfo^.regvars[i]^.reg),
  377. reg32(regvarinfo^.regvars[i]^.reg))));
  378. end;
  379. {$endif i386}
  380. if cs_asm_source in aktglobalswitches then
  381. asml^.insert(new(pai_asm_comment,init(strpnew(regvarinfo^.regvars[i]^.name+
  382. ' with weight '+tostr(regvarinfo^.regvars[i]^.refs)+' assigned to register '+
  383. reg2str(regvarinfo^.regvars[i]^.reg)))));
  384. if (status.verbosity and v_debug)=v_debug then
  385. Message3(cg_d_register_weight,reg2str(regvarinfo^.regvars[i]^.reg),
  386. tostr(regvarinfo^.regvars[i]^.refs),regvarinfo^.regvars[i]^.name);
  387. end;
  388. end;
  389. for i:=1 to maxfpuvarregs do
  390. begin
  391. if assigned(regvarinfo^.fpuregvars[i]) then
  392. begin
  393. {$ifdef i386}
  394. { reserve place on the FPU stack }
  395. regvarinfo^.fpuregvars[i]^.reg:=correct_fpuregister(R_ST0,i-1);
  396. asml^.concat(new(paicpu,op_none(A_FLDZ,S_NO)));
  397. {$endif i386}
  398. {$ifdef dummy}
  399. { parameter must be load }
  400. if regvarinfo^.fpuregvars_para[i] then
  401. begin
  402. { procinfo is there actual, }
  403. { because we can't never be in a }
  404. { nested procedure }
  405. { when loading parameter to reg }
  406. new(hr);
  407. reset_reference(hr^);
  408. hr^.offset:=pvarsym(regvarinfo^.regvars[i])^.address+procinfo^.para_offset;
  409. hr^.base:=procinfo^.framepointer;
  410. {$ifdef i386}
  411. asml^.concat(new(paicpu,op_ref_reg(A_MOV,regsize(regvarinfo^.regvars[i]^.reg),
  412. hr,regvarinfo^.regvars[i]^.reg)));
  413. {$endif i386}
  414. {$ifdef m68k}
  415. asml^.concat(new(paicpu,op_ref_reg(A_MOVE,regsize(regvarinfo^.regvars[i]^.reg),
  416. hr,regvarinfo^.regvars[i]^.reg)));
  417. {$endif m68k}
  418. end;
  419. {$endif dummy}
  420. end;
  421. end;
  422. if assigned(p) then
  423. if cs_asm_source in aktglobalswitches then
  424. asml^.insert(new(pai_asm_comment,init(strpnew(tostr(p.registersfpu)+
  425. ' registers on FPU stack used by temp. expressions'))));
  426. for i:=1 to maxfpuvarregs do
  427. begin
  428. if assigned(regvarinfo^.fpuregvars[i]) then
  429. begin
  430. if cs_asm_source in aktglobalswitches then
  431. asml^.insert(new(pai_asm_comment,init(strpnew(regvarinfo^.fpuregvars[i]^.name+
  432. ' with weight '+tostr(regvarinfo^.fpuregvars[i]^.refs)+' assigned to register '+
  433. reg2str(regvarinfo^.fpuregvars[i]^.reg)))));
  434. if (status.verbosity and v_debug)=v_debug then
  435. Message3(cg_d_register_weight,reg2str(regvarinfo^.fpuregvars[i]^.reg),
  436. tostr(regvarinfo^.fpuregvars[i]^.refs),regvarinfo^.fpuregvars[i]^.name);
  437. end;
  438. end;
  439. if cs_asm_source in aktglobalswitches then
  440. asml^.insert(new(pai_asm_comment,init(strpnew('Register variable assignment:'))));
  441. end;
  442. end;
  443. {$else CG11}
  444. procedure assign_regvars(p: ptree);
  445. { register variables }
  446. var
  447. regvarinfo: pregvarinfo;
  448. i: longint;
  449. begin
  450. { max. optimizations }
  451. { only if no asm is used }
  452. { and no try statement }
  453. if (cs_regalloc in aktglobalswitches) and
  454. ((procinfo^.flags and (pi_uses_asm or pi_uses_exceptions))=0) then
  455. begin
  456. new(regvarinfo);
  457. fillchar(regvarinfo^,sizeof(regvarinfo^),0);
  458. aktprocsym^.definition^.regvarinfo := regvarinfo;
  459. if (p^.registers32<4) then
  460. begin
  461. parasym:=false;
  462. symtablestack^.foreach({$ifdef FPCPROCVAR}@{$endif}searchregvars);
  463. { copy parameter into a register ? }
  464. parasym:=true;
  465. symtablestack^.next^.foreach({$ifdef FPCPROCVAR}@{$endif}searchregvars);
  466. { hold needed registers free }
  467. for i:=maxvarregs downto maxvarregs-p^.registers32+1 do
  468. begin
  469. regvarinfo^.regvars[i]:=nil;
  470. regvarinfo^.regvars_para[i] := false;
  471. end;
  472. { now assign register }
  473. for i:=1 to maxvarregs-p^.registers32 do
  474. begin
  475. if assigned(regvarinfo^.regvars[i]) and
  476. (reg_pushes[varregs[i]] < regvarinfo^.regvars[i]^.refs) then
  477. begin
  478. { register is no longer available for }
  479. { expressions }
  480. { search the register which is the most }
  481. { unused }
  482. usableregs:=usableregs-[varregs[i]];
  483. is_reg_var[varregs[i]]:=true;
  484. dec(c_usableregs);
  485. { possibly no 32 bit register are needed }
  486. { call by reference/const ? }
  487. if (regvarinfo^.regvars[i]^.varspez=vs_var) or
  488. ((regvarinfo^.regvars[i]^.varspez=vs_const) and
  489. push_addr_param(regvarinfo^.regvars[i]^.vartype.def)) then
  490. begin
  491. regvarinfo^.regvars[i]^.reg:=varregs[i];
  492. end
  493. else
  494. if (regvarinfo^.regvars[i]^.vartype.def^.deftype in [orddef,enumdef]) and
  495. (porddef(regvarinfo^.regvars[i]^.vartype.def)^.size=1) then
  496. begin
  497. {$ifdef i386}
  498. regvarinfo^.regvars[i]^.reg:=reg32toreg8(varregs[i]);
  499. {$endif}
  500. end
  501. else
  502. if (regvarinfo^.regvars[i]^.vartype.def^.deftype in [orddef,enumdef]) and
  503. (porddef(regvarinfo^.regvars[i]^.vartype.def)^.size=2) then
  504. begin
  505. {$ifdef i386}
  506. regvarinfo^.regvars[i]^.reg:=reg32toreg16(varregs[i]);
  507. {$endif}
  508. end
  509. else
  510. begin
  511. regvarinfo^.regvars[i]^.reg:=varregs[i];
  512. end;
  513. if regvarinfo^.regvars_para[i] then
  514. unused:=unused - [regvarinfo^.regvars[i]^.reg];
  515. { procedure uses this register }
  516. {$ifdef i386}
  517. usedinproc:=usedinproc or ($80 shr byte(varregs[i]));
  518. {$endif i386}
  519. {$ifdef m68k}
  520. usedinproc:=usedinproc or ($800 shr word(varregs[i]));
  521. {$endif m68k}
  522. end
  523. else
  524. begin
  525. regvarinfo^.regvars[i] := nil;
  526. regvarinfo^.regvars_para[i] := false;
  527. end;
  528. end;
  529. end;
  530. if ((p^.registersfpu+1)<maxfpuvarregs) then
  531. begin
  532. parasym:=false;
  533. symtablestack^.foreach({$ifdef FPCPROCVAR}@{$endif}searchfpuregvars);
  534. {$ifdef dummy}
  535. { copy parameter into a register ? }
  536. parasym:=true;
  537. symtablestack^.next^.foreach({$ifdef FPCPROCVAR}@{$endif}searchregvars);
  538. {$endif dummy}
  539. { hold needed registers free }
  540. { in non leaf procedures we must be very careful }
  541. { with assigning registers }
  542. if aktmaxfpuregisters=-1 then
  543. begin
  544. if (procinfo^.flags and pi_do_call)<>0 then
  545. begin
  546. for i:=maxfpuvarregs downto 2 do
  547. regvarinfo^.fpuregvars[i]:=nil;
  548. end
  549. else
  550. begin
  551. for i:=maxfpuvarregs downto maxfpuvarregs-p^.registersfpu do
  552. regvarinfo^.fpuregvars[i]:=nil;
  553. end;
  554. end
  555. else
  556. begin
  557. for i:=aktmaxfpuregisters+1 to maxfpuvarregs do
  558. regvarinfo^.fpuregvars[i]:=nil;
  559. end;
  560. { now assign register }
  561. for i:=1 to maxfpuvarregs do
  562. begin
  563. if assigned(regvarinfo^.fpuregvars[i]) then
  564. begin
  565. {$ifdef i386}
  566. { reserve place on the FPU stack }
  567. regvarinfo^.fpuregvars[i]^.reg:=correct_fpuregister(R_ST0,i-1);
  568. {$endif i386}
  569. {$ifdef m68k}
  570. regvarinfo^.fpuregvars[i]^.reg:=fpuvarregs[i];
  571. {$endif m68k}
  572. end;
  573. end;
  574. end;
  575. end;
  576. end;
  577. procedure load_regvars(asml: paasmoutput; p: ptree);
  578. var
  579. i: longint;
  580. hr : preference;
  581. regvarinfo: pregvarinfo;
  582. {$ifdef i386}
  583. opsize: topsize;
  584. opcode: tasmop;
  585. signed: boolean;
  586. {$endif i386}
  587. begin
  588. if (cs_regalloc in aktglobalswitches) and
  589. ((procinfo^.flags and (pi_uses_asm or pi_uses_exceptions))=0) then
  590. begin
  591. regvarinfo := pregvarinfo(aktprocsym^.definition^.regvarinfo);
  592. { can happen when inlining assembler procedures (JM) }
  593. if not assigned(regvarinfo) then
  594. exit;
  595. for i:=1 to maxvarregs do
  596. begin
  597. { parameter must be load }
  598. if regvarinfo^.regvars_para[i] then
  599. begin
  600. {$ifdef i386}
  601. asml^.concat(new(pairegalloc,alloc(reg32(regvarinfo^.regvars[i]^.reg))));
  602. {$endif i386}
  603. { procinfo is there actual, }
  604. { because we can't never be in a }
  605. { nested procedure }
  606. { when loading parameter to reg }
  607. new(hr);
  608. reset_reference(hr^);
  609. hr^.offset:=pvarsym(regvarinfo^.regvars[i])^.address+procinfo^.para_offset;
  610. hr^.base:=procinfo^.framepointer;
  611. {$ifdef i386}
  612. { zero the regvars because the upper 48bits must be clear }
  613. { for 8bits vars when using them with btrl (JM) }
  614. signed :=
  615. (pvarsym(regvarinfo^.regvars[i])^.vartype.def^.deftype =
  616. orddef) and
  617. is_signed(pvarsym(regvarinfo^.regvars[i])^.vartype.def);
  618. case regsize(regvarinfo^.regvars[i]^.reg) of
  619. S_L:
  620. begin
  621. opsize := S_L;
  622. opcode := A_MOV;
  623. end;
  624. S_W:
  625. begin
  626. opsize := S_WL;
  627. if signed then
  628. opcode := A_MOVSX
  629. else opcode := A_MOVZX;
  630. end;
  631. S_B:
  632. begin
  633. opsize := S_BL;
  634. if signed then
  635. opcode := A_MOVSX
  636. else opcode := A_MOVZX;
  637. end;
  638. end;
  639. asml^.concat(new(paicpu,op_ref_reg(opcode,opsize,
  640. hr,reg32(regvarinfo^.regvars[i]^.reg))));
  641. {$endif i386}
  642. {$ifdef m68k}
  643. asml^.concat(new(paicpu,op_ref_reg(A_MOVE,regsize(regvarinfo^.regvars[i]^.reg),
  644. hr,regvarinfo^.regvars[i]^.reg)));
  645. {$endif m68k}
  646. end
  647. end;
  648. for i:=1 to maxvarregs do
  649. begin
  650. if assigned(regvarinfo^.regvars[i]) then
  651. begin
  652. {$ifdef i386}
  653. if not(regvarinfo^.regvars_para[i]) then
  654. begin
  655. asml^.concat(new(pairegalloc,alloc(reg32(regvarinfo^.regvars[i]^.reg))));
  656. { zero the regvars because the upper 48bits must be clear }
  657. { for 8bits vars when using them with btrl (JM) }
  658. if (regsize(regvarinfo^.regvars[i]^.reg) in [S_B,S_W]) then
  659. asml^.concat(new(paicpu,op_reg_reg(A_XOR,S_L,
  660. reg32(regvarinfo^.regvars[i]^.reg),
  661. reg32(regvarinfo^.regvars[i]^.reg))));
  662. end;
  663. {$endif i386}
  664. if cs_asm_source in aktglobalswitches then
  665. asml^.insert(new(pai_asm_comment,init(strpnew(regvarinfo^.regvars[i]^.name+
  666. ' with weight '+tostr(regvarinfo^.regvars[i]^.refs)+' assigned to register '+
  667. reg2str(regvarinfo^.regvars[i]^.reg)))));
  668. if (status.verbosity and v_debug)=v_debug then
  669. Message3(cg_d_register_weight,reg2str(regvarinfo^.regvars[i]^.reg),
  670. tostr(regvarinfo^.regvars[i]^.refs),regvarinfo^.regvars[i]^.name);
  671. end;
  672. end;
  673. for i:=1 to maxfpuvarregs do
  674. begin
  675. if assigned(regvarinfo^.fpuregvars[i]) then
  676. begin
  677. {$ifdef i386}
  678. { reserve place on the FPU stack }
  679. regvarinfo^.fpuregvars[i]^.reg:=correct_fpuregister(R_ST0,i-1);
  680. asml^.concat(new(paicpu,op_none(A_FLDZ,S_NO)));
  681. {$endif i386}
  682. {$ifdef dummy}
  683. { parameter must be load }
  684. if regvarinfo^.fpuregvars_para[i] then
  685. begin
  686. { procinfo is there actual, }
  687. { because we can't never be in a }
  688. { nested procedure }
  689. { when loading parameter to reg }
  690. new(hr);
  691. reset_reference(hr^);
  692. hr^.offset:=pvarsym(regvarinfo^.regvars[i])^.address+procinfo^.para_offset;
  693. hr^.base:=procinfo^.framepointer;
  694. {$ifdef i386}
  695. asml^.concat(new(paicpu,op_ref_reg(A_MOV,regsize(regvarinfo^.regvars[i]^.reg),
  696. hr,regvarinfo^.regvars[i]^.reg)));
  697. {$endif i386}
  698. {$ifdef m68k}
  699. asml^.concat(new(paicpu,op_ref_reg(A_MOVE,regsize(regvarinfo^.regvars[i]^.reg),
  700. hr,regvarinfo^.regvars[i]^.reg)));
  701. {$endif m68k}
  702. end;
  703. {$endif dummy}
  704. end;
  705. end;
  706. if assigned(p) then
  707. if cs_asm_source in aktglobalswitches then
  708. asml^.insert(new(pai_asm_comment,init(strpnew(tostr(p^.registersfpu)+
  709. ' registers on FPU stack used by temp. expressions'))));
  710. for i:=1 to maxfpuvarregs do
  711. begin
  712. if assigned(regvarinfo^.fpuregvars[i]) then
  713. begin
  714. if cs_asm_source in aktglobalswitches then
  715. asml^.insert(new(pai_asm_comment,init(strpnew(regvarinfo^.fpuregvars[i]^.name+
  716. ' with weight '+tostr(regvarinfo^.fpuregvars[i]^.refs)+' assigned to register '+
  717. reg2str(regvarinfo^.fpuregvars[i]^.reg)))));
  718. if (status.verbosity and v_debug)=v_debug then
  719. Message3(cg_d_register_weight,reg2str(regvarinfo^.fpuregvars[i]^.reg),
  720. tostr(regvarinfo^.fpuregvars[i]^.refs),regvarinfo^.fpuregvars[i]^.name);
  721. end;
  722. end;
  723. if cs_asm_source in aktglobalswitches then
  724. asml^.insert(new(pai_asm_comment,init(strpnew('Register variable assignment:'))));
  725. end;
  726. end;
  727. {$endif CG11}
  728. procedure cleanup_regvars(asml: paasmoutput);
  729. var
  730. i: longint;
  731. begin
  732. {$ifdef i386}
  733. { can happen when inlining assembler procedures (JM) }
  734. if not assigned(aktprocsym^.definition^.regvarinfo) then
  735. exit;
  736. if (cs_regalloc in aktglobalswitches) and
  737. ((procinfo^.flags and (pi_uses_asm or pi_uses_exceptions))=0) then
  738. with pregvarinfo(aktprocsym^.definition^.regvarinfo)^ do
  739. begin
  740. for i:=1 to maxfpuvarregs do
  741. if assigned(fpuregvars[i]) then
  742. { ... and clean it up }
  743. asml^.concat(new(paicpu,op_reg(A_FSTP,S_NO,R_ST0)));
  744. for i := 1 to maxvarregs do
  745. if assigned(regvars[i]) then
  746. asml^.concat(new(pairegalloc,dealloc(reg32(regvars[i]^.reg))));
  747. end;
  748. {$endif i386}
  749. end;
  750. end.
  751. {
  752. $Log$
  753. Revision 1.9 2000-10-01 19:48:25 peter
  754. * lot of compile updates for cg11
  755. Revision 1.8 2000/09/30 16:08:45 peter
  756. * more cg11 updates
  757. Revision 1.7 2000/09/30 13:08:16 jonas
  758. * regvars are now zeroed at the start of their life if they contain an 8
  759. or 16bit var/parameter, because the full 32bits are used if they are
  760. necessary for a btrl instruction
  761. Revision 1.6 2000/09/24 15:06:27 peter
  762. * use defines.inc
  763. Revision 1.5 2000/08/27 16:11:52 peter
  764. * moved some util functions from globals,cobjects to cutils
  765. * splitted files into finput,fmodule
  766. Revision 1.4 2000/08/17 11:07:51 jonas
  767. * fixed crash when inlining assembler procedures with -Or
  768. Revision 1.3 2000/08/04 05:52:00 jonas
  769. * correct version (I also had a regvars.pp locally, which was used
  770. instead of the regvars.pas on CVS, so I didn't notice the errors :( )
  771. Revision 1.2 2000/08/03 14:36:47 jonas
  772. * fixed inserting of allocated register for regvars (only those for
  773. parameters were done, and sometimes even the wrong ones)
  774. Revision 1.1 2000/08/03 13:17:25 jonas
  775. + allow regvars to be used inside inlined procs, which required the
  776. following changes:
  777. + load regvars in genentrycode/free them in genexitcode (cgai386)
  778. * moved all regvar related code to new regvars unit
  779. + added pregvarinfo type to hcodegen
  780. + added regvarinfo field to tprocinfo (symdef/symdefh)
  781. * deallocate the regvars of the caller in secondprocinline before
  782. inlining the called procedure and reallocate them afterwards
  783. }