tgobj.pas 27 KB

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