tgobj.pas 27 KB

123456789101112131415161718192021222324252627282930313233343536373839404142434445464748495051525354555657585960616263646566676869707172737475767778798081828384858687888990919293949596979899100101102103104105106107108109110111112113114115116117118119120121122123124125126127128129130131132133134135136137138139140141142143144145146147148149150151152153154155156157158159160161162163164165166167168169170171172173174175176177178179180181182183184185186187188189190191192193194195196197198199200201202203204205206207208209210211212213214215216217218219220221222223224225226227228229230231232233234235236237238239240241242243244245246247248249250251252253254255256257258259260261262263264265266267268269270271272273274275276277278279280281282283284285286287288289290291292293294295296297298299300301302303304305306307308309310311312313314315316317318319320321322323324325326327328329330331332333334335336337338339340341342343344345346347348349350351352353354355356357358359360361362363364365366367368369370371372373374375376377378379380381382383384385386387388389390391392393394395396397398399400401402403404405406407408409410411412413414415416417418419420421422423424425426427428429430431432433434435436437438439440441442443444445446447448449450451452453454455456457458459460461462463464465466467468469470471472473474475476477478479480481482483484485486487488489490491492493494495496497498499500501502503504505506507508509510511512513514515516517518519520521522523524525526527528529530531532533534535536537538539540541542543544545546547548549550551552553554555556557558559560561562563564565566567568569570571572573574575576577578579580581582583584585586587588589590591592593594595596597598599600601602603604605606607608609610611612613614615616617618619620621622623624625626627628629630631632633634635636637638639640641642643644645646647648649650651652653654655656657658659660661662663664665666667668669670671672673674675676677678679680681682683684685686687688689690691692693694695696697698699700701702703704705706707708709710711712713714715716717718719720721722723724725726727728729730731732733734735736737738739740741742743744745746747748749750751752753754755756757758759760761
  1. {
  2. Copyright (c) 1998-2002 by Florian Klaempfl
  3. This unit implements the base object for temp. generator
  4. This program is free software; you can redistribute it and/or modify
  5. it under the terms of the GNU General Public License as published by
  6. the Free Software Foundation; either version 2 of the License, or
  7. (at your option) any later version.
  8. This program is distributed in the hope that it will be useful,
  9. but WITHOUT ANY WARRANTY; without even the implied warranty of
  10. MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
  11. GNU General Public License for more details.
  12. You should have received a copy of the GNU General Public License
  13. along with this program; if not, write to the Free Software
  14. Foundation, Inc., 675 Mass Ave, Cambridge, MA 02139, USA.
  15. ****************************************************************************
  16. }
  17. {#@abstract(Temporary reference allocator unit)
  18. Temporary reference allocator unit. This unit contains
  19. all which is related to allocating temporary memory
  20. space on the stack, as required, by the code generator.
  21. }
  22. unit tgobj;
  23. {$i fpcdefs.inc}
  24. { $define DEBUG_FREETEMP}
  25. interface
  26. uses
  27. globals,globtype,
  28. symtype,
  29. cpubase,cgbase,cgutils,
  30. aasmtai,aasmdata;
  31. type
  32. ptemprecord = ^ttemprecord;
  33. ttemprecord = record
  34. temptype : ttemptype;
  35. { finalize this temp if it's a managed type }
  36. fini : boolean;
  37. alignment : shortint;
  38. pos : asizeint;
  39. size : asizeint;
  40. def : tdef;
  41. next : ptemprecord;
  42. nextfree : ptemprecord; { for faster freeblock checking }
  43. {$ifdef EXTDEBUG}
  44. posinfo,
  45. releaseposinfo : tfileposinfo;
  46. {$endif}
  47. end;
  48. {# Generates temporary variables }
  49. ttgobj = class
  50. protected
  51. { contains all free temps using nextfree links }
  52. tempfreelist : ptemprecord;
  53. procedure alloctemp(list: TAsmList; size: asizeint; alignment: shortint; temptype: ttemptype; def: tdef; fini: boolean; out ref: treference); virtual;
  54. procedure freetemp(list: TAsmList; pos: treftemppos; temptypes: ttemptypeset);virtual;
  55. procedure gettempinternal(list: TAsmList; size: asizeint; alignment: shortint; temptype: ttemptype; def: tdef; fini: boolean; out ref : treference);
  56. procedure freetemphook(list: TAsmList; temp: ptemprecord); virtual;
  57. public
  58. { contains all temps }
  59. templist : ptemprecord;
  60. { Offsets of the first/last temp }
  61. firsttemp,
  62. lasttemp,
  63. { Offset of temp base register relative to guaranteed stack alignment
  64. (note: currently only behaves as expected if it's a power of 2,
  65. and if all requested alignments are also a power of 2) }
  66. alignmismatch: longint;
  67. direction : shortint;
  68. constructor create;virtual;reintroduce;
  69. {# Clear and free the complete linked list of temporary memory
  70. locations. The list is set to nil.}
  71. procedure resettempgen;
  72. {# Sets the first offset from the frame pointer or stack pointer where
  73. the temporary references will be allocated. It is to note that this
  74. value should always be negative.
  75. @param(l start offset where temps will start in stack)
  76. }
  77. procedure setfirsttemp(l: asizeint); virtual;
  78. procedure setalignmentmismatch(l: shortint); virtual;
  79. { version of gettemp that is compatible with hlcg-based targets;
  80. always use in common code, only use gettemp in cgobj and
  81. architecture-specific backends.
  82. the forcesize parameter is so that it can be used for defs that
  83. don't have an inherent size (e.g., array of const) }
  84. procedure gethltemp(list: TAsmList; def: tdef; forcesize: asizeint; temptype: ttemptype; out ref: treference); virtual;
  85. procedure gethltempmanaged(list: TAsmList; def: tdef; temptype: ttemptype; out ref: treference); virtual;
  86. procedure gettemp(list: TAsmList; size: asizeint; alignment: shortint; temptype: ttemptype; out ref : treference);
  87. procedure gettempmanaged(list: TAsmList; def:tdef;temptype:ttemptype;out ref : treference);
  88. procedure ungettemp(list: TAsmList; const ref : treference); virtual;
  89. function sizeoftemp(list: TAsmList; const ref: treference): asizeint;
  90. function changetemptype(list: TAsmList; const ref:treference;temptype:ttemptype):boolean;
  91. function gettypeoftemp(const ref:treference): ttemptype;
  92. function isstartoftemp(const ref: treference): boolean;
  93. {# Returns a reference corresponding to a temp }
  94. procedure temp_to_ref(p: ptemprecord; out ref: treference); virtual;
  95. {# Returns TRUE if the reference ref is allocated in temporary volatile memory space,
  96. otherwise returns FALSE.
  97. @param(ref reference to verify)
  98. }
  99. function istemp(const ref : treference) : boolean; virtual;
  100. {# Frees a reference @var(ref) which was allocated in the volatile temporary memory space.
  101. The freed space can later be reallocated and reused. If this reference
  102. is not in the temporary memory, it is simply not freed.
  103. }
  104. procedure ungetiftemp(list: TAsmList; const ref : treference); virtual;
  105. { Allocate space for a local }
  106. procedure getlocal(list: TAsmList; size: asizeint; def: tdef; var ref : treference);
  107. procedure getlocal(list: TAsmList; size: asizeint; alignment: shortint; def: tdef; var ref : treference); virtual;
  108. procedure UnGetLocal(list: TAsmList; const ref : treference);
  109. end;
  110. ttgobjclass = class of ttgobj;
  111. var
  112. tg: ttgobj;
  113. tgobjclass: ttgobjclass = ttgobj;
  114. procedure location_freetemp(list:TAsmList; const l : tlocation);
  115. implementation
  116. uses
  117. cutils,
  118. verbose,
  119. procinfo;
  120. const
  121. FreeTempTypes = [tt_free,tt_freenoreuse,tt_freeregallocator];
  122. {$ifdef EXTDEBUG}
  123. TempTypeStr : array[ttemptype] of string[18] = (
  124. '<none>',
  125. 'free','normal','persistent',
  126. 'noreuse','freenoreuse',
  127. 'regallocator','freeregallocator'
  128. );
  129. {$endif EXTDEBUG}
  130. Used2Free : array[ttemptype] of ttemptype = (
  131. tt_none,
  132. tt_none,tt_free,tt_free,
  133. tt_freenoreuse,tt_none,
  134. tt_freeregallocator,tt_none
  135. );
  136. {*****************************************************************************
  137. Helpers
  138. *****************************************************************************}
  139. procedure location_freetemp(list:TAsmList; const l : tlocation);
  140. begin
  141. if (l.loc in [LOC_REFERENCE,LOC_CREFERENCE]) then
  142. tg.ungetiftemp(list,l.reference);
  143. end;
  144. {*****************************************************************************
  145. TTGOBJ
  146. *****************************************************************************}
  147. constructor ttgobj.create;
  148. begin
  149. tempfreelist:=nil;
  150. templist:=nil;
  151. { we could create a new child class for this but I don't if it is worth the effort (FK) }
  152. {$if defined(powerpc) or defined(powerpc64) or defined(avr) or defined(jvm) or defined(aarch64) or defined(xtensa) or defined(wasm32)}
  153. direction:=1;
  154. {$else}
  155. direction:=-1;
  156. {$endif}
  157. end;
  158. procedure ttgobj.resettempgen;
  159. var
  160. hp : ptemprecord;
  161. begin
  162. { Clear the old templist }
  163. while assigned(templist) do
  164. begin
  165. {$ifdef EXTDEBUG}
  166. if not(templist^.temptype in FreeTempTypes) then
  167. begin
  168. Comment(V_Warning,'tgobj: (ResetTempgen) temp at pos '+tostr(templist^.pos)+
  169. ' with size '+tostr(templist^.size)+' and type '+TempTypeStr[templist^.temptype]+
  170. ' from pos '+tostr(templist^.posinfo.line)+':'+tostr(templist^.posinfo.column)+
  171. ' not freed at the end of the procedure');
  172. end;
  173. {$endif EXTDEBUG}
  174. hp:=templist;
  175. templist:=hp^.next;
  176. dispose(hp);
  177. end;
  178. templist:=nil;
  179. tempfreelist:=nil;
  180. firsttemp:=0;
  181. lasttemp:=0;
  182. alignmismatch:=0;
  183. {$ifdef EXTDEBUG}
  184. Comment(V_Note,'tgobj: (ResetTempGen) all temps freed');
  185. {$endif}
  186. end;
  187. procedure ttgobj.setfirsttemp(l: asizeint);
  188. begin
  189. { this is a negative value normally }
  190. if l*direction>=0 then
  191. begin
  192. if odd(l) then
  193. inc(l,direction);
  194. end
  195. else
  196. internalerror(200204221);
  197. firsttemp:=l;
  198. lasttemp:=l;
  199. {$ifdef EXTDEBUG}
  200. Comment(V_Note,'tgobj: (SetFirstTempGen) set to '+tostr(l));
  201. {$endif}
  202. end;
  203. procedure ttgobj.setalignmentmismatch(l: shortint);
  204. begin
  205. alignmismatch:=l*direction;
  206. end;
  207. procedure ttgobj.alloctemp(list: TAsmList; size: asizeint; alignment: shortint; temptype: ttemptype; def :tdef; fini: boolean; out ref: treference);
  208. var
  209. tl,htl,
  210. bestslot,bestprev,
  211. hprev,hp : ptemprecord;
  212. freetype : ttemptype;
  213. adjustedpos : longint;
  214. bestatend,
  215. fitatbegin,
  216. fitatend : boolean;
  217. begin
  218. bestprev:=nil;
  219. bestslot:=nil;
  220. tl:=nil;
  221. bestatend:=false;
  222. current_procinfo.updatestackalignment(alignment);
  223. if size=0 then
  224. begin
  225. {$ifdef EXTDEBUG}
  226. Comment(V_Note,'tgobj: (AllocTemp) temp of size 0 requested, allocating 4 bytes');
  227. {$endif}
  228. size:=4;
  229. end;
  230. freetype:=Used2Free[temptype];
  231. if freetype=tt_none then
  232. internalerror(200208201);
  233. if size>MaxLocalsSize then
  234. begin
  235. CGMessage(cg_e_localsize_too_big);
  236. size:=0; // Prevent further range check errors
  237. end;
  238. size:=align(size,alignment);
  239. { First check the tmpfreelist, but not when
  240. we don't want to reuse an already allocated block }
  241. if assigned(tempfreelist) and
  242. (temptype<>tt_noreuse) then
  243. begin
  244. hprev:=nil;
  245. hp:=tempfreelist;
  246. while assigned(hp) do
  247. begin
  248. {$ifdef EXTDEBUG}
  249. if not(hp^.temptype in FreeTempTypes) then
  250. Comment(V_Warning,'tgobj: (AllocTemp) temp at pos '+tostr(hp^.pos)+ ' in freelist is not set to a free temp type !');
  251. {$endif}
  252. { Check only slots that are
  253. - free
  254. - share the same type if either has to be finalised
  255. - contain enough space
  256. - has a correct alignment }
  257. adjustedpos:=hp^.pos+alignmismatch;
  258. if (hp^.temptype=freetype) and
  259. (hp^.fini=fini) and
  260. ((hp^.def=def) or
  261. not fini) and
  262. (hp^.size>=size) and
  263. ((adjustedpos=align(adjustedpos,alignment)) or
  264. (adjustedpos+hp^.size-size = align(adjustedpos+hp^.size-size,alignment))) then
  265. begin
  266. { Slot is the same size then leave immediatly }
  267. if (hp^.size=size) then
  268. begin
  269. bestprev:=hprev;
  270. bestslot:=hp;
  271. break;
  272. end
  273. else
  274. begin
  275. { we can fit a smaller block either at the begin or at }
  276. { the end of a block. For direction=-1 we prefer the }
  277. { end, for direction=1 we prefer the begin (i.e., }
  278. { always closest to the source). We also try to use }
  279. { the block with the worst possible alignment that }
  280. { still suffices. And we pick the block which will }
  281. { have the best alignmenment after this new block is }
  282. { substracted from it. }
  283. fitatend:=(adjustedpos+hp^.size-size)=align(adjustedpos+hp^.size-size,alignment);
  284. fitatbegin:=adjustedpos=align(adjustedpos,alignment);
  285. if assigned(bestslot) then
  286. begin
  287. fitatend:=fitatend and
  288. ((not bestatend and
  289. (direction=-1)) or
  290. (bestatend and
  291. isbetteralignedthan(abs(bestslot^.pos+hp^.size-size),abs(adjustedpos+hp^.size-size),current_settings.alignment.localalignmax)));
  292. fitatbegin:=fitatbegin and
  293. (not bestatend or
  294. (direction=1)) and
  295. isbetteralignedthan(abs(adjustedpos+size),abs(bestslot^.pos+size),current_settings.alignment.localalignmax);
  296. end;
  297. if fitatend and
  298. fitatbegin then
  299. if isbetteralignedthan(abs(adjustedpos+hp^.size-size),abs(adjustedpos+size),current_settings.alignment.localalignmax) then
  300. fitatbegin:=false
  301. else if isbetteralignedthan(abs(adjustedpos+size),abs(adjustedpos+hp^.size-size),current_settings.alignment.localalignmax) then
  302. fitatend:=false
  303. else if (direction=1) then
  304. fitatend:=false
  305. else
  306. fitatbegin:=false;
  307. if fitatend or
  308. fitatbegin then
  309. begin
  310. bestprev:=hprev;
  311. bestslot:=hp;
  312. bestatend:=fitatend;
  313. end;
  314. end;
  315. end;
  316. hprev:=hp;
  317. hp:=hp^.nextfree;
  318. end;
  319. end;
  320. { Reuse an old temp ? }
  321. if assigned(bestslot) then
  322. begin
  323. if bestslot^.size=size then
  324. begin
  325. tl:=bestslot;
  326. { Remove from the tempfreelist }
  327. if assigned(bestprev) then
  328. bestprev^.nextfree:=tl^.nextfree
  329. else
  330. tempfreelist:=tl^.nextfree;
  331. end
  332. else
  333. begin
  334. { Duplicate bestlost and the block in the list }
  335. new(tl);
  336. move(bestslot^,tl^,sizeof(ttemprecord));
  337. tl^.next:=bestslot^.next;
  338. bestslot^.next:=tl;
  339. { Now we split the block in 2 parts. Depending on the direction
  340. we need to resize the newly inserted block or the old reused block.
  341. For direction=1 we can use tl for the new block. For direction=-1 we
  342. will be reusing bestslot and resize the new block, that means we need
  343. to swap the pointers }
  344. if (direction=-1) xor
  345. bestatend then
  346. begin
  347. htl:=tl;
  348. tl:=bestslot;
  349. bestslot:=htl;
  350. { Update the tempfreelist to point to the new block }
  351. if assigned(bestprev) then
  352. bestprev^.nextfree:=bestslot
  353. else
  354. tempfreelist:=bestslot;
  355. end;
  356. if not bestatend then
  357. inc(bestslot^.pos,size)
  358. else
  359. inc(tl^.pos,tl^.size-size);
  360. { Create new block and resize the old block }
  361. tl^.fini:=fini;
  362. tl^.size:=size;
  363. tl^.nextfree:=nil;
  364. { Resize the old block }
  365. dec(bestslot^.size,size);
  366. end;
  367. tl^.temptype:=temptype;
  368. tl^.def:=def;
  369. tl^.alignment:=alignment;
  370. tl^.nextfree:=nil;
  371. end
  372. else
  373. begin
  374. { now we can create the templist entry }
  375. new(tl);
  376. tl^.temptype:=temptype;
  377. tl^.def:=def;
  378. { Extend the temp }
  379. if direction=-1 then
  380. begin
  381. if Int64(align(-lasttemp-alignmismatch,alignment))+size+alignmismatch>MaxLocalsSize then
  382. begin
  383. CGMessage(cg_e_localsize_too_big);
  384. size:=0; // Prevent further range check errors
  385. end;
  386. lasttemp:=(-align(-lasttemp-alignmismatch,alignment))-size-alignmismatch;
  387. tl^.pos:=lasttemp;
  388. end
  389. else
  390. begin
  391. tl^.pos:=align(lasttemp+alignmismatch,alignment)-alignmismatch;
  392. if Int64(tl^.pos)+size>MaxLocalsSize then
  393. begin
  394. CGMessage(cg_e_localsize_too_big);
  395. size:=0; // Prevent further range check errors
  396. end;
  397. lasttemp:=tl^.pos+size;
  398. end;
  399. {$ifdef EXTDEBUG}
  400. Comment(V_Note,'tgobj: (AllocTemp) lasttemp set to '+tostr(lasttemp));
  401. {$endif}
  402. tl^.fini:=fini;
  403. tl^.alignment:=alignment;
  404. tl^.size:=size;
  405. tl^.next:=templist;
  406. tl^.nextfree:=nil;
  407. templist:=tl;
  408. end;
  409. {$ifdef EXTDEBUG}
  410. tl^.posinfo:=current_filepos;
  411. if assigned(tl^.def) then
  412. list.concat(tai_tempalloc.allocinfo(tl^.pos,tl^.size,'allocated with type '+TempTypeStr[tl^.temptype]+' for def '+tl^.def.typename))
  413. else
  414. list.concat(tai_tempalloc.allocinfo(tl^.pos,tl^.size,'allocated with type '+TempTypeStr[tl^.temptype]));
  415. Comment(V_Note,'tgobj: (AllocTemp) temp of size '+tostr(size)+' type '+TempTypeStr[tl^.temptype]+' requested, allocated at offset '+tostr(tl^.pos));
  416. {$else}
  417. list.concat(tai_tempalloc.alloc(tl^.pos,tl^.size));
  418. {$endif}
  419. temp_to_ref(tl,ref);
  420. end;
  421. procedure ttgobj.FreeTemp(list: TAsmList; pos: treftemppos; temptypes: ttemptypeset);
  422. var
  423. hp,hnext,hprev,hprevfree : ptemprecord;
  424. begin
  425. hp:=templist;
  426. hprev:=nil;
  427. hprevfree:=nil;
  428. {$ifdef EXTDEBUG}
  429. Comment(V_Note,'tgobj: (FreeTemp) freeing of temp at pos '+tostr(pos.val)+' requested');
  430. {$endif}
  431. while assigned(hp) do
  432. begin
  433. if (hp^.pos=pos.val) then
  434. begin
  435. { check if already freed }
  436. if hp^.temptype in FreeTempTypes then
  437. begin
  438. {$ifdef EXTDEBUG}
  439. Comment(V_Warning,'tgobj: (FreeTemp) temp at pos '+tostr(pos.val)+ ' is already free !');
  440. list.concat(tai_tempalloc.allocinfo(hp^.pos,hp^.size,'temp is already freed'));
  441. {$endif}
  442. exit;
  443. end;
  444. { check type that are allowed to be released }
  445. if not(hp^.temptype in temptypes) then
  446. begin
  447. {$ifdef DEBUG_FREETEMP}
  448. if hp^.temptype = tt_persistent then
  449. Comment(V_Note,'tgobj: (Freetemp) temp at pos '+tostr(pos.val)+ ' has different type ('+TempTypeStr[hp^.temptype]+'), not releasing')
  450. else
  451. Comment(V_Warning,'tgobj: (Freetemp) temp at pos '+tostr(pos.val)+ ' has different type ('+TempTypeStr[hp^.temptype]+'), not releasing');
  452. list.concat(tai_tempalloc.allocinfo(hp^.pos,hp^.size,'temp has wrong type ('+TempTypeStr[hp^.temptype]+') not releasing'));
  453. {$endif}
  454. exit;
  455. end;
  456. freetemphook(list,hp);
  457. { set this block to free }
  458. hp^.temptype:=Used2Free[hp^.temptype];
  459. { Update tempfreelist }
  460. if assigned(hprevfree) then
  461. begin
  462. { Concat blocks when the previous block is free and
  463. there is no block assigned for a tdef }
  464. if assigned(hprev) and
  465. (hp^.temptype=tt_free) and
  466. not assigned(hp^.def) and
  467. (hprev^.temptype=tt_free) and
  468. not assigned(hprev^.def) then
  469. begin
  470. inc(hprev^.size,hp^.size);
  471. if direction=1 then
  472. hprev^.pos:=hp^.pos;
  473. hprev^.next:=hp^.next;
  474. dispose(hp);
  475. hp:=hprev;
  476. end
  477. else
  478. begin
  479. hp^.nextfree:=hprevfree^.nextfree;
  480. hprevfree^.nextfree:=hp;
  481. end;
  482. end
  483. else
  484. begin
  485. hp^.nextfree:=tempfreelist;
  486. tempfreelist:=hp;
  487. end;
  488. { Concat blocks when the next block is free and
  489. there is no block assigned for a tdef }
  490. hnext:=hp^.next;
  491. if assigned(hnext) and
  492. (hp^.temptype=tt_free) and
  493. not assigned(hp^.def) and
  494. (hnext^.temptype=tt_free) and
  495. not assigned(hnext^.def) then
  496. begin
  497. inc(hp^.size,hnext^.size);
  498. if direction=1 then
  499. hp^.pos:=hnext^.pos;
  500. hp^.nextfree:=hnext^.nextfree;
  501. hp^.next:=hnext^.next;
  502. dispose(hnext);
  503. end;
  504. { Stop }
  505. exit;
  506. end;
  507. if (hp^.temptype=tt_free) then
  508. hprevfree:=hp;
  509. hprev:=hp;
  510. hp:=hp^.next;
  511. end;
  512. end;
  513. procedure ttgobj.gethltemp(list: TAsmList; def: tdef; forcesize: asizeint; temptype: ttemptype; out ref: treference);
  514. begin
  515. gettemp(list,forcesize,def.alignment,temptype,ref);
  516. end;
  517. procedure ttgobj.gethltempmanaged(list: TAsmList; def: tdef; temptype: ttemptype; out ref: treference);
  518. begin
  519. gettempmanaged(list,def,temptype,ref);
  520. end;
  521. procedure ttgobj.gettemp(list: TAsmList; size: asizeint; alignment: shortint; temptype: ttemptype; out ref : treference);
  522. begin
  523. gettempinternal(list,size,alignment,temptype,nil,false,ref);
  524. end;
  525. procedure ttgobj.gettempinternal(list: TAsmList; size: asizeint; alignment: shortint; temptype: ttemptype; def: tdef; fini: boolean; out ref : treference);
  526. var
  527. varalign : shortint;
  528. begin
  529. varalign:=used_align(alignment,current_settings.alignment.localalignmin,current_settings.alignment.localalignmax);
  530. alloctemp(list,size,varalign,temptype,def,fini,ref);
  531. end;
  532. procedure ttgobj.freetemphook(list: TAsmList; temp: ptemprecord);
  533. begin
  534. list.concat(tai_tempalloc.dealloc(temp^.pos,temp^.size));
  535. end;
  536. procedure ttgobj.gettempmanaged(list: TAsmList; def:tdef;temptype:ttemptype;out ref : treference);
  537. begin
  538. gettempinternal(list,def.size,def.alignment,temptype,def,true,ref);
  539. end;
  540. function ttgobj.istemp(const ref : treference) : boolean;
  541. begin
  542. istemp:=ref.temppos.val<>ctempposinvalid.val;
  543. end;
  544. function ttgobj.sizeoftemp(list: TAsmList; const ref: treference): asizeint;
  545. var
  546. hp : ptemprecord;
  547. begin
  548. SizeOfTemp := -1;
  549. hp:=templist;
  550. while assigned(hp) do
  551. begin
  552. if (hp^.pos=ref.temppos.val) then
  553. begin
  554. sizeoftemp := hp^.size;
  555. exit;
  556. end;
  557. hp := hp^.next;
  558. end;
  559. {$ifdef EXTDEBUG}
  560. comment(v_debug,'tgobj: (SizeOfTemp) temp at pos '+tostr(ref.temppos.val)+' not found !');
  561. list.concat(tai_tempalloc.allocinfo(ref.temppos.val,0,'temp not found'));
  562. {$endif}
  563. end;
  564. function ttgobj.changetemptype(list: tasmList; const ref:treference; temptype:ttemptype):boolean;
  565. var
  566. hp : ptemprecord;
  567. begin
  568. ChangeTempType:=false;
  569. hp:=templist;
  570. while assigned(hp) do
  571. begin
  572. if (hp^.pos=ref.temppos.val) then
  573. begin
  574. if hp^.temptype<>tt_free then
  575. begin
  576. {$ifdef EXTDEBUG}
  577. if hp^.temptype=temptype then
  578. Comment(V_Warning,'tgobj: (ChangeTempType) temp'+
  579. ' at pos '+tostr(ref.temppos.val)+ ' is already of the correct type !');
  580. list.concat(tai_tempalloc.allocinfo(hp^.pos,hp^.size,'type changed to '+TempTypeStr[temptype]));
  581. {$endif}
  582. ChangeTempType:=true;
  583. hp^.temptype:=temptype;
  584. end
  585. else
  586. begin
  587. {$ifdef EXTDEBUG}
  588. Comment(V_Warning,'tgobj: (ChangeTempType) temp'+
  589. ' at pos '+tostr(ref.temppos.val)+ ' is already freed !');
  590. list.concat(tai_tempalloc.allocinfo(hp^.pos,hp^.size,'temp is already freed'));
  591. {$endif}
  592. end;
  593. exit;
  594. end;
  595. hp:=hp^.next;
  596. end;
  597. {$ifdef EXTDEBUG}
  598. Comment(V_Warning,'tgobj: (ChangeTempType) temp'+
  599. ' at pos '+tostr(ref.temppos.val)+ ' not found !');
  600. list.concat(tai_tempalloc.allocinfo(ref.temppos.val,0,'temp not found'));
  601. {$endif}
  602. end;
  603. function ttgobj.gettypeoftemp(const ref:treference): ttemptype;
  604. var
  605. hp : ptemprecord;
  606. begin
  607. hp:=templist;
  608. while assigned(hp) do
  609. begin
  610. if (hp^.pos=ref.temppos.val) then
  611. begin
  612. if hp^.temptype<>tt_free then
  613. result:=hp^.temptype
  614. else
  615. internalerror(2007020810);
  616. exit;
  617. end;
  618. hp:=hp^.next;
  619. end;
  620. result:=tt_none;
  621. end;
  622. function ttgobj.isstartoftemp(const ref: treference): boolean;
  623. var
  624. hp: ptemprecord;
  625. tmpref: treference;
  626. begin
  627. hp:=templist;
  628. if ref.temppos.val=ctempposinvalid.val then
  629. begin
  630. result:=false;
  631. exit;
  632. end;
  633. while assigned(hp) do
  634. begin
  635. if (hp^.pos=ref.temppos.val) then
  636. begin
  637. temp_to_ref(hp, tmpref);
  638. result:=references_equal(ref, tmpref);
  639. exit;
  640. end;
  641. hp:=hp^.next;
  642. end;
  643. internalerror(2018042601);
  644. end;
  645. procedure ttgobj.temp_to_ref(p: ptemprecord; out ref: treference);
  646. var
  647. t: treftemppos;
  648. begin
  649. t.val:=p^.pos;
  650. reference_reset_base(ref,current_procinfo.framepointer,p^.pos,t,p^.alignment,[]);
  651. end;
  652. procedure ttgobj.UnGetTemp(list: TAsmList; const ref : treference);
  653. begin
  654. FreeTemp(list,ref.temppos,[tt_normal,tt_noreuse,tt_persistent,tt_regallocator]);
  655. end;
  656. procedure ttgobj.UnGetIfTemp(list: TAsmList; const ref : treference);
  657. begin
  658. if istemp(ref) then
  659. FreeTemp(list,ref.temppos,[tt_normal]);
  660. end;
  661. procedure ttgobj.getlocal(list: TAsmList; size: asizeint; def: tdef; var ref : treference);
  662. begin
  663. getlocal(list, size, def.alignment, def, ref);
  664. end;
  665. procedure ttgobj.getlocal(list: TAsmList; size: asizeint; alignment: shortint; def: tdef; var ref : treference);
  666. begin
  667. alignment:=used_align(alignment,current_settings.alignment.localalignmin,current_settings.alignment.localalignmax);
  668. alloctemp(list,size,alignment,tt_persistent,def,false,ref);
  669. end;
  670. procedure ttgobj.UnGetLocal(list: TAsmList; const ref : treference);
  671. begin
  672. FreeTemp(list,ref.temppos,[tt_persistent]);
  673. end;
  674. end.