temp_gen.pas 18 KB

123456789101112131415161718192021222324252627282930313233343536373839404142434445464748495051525354555657585960616263646566676869707172737475767778798081828384858687888990919293949596979899100101102103104105106107108109110111112113114115116117118119120121122123124125126127128129130131132133134135136137138139140141142143144145146147148149150151152153154155156157158159160161162163164165166167168169170171172173174175176177178179180181182183184185186187188189190191192193194195196197198199200201202203204205206207208209210211212213214215216217218219220221222223224225226227228229230231232233234235236237238239240241242243244245246247248249250251252253254255256257258259260261262263264265266267268269270271272273274275276277278279280281282283284285286287288289290291292293294295296297298299300301302303304305306307308309310311312313314315316317318319320321322323324325326327328329330331332333334335336337338339340341342343344345346347348349350351352353354355356357358359360361362363364365366367368369370371372373374375376377378379380381382383384385386387388389390391392393394395396397398399400401402403404405406407408409410411412413414415416417418419420421422423424425426427428429430431432433434435436437438439440441442443444445446447448449450451452453454455456457458459460461462463464465466467468469470471472473474475476477478479480481482483484485486487488489490491492493494495496497498499500501502503504505506507508509510511512513514515516517518519520521522523524525526527528529530531532533534535536537538539540541542543544545546547548549550551552553554555556557558559560561562563564565566567568569570571572573574575576577578579580581582583584585586587588589590591592593594595596597598599600601602603604605606
  1. {
  2. $Id$
  3. Copyright (C) 1998-2000 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 temp_gen;
  19. {$i defines.inc}
  20. interface
  21. uses
  22. cpubase,cpuinfo,cobjects,globals,
  23. hcodegen,verbose,fmodule,aasm;
  24. {$ifdef newcg}
  25. const
  26. countusableregint : byte = c_countusableregsint;
  27. countusableregfpu : byte = c_countusableregsfpu;
  28. countusableregmm : byte = c_countusableregsmm;
  29. {$endif newcg}
  30. type
  31. ttemptype = (tt_none,tt_free,tt_normal,tt_persistant,
  32. tt_ansistring,tt_freeansistring,tt_widestring,tt_freewidestring,
  33. tt_interfacecom,tt_freeinterfacecom);
  34. ttemptypeset = set of ttemptype;
  35. ptemprecord = ^ttemprecord;
  36. ttemprecord = record
  37. temptype : ttemptype;
  38. pos : longint;
  39. size : longint;
  40. next : ptemprecord;
  41. nextfree : ptemprecord; { for faster freeblock checking }
  42. {$ifdef EXTDEBUG}
  43. posinfo,
  44. releaseposinfo : tfileposinfo;
  45. {$endif}
  46. end;
  47. var
  48. { contains all temps }
  49. templist : ptemprecord;
  50. { contains all free temps using nextfree links }
  51. tempfreelist : ptemprecord;
  52. { Offsets of the first/last temp }
  53. firsttemp,
  54. lasttemp : longint;
  55. { generates temporary variables }
  56. procedure resettempgen;
  57. procedure setfirsttemp(l : longint);
  58. function gettempsize : longint;
  59. function newtempofsize(size : longint) : longint;
  60. function gettempofsize(size : longint) : longint;
  61. { special call for inlined procedures }
  62. function gettempofsizepersistant(size : longint) : longint;
  63. { for parameter func returns }
  64. procedure normaltemptopersistant(pos : longint);
  65. procedure persistanttemptonormal(pos : longint);
  66. {procedure ungettemp(pos : longint;size : longint);}
  67. procedure ungetpersistanttemp(pos : longint);
  68. procedure gettempofsizereference(l : longint;var ref : treference);
  69. function istemp(const ref : treference) : boolean;
  70. procedure ungetiftemp(const ref : treference);
  71. function getsizeoftemp(const ref: treference): longint;
  72. function ungetiftempansi(const ref : treference) : boolean;
  73. procedure gettempansistringreference(var ref : treference);
  74. function ungetiftempintfcom(const ref : treference) : boolean;
  75. procedure gettempintfcomreference(var ref : treference);
  76. implementation
  77. uses
  78. cutils,systems;
  79. procedure resettempgen;
  80. var
  81. hp : ptemprecord;
  82. begin
  83. { Clear the old templist }
  84. while assigned(templist) do
  85. begin
  86. {$ifdef EXTDEBUG}
  87. case tempList^.temptype of
  88. tt_normal,
  89. tt_persistant :
  90. Comment(V_Warning,'temporary assignment of size '+
  91. tostr(templist^.size)+' from pos '+tostr(templist^.posinfo.line)+
  92. ':'+tostr(templist^.posinfo.column)+
  93. ' at pos '+tostr(templist^.pos)+
  94. ' not freed at the end of the procedure');
  95. tt_ansistring :
  96. Comment(V_Warning,'temporary ANSI assignment of size '+
  97. tostr(templist^.size)+' from pos '+tostr(templist^.posinfo.line)+
  98. ':'+tostr(templist^.posinfo.column)+
  99. ' at pos '+tostr(templist^.pos)+
  100. ' not freed at the end of the procedure');
  101. end;
  102. {$endif}
  103. hp:=templist;
  104. templist:=hp^.next;
  105. dispose(hp);
  106. end;
  107. templist:=nil;
  108. tempfreelist:=nil;
  109. firsttemp:=0;
  110. lasttemp:=0;
  111. end;
  112. procedure setfirsttemp(l : longint);
  113. begin
  114. { this is a negative value normally }
  115. if l < 0 then
  116. Begin
  117. if odd(l) then
  118. Dec(l);
  119. end
  120. else
  121. Begin
  122. if odd(l) then
  123. Inc(l);
  124. end;
  125. firsttemp:=l;
  126. lasttemp:=l;
  127. end;
  128. function newtempofsize(size : longint) : longint;
  129. var
  130. tl : ptemprecord;
  131. begin
  132. { Just extend the temp, everything below has been use
  133. already }
  134. dec(lasttemp,size);
  135. { now we can create the templist entry }
  136. new(tl);
  137. tl^.temptype:=tt_normal;
  138. tl^.pos:=lasttemp;
  139. tl^.size:=size;
  140. tl^.next:=templist;
  141. tl^.nextfree:=nil;
  142. templist:=tl;
  143. newtempofsize:=tl^.pos;
  144. end;
  145. const
  146. lasttempofsize : ptemprecord = nil;
  147. function gettempofsize(size : longint) : longint;
  148. var
  149. tl,
  150. bestslot,bestprev,
  151. hprev,hp : ptemprecord;
  152. bestsize,ofs : longint;
  153. begin
  154. bestprev:=nil;
  155. bestslot:=nil;
  156. tl:=nil;
  157. bestsize:=0;
  158. { Align needed size on 4 bytes }
  159. if (size mod 4)<>0 then
  160. size:=size+(4-(size mod 4));
  161. { First check the tmpfreelist }
  162. if assigned(tempfreelist) then
  163. begin
  164. { Check for a slot with the same size first }
  165. hprev:=nil;
  166. hp:=tempfreelist;
  167. while assigned(hp) do
  168. begin
  169. {$ifdef EXTDEBUG}
  170. if hp^.temptype<>tt_free then
  171. Comment(V_Warning,'Temp in freelist is not set to tt_free');
  172. {$endif}
  173. if hp^.size>=size then
  174. begin
  175. { Slot is the same size, then leave immediatly }
  176. if hp^.size=size then
  177. begin
  178. bestprev:=hprev;
  179. bestslot:=hp;
  180. bestsize:=size;
  181. break;
  182. end
  183. else
  184. begin
  185. if (bestsize=0) or (hp^.size<bestsize) then
  186. begin
  187. bestprev:=hprev;
  188. bestslot:=hp;
  189. bestsize:=hp^.size;
  190. end;
  191. end;
  192. end;
  193. hprev:=hp;
  194. hp:=hp^.nextfree;
  195. end;
  196. end;
  197. { Reuse an old temp ? }
  198. if assigned(bestslot) then
  199. begin
  200. if bestsize=size then
  201. begin
  202. bestslot^.temptype:=tt_normal;
  203. ofs:=bestslot^.pos;
  204. tl:=bestslot;
  205. { Remove from the tempfreelist }
  206. if assigned(bestprev) then
  207. bestprev^.nextfree:=bestslot^.nextfree
  208. else
  209. tempfreelist:=bestslot^.nextfree;
  210. end
  211. else
  212. begin
  213. { Resize the old block }
  214. dec(bestslot^.size,size);
  215. { Create new block and link after bestslot }
  216. new(tl);
  217. tl^.temptype:=tt_normal;
  218. tl^.pos:=bestslot^.pos+bestslot^.size;
  219. ofs:=tl^.pos;
  220. tl^.size:=size;
  221. tl^.nextfree:=nil;
  222. { link the new block }
  223. tl^.next:=bestslot^.next;
  224. bestslot^.next:=tl;
  225. end;
  226. end
  227. else
  228. begin
  229. ofs:=newtempofsize(size);
  230. tl:=templist;
  231. end;
  232. lasttempofsize:=tl;
  233. {$ifdef EXTDEBUG}
  234. tl^.posinfo:=aktfilepos;
  235. {$endif}
  236. exprasmList.concat(Taitempalloc.alloc(ofs,size));
  237. gettempofsize:=ofs;
  238. end;
  239. function gettempofsizepersistant(size : longint) : longint;
  240. var
  241. l : longint;
  242. begin
  243. l:=gettempofsize(size);
  244. lasttempofsize^.temptype:=tt_persistant;
  245. {$ifdef EXTDEBUG}
  246. Comment(V_Debug,'temp managment : call to gettempofsizepersistant()'+
  247. ' with size '+tostr(size)+' returned '+tostr(l));
  248. {$endif}
  249. gettempofsizepersistant:=l;
  250. end;
  251. function gettempsize : longint;
  252. var
  253. _align : longint;
  254. begin
  255. { align to 4 bytes at least
  256. otherwise all those subl $2,%esp are meaningless PM }
  257. _align:=target_os.stackalignment;
  258. if _align<4 then
  259. _align:=4;
  260. gettempsize:=Align(-lasttemp,_align);
  261. end;
  262. procedure gettempofsizereference(l : longint;var ref : treference);
  263. begin
  264. { do a reset, because the reference isn't used }
  265. reset_reference(ref);
  266. ref.offset:=gettempofsize(l);
  267. ref.base:=procinfo^.framepointer;
  268. end;
  269. procedure gettemppointerreferencefortype(var ref : treference; const usedtype, freetype: ttemptype);
  270. var
  271. foundslot,tl : ptemprecord;
  272. begin
  273. { do a reset, because the reference isn't used }
  274. reset_reference(ref);
  275. ref.base:=procinfo^.framepointer;
  276. { Reuse old slot ? }
  277. foundslot:=nil;
  278. tl:=templist;
  279. while assigned(tl) do
  280. begin
  281. if tl^.temptype=freetype then
  282. begin
  283. foundslot:=tl;
  284. {$ifdef EXTDEBUG}
  285. tl^.posinfo:=aktfilepos;
  286. {$endif}
  287. break;
  288. end;
  289. tl:=tl^.next;
  290. end;
  291. if assigned(foundslot) then
  292. begin
  293. foundslot^.temptype:=usedtype;
  294. ref.offset:=foundslot^.pos;
  295. end
  296. else
  297. begin
  298. ref.offset:=newtempofsize(target_os.size_of_pointer);
  299. {$ifdef EXTDEBUG}
  300. templist^.posinfo:=aktfilepos;
  301. {$endif}
  302. templist^.temptype:=usedtype;
  303. end;
  304. exprasmList.concat(Taitempalloc.alloc(ref.offset,target_os.size_of_pointer));
  305. end;
  306. function ungettemppointeriftype(const ref : treference; const usedtype, freetype: ttemptype) : boolean;
  307. var
  308. tl : ptemprecord;
  309. begin
  310. ungettemppointeriftype:=false;
  311. tl:=templist;
  312. while assigned(tl) do
  313. begin
  314. if tl^.pos=ref.offset then
  315. begin
  316. if tl^.temptype=usedtype then
  317. begin
  318. tl^.temptype:=freetype;
  319. ungettemppointeriftype:=true;
  320. exprasmList.concat(Taitempalloc.dealloc(tl^.pos,tl^.size));
  321. exit;
  322. {$ifdef EXTDEBUG}
  323. end
  324. else if (tl^.temptype=freetype) then
  325. begin
  326. Comment(V_Debug,'temp managment problem : ungettemppointeriftype()'+
  327. ' at pos '+tostr(ref.offset)+ ' already free !');
  328. {$endif}
  329. end;
  330. end;
  331. tl:=tl^.next;
  332. end;
  333. end;
  334. procedure gettempansistringreference(var ref : treference);
  335. begin
  336. gettemppointerreferencefortype(ref,tt_ansistring,tt_freeansistring);
  337. end;
  338. function ungetiftempansi(const ref : treference) : boolean;
  339. begin
  340. ungetiftempansi:=ungettemppointeriftype(ref,tt_ansistring,tt_freeansistring);
  341. end;
  342. procedure gettempintfcomreference(var ref : treference);
  343. begin
  344. gettemppointerreferencefortype(ref,tt_interfacecom,tt_freeinterfacecom);
  345. end;
  346. function ungetiftempintfcom(const ref : treference) : boolean;
  347. begin
  348. ungetiftempintfcom:=ungettemppointeriftype(ref,tt_ansistring,tt_freeansistring);
  349. end;
  350. function istemp(const ref : treference) : boolean;
  351. begin
  352. { ref.index = R_NO was missing
  353. led to problems with local arrays
  354. with lower bound > 0 (PM) }
  355. istemp:=((ref.base=procinfo^.framepointer) and
  356. {$ifdef i386}
  357. (ref.index=R_NO) and
  358. {$endif}
  359. (ref.offset<firsttemp));
  360. end;
  361. procedure persistanttemptonormal(pos : longint);
  362. var
  363. hp : ptemprecord;
  364. begin
  365. hp:=templist;
  366. while assigned(hp) do
  367. if (hp^.pos=pos) and (hp^.temptype=tt_persistant) then
  368. begin
  369. {$ifdef EXTDEBUG}
  370. Comment(V_Debug,'temp managment : persistanttemptonormal()'+
  371. ' at pos '+tostr(pos)+ ' found !');
  372. {$endif}
  373. hp^.temptype:=tt_normal;
  374. exit;
  375. end
  376. else
  377. hp:=hp^.next;
  378. {$ifdef EXTDEBUG}
  379. Comment(V_Debug,'temp managment problem : persistanttemptonormal()'+
  380. ' at pos '+tostr(pos)+ ' not found !');
  381. {$endif}
  382. end;
  383. procedure normaltemptopersistant(pos : longint);
  384. var
  385. hp : ptemprecord;
  386. begin
  387. hp:=templist;
  388. while assigned(hp) do
  389. if (hp^.pos=pos) and (hp^.temptype=tt_normal) then
  390. begin
  391. {$ifdef EXTDEBUG}
  392. Comment(V_Debug,'temp managment : normaltemptopersistant()'+
  393. ' at pos '+tostr(pos)+ ' found !');
  394. {$endif}
  395. hp^.temptype:=tt_persistant;
  396. exit;
  397. end
  398. else
  399. hp:=hp^.next;
  400. {$ifdef EXTDEBUG}
  401. Comment(V_Debug,'temp managment problem : normaltemptopersistant()'+
  402. ' at pos '+tostr(pos)+ ' not found !');
  403. {$endif}
  404. end;
  405. function ungettemp(pos:longint;allowtype:ttemptype):ttemptype;
  406. var
  407. hp,hnext,hprev,hprevfree : ptemprecord;
  408. begin
  409. ungettemp:=tt_none;
  410. hp:=templist;
  411. hprev:=nil;
  412. hprevfree:=nil;
  413. while assigned(hp) do
  414. begin
  415. if (hp^.pos=pos) then
  416. begin
  417. { check type }
  418. ungettemp:=hp^.temptype;
  419. if hp^.temptype<>allowtype then
  420. begin
  421. exit;
  422. end;
  423. exprasmList.concat(Taitempalloc.dealloc(hp^.pos,hp^.size));
  424. { set this block to free }
  425. hp^.temptype:=tt_free;
  426. { Update tempfreelist }
  427. if assigned(hprevfree) then
  428. begin
  429. { Connect with previous? }
  430. if assigned(hprev) and (hprev^.temptype=tt_free) then
  431. begin
  432. inc(hprev^.size,hp^.size);
  433. hprev^.next:=hp^.next;
  434. dispose(hp);
  435. hp:=hprev;
  436. end
  437. else
  438. hprevfree^.nextfree:=hp;
  439. end
  440. else
  441. begin
  442. hp^.nextfree:=tempfreelist;
  443. tempfreelist:=hp;
  444. end;
  445. { Next block free ? Yes, then concat }
  446. hnext:=hp^.next;
  447. if assigned(hnext) and (hnext^.temptype=tt_free) then
  448. begin
  449. inc(hp^.size,hnext^.size);
  450. hp^.nextfree:=hnext^.nextfree;
  451. hp^.next:=hnext^.next;
  452. dispose(hnext);
  453. end;
  454. exit;
  455. end;
  456. if (hp^.temptype=tt_free) then
  457. hprevfree:=hp;
  458. hprev:=hp;
  459. hp:=hp^.next;
  460. end;
  461. ungettemp:=tt_none;
  462. end;
  463. function getsizeoftemp(const ref: treference): longint;
  464. var
  465. hp : ptemprecord;
  466. begin
  467. hp:=templist;
  468. while assigned(hp) do
  469. begin
  470. if (hp^.pos=ref.offset) then
  471. begin
  472. getsizeoftemp := hp^.size;
  473. exit;
  474. end;
  475. hp := hp^.next;
  476. end;
  477. getsizeoftemp := -1;
  478. end;
  479. procedure ungetpersistanttemp(pos : longint);
  480. begin
  481. {$ifdef EXTDEBUG}
  482. if ungettemp(pos,tt_persistant)<>tt_persistant then
  483. Comment(V_Warning,'temp managment problem : ungetpersistanttemp()'+
  484. ' at pos '+tostr(pos)+ ' not found !');
  485. {$else}
  486. ungettemp(pos,tt_persistant);
  487. {$endif}
  488. end;
  489. procedure ungetiftemp(const ref : treference);
  490. {$ifdef EXTDEBUG}
  491. var
  492. tt : ttemptype;
  493. {$endif}
  494. begin
  495. if istemp(ref) then
  496. begin
  497. { first check if ansistring }
  498. if ungetiftempansi(ref) then
  499. exit;
  500. {$ifndef EXTDEBUG}
  501. ungettemp(ref.offset,tt_normal);
  502. {$else}
  503. tt:=ungettemp(ref.offset,tt_normal);
  504. if tt=tt_persistant then
  505. Comment(V_Debug,'temp at pos '+tostr(ref.offset)+ ' not released because persistant!');
  506. if tt=tt_none then
  507. Comment(V_Warning,'temp not found for release at offset '+tostr(ref.offset));
  508. {$endif}
  509. end;
  510. end;
  511. procedure inittemps;
  512. begin
  513. tempfreelist:=nil;
  514. templist:=nil;
  515. end;
  516. begin
  517. InitTemps;
  518. end.
  519. {
  520. $Log$
  521. Revision 1.10 2000-12-31 11:04:43 jonas
  522. + sizeoftemp() function
  523. Revision 1.9 2000/12/25 00:07:30 peter
  524. + new tlinkedlist class (merge of old tstringqueue,tcontainer and
  525. tlinkedlist objects)
  526. Revision 1.8 2000/11/30 22:16:50 florian
  527. * moved to i386
  528. Revision 1.7 2000/11/29 00:30:42 florian
  529. * unused units removed from uses clause
  530. * some changes for widestrings
  531. Revision 1.6 2000/11/04 14:25:22 florian
  532. + merged Attila's changes for interfaces, not tested yet
  533. Revision 1.5 2000/09/30 16:08:45 peter
  534. * more cg11 updates
  535. Revision 1.4 2000/09/24 15:06:31 peter
  536. * use defines.inc
  537. Revision 1.3 2000/08/27 16:11:55 peter
  538. * moved some util functions from globals,cobjects to cutils
  539. * splitted files into finput,fmodule
  540. Revision 1.2 2000/07/13 11:32:52 michael
  541. + removed logs
  542. }