tgeni386.pas 18 KB

123456789101112131415161718192021222324252627282930313233343536373839404142434445464748495051525354555657585960616263646566676869707172737475767778798081828384858687888990919293949596979899100101102103104105106107108109110111112113114115116117118119120121122123124125126127128129130131132133134135136137138139140141142143144145146147148149150151152153154155156157158159160161162163164165166167168169170171172173174175176177178179180181182183184185186187188189190191192193194195196197198199200201202203204205206207208209210211212213214215216217218219220221222223224225226227228229230231232233234235236237238239240241242243244245246247248249250251252253254255256257258259260261262263264265266267268269270271272273274275276277278279280281282283284285286287288289290291292293294295296297298299300301302303304305306307308309310311312313314315316317318319320321322323324325326327328329330331332333334335336337338339340341342343344345346347348349350351352353354355356357358359360361362363364365366367368369370371372373374375376377378379380381382383384385386387388389390391392393394395396397398399400401402403404405406407408409410411412413414415416417418419420421422423424425426427428429430431432433434435436437438439440441442443444445446447448449450451452453454455456457458459460461462463464465466467468469470471472473474475476477478479480481482483484485486487488489490491492493494495496497498499500501502503504505506507508509510511512513514515516517518519520521522523524525526527528529530531532533534535536537538539540541542543544545546547548549550551552553554555556557558559560561562563564565566567568569570571572573574575576577578579580581582583584585586587588589590
  1. {
  2. $Id$
  3. Copyright (C) 1993-98 by Florian Klaempfl
  4. This unit handles the temporary variables stuff for i386
  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 tgeni386;
  19. interface
  20. uses
  21. cobjects,globals,tree,hcodegen,verbose,files,aasm,
  22. cpubase,cpuasm
  23. ;
  24. type
  25. tregisterset = set of tregister;
  26. tpushed = array[R_EAX..R_MM6] of boolean;
  27. tsaved = array[R_EAX..R_MM6] of longint;
  28. const
  29. usablereg32 : byte = 4;
  30. { this value is used in tsaved, if the register isn't saved }
  31. reg_not_saved = $7fffffff;
  32. {$ifdef SUPPORT_MMX}
  33. usableregmmx : byte = 8;
  34. {$endif SUPPORT_MMX}
  35. function getregister32 : tregister;
  36. procedure ungetregister32(r : tregister);
  37. { tries to allocate the passed register, if possible }
  38. function getexplicitregister32(r : tregister) : tregister;
  39. {$ifdef SUPPORT_MMX}
  40. function getregistermmx : tregister;
  41. procedure ungetregistermmx(r : tregister);
  42. {$endif SUPPORT_MMX}
  43. procedure ungetregister(r : tregister);
  44. procedure cleartempgen;
  45. procedure del_reference(const ref : treference);
  46. procedure del_locref(const location : tlocation);
  47. procedure del_location(const l : tlocation);
  48. { pushs and restores registers }
  49. procedure pushusedregisters(var pushed : tpushed;b : byte);
  50. procedure popusedregisters(const pushed : tpushed);
  51. { saves and restores used registers to temp. values }
  52. procedure saveusedregisters(var saved : tsaved;b : byte);
  53. procedure restoreusedregisters(const saved : tsaved);
  54. procedure clearregistercount;
  55. procedure resetusableregisters;
  56. var
  57. unused,usableregs : tregisterset;
  58. c_usableregs : longint;
  59. { uses only 1 byte while a set uses in FPC 32 bytes }
  60. usedinproc : byte;
  61. { count, how much a register must be pushed if it is used as register }
  62. { variable }
  63. {$ifdef SUPPORT_MMX}
  64. reg_pushes : array[R_EAX..R_MM6] of longint;
  65. is_reg_var : array[R_EAX..R_MM6] of boolean;
  66. {$else SUPPORT_MMX}
  67. reg_pushes : array[R_EAX..R_EDI] of longint;
  68. is_reg_var : array[R_EAX..R_EDI] of boolean;
  69. {$endif SUPPORT_MMX}
  70. implementation
  71. uses
  72. globtype,temp_gen;
  73. procedure pushusedregisters(var pushed : tpushed;b : byte);
  74. var
  75. r : tregister;
  76. hr : preference;
  77. begin
  78. usedinproc:=usedinproc or b;
  79. for r:=R_EAX to R_EBX do
  80. begin
  81. pushed[r]:=false;
  82. { if the register is used by the calling subroutine }
  83. if ((b and ($80 shr byte(r)))<>0) then
  84. begin
  85. { and is present in use }
  86. if not(r in unused) then
  87. begin
  88. { then save it }
  89. exprasmlist^.concat(new(pai386,op_reg(A_PUSH,S_L,r)));
  90. { here was a big problem !!!!!}
  91. { you cannot do that for a register that is
  92. globally assigned to a var
  93. this also means that you must push it much more
  94. often, but there must be a better way
  95. maybe by putting the value back to the stack !! }
  96. if not(is_reg_var[r]) then
  97. unused:=unused+[r];
  98. pushed[r]:=true;
  99. end;
  100. end;
  101. end;
  102. {$ifdef SUPPORT_MMX}
  103. for r:=R_MM0 to R_MM6 do
  104. begin
  105. pushed[r]:=false;
  106. { if the mmx register is in use, save it }
  107. if not(r in unused) then
  108. begin
  109. exprasmlist^.concat(new(pai386,op_const_reg(
  110. A_SUB,S_L,8,R_ESP)));
  111. new(hr);
  112. reset_reference(hr^);
  113. hr^.base:=R_ESP;
  114. exprasmlist^.concat(new(pai386,op_reg_ref(
  115. A_MOVQ,S_NO,r,hr)));
  116. if not(is_reg_var[r]) then
  117. unused:=unused+[r];
  118. pushed[r]:=true;
  119. end;
  120. end;
  121. {$endif SUPPORT_MMX}
  122. end;
  123. procedure saveusedregisters(var saved : tsaved;b : byte);
  124. var
  125. r : tregister;
  126. hr : treference;
  127. begin
  128. usedinproc:=usedinproc or b;
  129. for r:=R_EAX to R_EBX do
  130. begin
  131. saved[r]:=reg_not_saved;
  132. { if the register is used by the calling subroutine }
  133. if ((b and ($80 shr byte(r)))<>0) then
  134. begin
  135. { and is present in use }
  136. if not(r in unused) then
  137. begin
  138. { then save it }
  139. gettempofsizereference(4,hr);
  140. saved[r]:=hr.offset;
  141. exprasmlist^.concat(new(pai386,op_reg_ref(A_MOV,S_L,r,newreference(hr))));
  142. { here was a big problem !!!!!}
  143. { you cannot do that for a register that is
  144. globally assigned to a var
  145. this also means that you must push it much more
  146. often, but there must be a better way
  147. maybe by putting the value back to the stack !! }
  148. if not(is_reg_var[r]) then
  149. unused:=unused+[r];
  150. end;
  151. end;
  152. end;
  153. {$ifdef SUPPORT_MMX}
  154. for r:=R_MM0 to R_MM6 do
  155. begin
  156. saved[r]:=reg_not_saved;
  157. { if the mmx register is in use, save it }
  158. if not(r in unused) then
  159. begin
  160. gettempofsizereference(8,hr);
  161. exprasmlist^.concat(new(pai386,op_reg_ref(
  162. A_MOVQ,S_NO,r,newreference(hr))));
  163. if not(is_reg_var[r]) then
  164. unused:=unused+[r];
  165. saved[r]:=hr.offset;
  166. end;
  167. end;
  168. {$endif SUPPORT_MMX}
  169. end;
  170. procedure popusedregisters(const pushed : tpushed);
  171. var
  172. r : tregister;
  173. {$ifdef SUPPORT_MMX}
  174. hr : preference;
  175. {$endif SUPPORT_MMX}
  176. begin
  177. { restore in reverse order: }
  178. {$ifdef SUPPORT_MMX}
  179. for r:=R_MM6 downto R_MM0 do
  180. begin
  181. if pushed[r] then
  182. begin
  183. new(hr);
  184. reset_reference(hr^);
  185. hr^.base:=R_ESP;
  186. exprasmlist^.concat(new(pai386,op_ref_reg(
  187. A_MOVQ,S_NO,hr,r)));
  188. exprasmlist^.concat(new(pai386,op_const_reg(
  189. A_ADD,S_L,8,R_ESP)));
  190. unused:=unused-[r];
  191. end;
  192. end;
  193. {$endif SUPPORT_MMX}
  194. for r:=R_EBX downto R_EAX do
  195. if pushed[r] then
  196. begin
  197. exprasmlist^.concat(new(pai386,op_reg(A_POP,S_L,r)));
  198. unused:=unused-[r];
  199. end;
  200. end;
  201. procedure restoreusedregisters(const saved : tsaved);
  202. var
  203. r : tregister;
  204. hr : treference;
  205. begin
  206. { restore in reverse order: }
  207. {$ifdef SUPPORT_MMX}
  208. for r:=R_MM6 downto R_MM0 do
  209. begin
  210. if saved[r]<>reg_not_saved then
  211. begin
  212. reset_reference(hr);
  213. hr.base:=frame_pointer;
  214. hr.offset:=saved[r];
  215. exprasmlist^.concat(new(pai386,op_ref_reg(
  216. A_MOVQ,S_NO,newreference(hr),r)));
  217. unused:=unused-[r];
  218. ungetiftemp(hr);
  219. end;
  220. end;
  221. {$endif SUPPORT_MMX}
  222. for r:=R_EBX downto R_EAX do
  223. if saved[r]<>reg_not_saved then
  224. begin
  225. reset_reference(hr);
  226. hr.base:=frame_pointer;
  227. hr.offset:=saved[r];
  228. exprasmlist^.concat(new(pai386,op_ref_reg(A_MOV,S_L,newreference(hr),r)));
  229. unused:=unused-[r];
  230. ungetiftemp(hr);
  231. end;
  232. end;
  233. procedure ungetregister(r : tregister);
  234. begin
  235. if r in [R_EAX,R_ECX,R_EDX,R_EBX,R_ESP,R_EBP,R_ESI,R_EDI] then
  236. ungetregister32(r)
  237. else if r in [R_AX,R_CX,R_DX,R_BX,R_SP,R_BP,R_SI,R_DI] then
  238. ungetregister32(reg16toreg32(r))
  239. else if r in [R_AL,R_BL,R_CL,R_DL] then
  240. ungetregister32(reg8toreg32(r))
  241. {$ifdef SUPPORT_MMX}
  242. else if r in [R_MM0..R_MM6] then
  243. ungetregistermmx(r)
  244. {$endif SUPPORT_MMX}
  245. else internalerror(18);
  246. end;
  247. procedure ungetregister32(r : tregister);
  248. begin
  249. if cs_regalloc in aktglobalswitches then
  250. begin
  251. { takes much time }
  252. if not(r in usableregs) then
  253. exit;
  254. unused:=unused+[r];
  255. inc(usablereg32);
  256. end
  257. else
  258. begin
  259. if not(r in [R_EAX,R_EBX,R_ECX,R_EDX]) then
  260. exit;
  261. unused:=unused+[r];
  262. inc(usablereg32);
  263. end;
  264. exprasmlist^.concat(new(pairegalloc,dealloc(r)));
  265. end;
  266. {$ifdef SUPPORT_MMX}
  267. function getregistermmx : tregister;
  268. var
  269. r : tregister;
  270. begin
  271. dec(usableregmmx);
  272. for r:=R_MM0 to R_MM6 do
  273. if r in unused then
  274. begin
  275. unused:=unused-[r];
  276. usedinproc:=usedinproc or ($80 shr byte(R_EAX));
  277. getregistermmx:=r;
  278. exit;
  279. end;
  280. internalerror(10);
  281. end;
  282. procedure ungetregistermmx(r : tregister);
  283. begin
  284. if cs_regalloc in aktglobalswitches then
  285. begin
  286. { takes much time }
  287. if not(r in usableregs) then
  288. exit;
  289. unused:=unused+[r];
  290. inc(usableregmmx);
  291. end
  292. else
  293. begin
  294. unused:=unused+[r];
  295. inc(usableregmmx);
  296. end;
  297. end;
  298. {$endif SUPPORT_MMX}
  299. procedure del_reference(const ref : treference);
  300. begin
  301. if ref.is_immediate then
  302. exit;
  303. ungetregister32(ref.base);
  304. ungetregister32(ref.index);
  305. end;
  306. procedure del_locref(const location : tlocation);
  307. begin
  308. if (location.loc<>loc_mem) and (location.loc<>loc_reference) then
  309. exit;
  310. if location.reference.is_immediate then
  311. exit;
  312. ungetregister32(location.reference.base);
  313. ungetregister32(location.reference.index);
  314. end;
  315. procedure del_location(const l : tlocation);
  316. begin
  317. case l.loc of
  318. LOC_REGISTER :
  319. ungetregister(l.register);
  320. LOC_MEM,LOC_REFERENCE :
  321. del_reference(l.reference);
  322. end;
  323. end;
  324. function getregister32 : tregister;
  325. begin
  326. if usablereg32=0 then
  327. internalerror(10);
  328. dec(usablereg32);
  329. if R_EAX in unused then
  330. begin
  331. unused:=unused-[R_EAX];
  332. usedinproc:=usedinproc or ($80 shr byte(R_EAX));
  333. getregister32:=R_EAX;
  334. exprasmlist^.concat(new(pairegalloc,alloc(R_EAX)));
  335. end
  336. else if R_EDX in unused then
  337. begin
  338. unused:=unused-[R_EDX];
  339. usedinproc:=usedinproc or ($80 shr byte(R_EDX));
  340. getregister32:=R_EDX;
  341. exprasmlist^.concat(new(pairegalloc,alloc(R_EDX)));
  342. end
  343. else if R_EBX in unused then
  344. begin
  345. unused:=unused-[R_EBX];
  346. usedinproc:=usedinproc or ($80 shr byte(R_EBX));
  347. getregister32:=R_EBX;
  348. exprasmlist^.concat(new(pairegalloc,alloc(R_EBX)));
  349. end
  350. else if R_ECX in unused then
  351. begin
  352. unused:=unused-[R_ECX];
  353. usedinproc:=usedinproc or ($80 shr byte(R_ECX));
  354. getregister32:=R_ECX;
  355. exprasmlist^.concat(new(pairegalloc,alloc(R_ECX)));
  356. end
  357. else internalerror(10);
  358. end;
  359. function getexplicitregister32(r : tregister) : tregister;
  360. begin
  361. if r in unused then
  362. begin
  363. dec(usablereg32);
  364. unused:=unused-[r];
  365. usedinproc:=usedinproc or ($80 shr byte(r));
  366. exprasmlist^.concat(new(pairegalloc,alloc(r)));
  367. getexplicitregister32:=r;
  368. end
  369. else
  370. getexplicitregister32:=getregister32;
  371. end;
  372. procedure cleartempgen;
  373. begin
  374. unused:=usableregs;
  375. usablereg32:=c_usableregs;
  376. end;
  377. procedure clearregistercount;
  378. var
  379. regi : tregister;
  380. begin
  381. {$ifdef SUPPORT_MMX}
  382. for regi:=R_EAX to R_MM6 do
  383. begin
  384. reg_pushes[regi]:=0;
  385. is_reg_var[regi]:=false;
  386. end;
  387. {$else SUPPORT_MMX}
  388. for regi:=R_EAX to R_EDI do
  389. begin
  390. reg_pushes[regi]:=0;
  391. is_reg_var[regi]:=false;
  392. end;
  393. {$endif SUPPORT_MMX}
  394. end;
  395. procedure resetusableregisters;
  396. begin
  397. {$ifdef SUPPORT_MMX}
  398. usableregs:=[R_EAX,R_EBX,R_ECX,R_EDX,R_MM0..R_MM6];
  399. c_usableregs:=4;
  400. usableregmmx:=8;
  401. {$else}
  402. usableregs:=[R_EAX,R_EBX,R_ECX,R_EDX];
  403. c_usableregs:=4;
  404. {$endif SUPPORT_MMX}
  405. end;
  406. begin
  407. resetusableregisters;
  408. end.
  409. {
  410. $Log$
  411. Revision 1.29 1999-08-04 00:23:48 florian
  412. * renamed i386asm and i386base to cpuasm and cpubase
  413. Revision 1.28 1999/08/02 17:17:11 florian
  414. * small changes for the new code generator
  415. Revision 1.27 1999/06/09 23:22:39 peter
  416. + del_location
  417. Revision 1.26 1999/05/27 19:45:27 peter
  418. * removed oldasm
  419. * plabel -> pasmlabel
  420. * -a switches to source writing automaticly
  421. * assembler readers OOPed
  422. * asmsymbol automaticly external
  423. * jumptables and other label fixes for asm readers
  424. Revision 1.25 1999/05/19 22:00:48 florian
  425. * some new routines for register management:
  426. maybe_savetotemp,restorefromtemp, saveusedregisters,
  427. restoreusedregisters
  428. Revision 1.24 1999/05/18 21:58:34 florian
  429. * fixed some bugs related to temp. ansistrings and functions results
  430. which return records/objects/arrays which need init/final.
  431. Revision 1.23 1999/05/01 13:25:01 peter
  432. * merged nasm compiler
  433. * old asm moved to oldasm/
  434. Revision 1.22 1999/04/21 16:31:48 pierre
  435. ra386att.pas
  436. Revision 1.21 1999/04/16 11:49:47 peter
  437. + tempalloc
  438. + -at to show temp alloc info in .s file
  439. Revision 1.20 1999/02/25 21:02:55 peter
  440. * ag386bin updates
  441. + coff writer
  442. Revision 1.19 1999/02/22 02:15:58 peter
  443. * updates for ag386bin
  444. Revision 1.18 1999/01/18 16:02:20 pierre
  445. * better error info with -Co
  446. Revision 1.17 1998/12/11 23:36:09 florian
  447. + again more stuff for int64/qword:
  448. - comparision operators
  449. - code generation for: str, read(ln), write(ln)
  450. Revision 1.16 1998/12/11 17:22:40 florian
  451. * fixed previous commit bug fix of getexplicitregister32
  452. (usableregs32 was decremented twice, thnaks Pierre for that hint)
  453. Revision 1.15 1998/12/11 16:10:13 florian
  454. + shifting for 64 bit ints added
  455. * bug in getexplicitregister32 fixed: usableregs wasn't decremented !!
  456. Revision 1.14 1998/12/11 00:03:59 peter
  457. + globtype,tokens,version unit splitted from globals
  458. Revision 1.13 1998/10/21 08:40:03 florian
  459. + ansistring operator +
  460. + $h and string[n] for n>255 added
  461. * small problem with TP fixed
  462. Revision 1.12 1998/09/20 17:11:24 jonas
  463. * released REGALLOC
  464. Revision 1.11 1998/09/16 17:58:33 jonas
  465. * fixed -dRegAlloc and -dDRegalloc problems
  466. Revision 1.10 1998/09/01 09:03:47 peter
  467. + resetregistercount, resetusableregisters
  468. Revision 1.9 1998/08/19 16:07:56 jonas
  469. * changed optimizer switches + cleanup of DestroyRefs in daopt386.pas
  470. Revision 1.8 1998/08/10 14:50:34 peter
  471. + localswitches, moduleswitches, globalswitches splitting
  472. Revision 1.7 1998/06/08 13:13:47 pierre
  473. + temporary variables now in temp_gen.pas unit
  474. because it is processor independent
  475. * mppc68k.bat modified to undefine i386 and support_mmx
  476. (which are defaults for i386)
  477. Revision 1.6 1998/05/20 09:42:38 pierre
  478. + UseTokenInfo now default
  479. * unit in interface uses and implementation uses gives error now
  480. * only one error for unknown symbol (uses lastsymknown boolean)
  481. the problem came from the label code !
  482. + first inlined procedures and function work
  483. (warning there might be allowed cases were the result is still wrong !!)
  484. * UseBrower updated gives a global list of all position of all used symbols
  485. with switch -gb
  486. Revision 1.5 1998/05/11 13:07:58 peter
  487. + $ifdef NEWPPU for the new ppuformat
  488. + $define GDB not longer required
  489. * removed all warnings and stripped some log comments
  490. * no findfirst/findnext anymore to remove smartlink *.o files
  491. Revision 1.4 1998/04/29 10:34:08 pierre
  492. + added some code for ansistring (not complete nor working yet)
  493. * corrected operator overloading
  494. * corrected nasm output
  495. + started inline procedures
  496. + added starstarn : use ** for exponentiation (^ gave problems)
  497. + started UseTokenInfo cond to get accurate positions
  498. Revision 1.3 1998/04/09 22:16:36 florian
  499. * problem with previous REGALLOC solved
  500. * improved property support
  501. Revision 1.2 1998/04/09 15:46:39 florian
  502. + register allocation tracing stuff added
  503. }