nbas.pas 36 KB

12345678910111213141516171819202122232425262728293031323334353637383940414243444546474849505152535455565758596061626364656667686970717273747576777879808182838485868788899091929394959697989910010110210310410510610710810911011111211311411511611711811912012112212312412512612712812913013113213313413513613713813914014114214314414514614714814915015115215315415515615715815916016116216316416516616716816917017117217317417517617717817918018118218318418518618718818919019119219319419519619719819920020120220320420520620720820921021121221321421521621721821922022122222322422522622722822923023123223323423523623723823924024124224324424524624724824925025125225325425525625725825926026126226326426526626726826927027127227327427527627727827928028128228328428528628728828929029129229329429529629729829930030130230330430530630730830931031131231331431531631731831932032132232332432532632732832933033133233333433533633733833934034134234334434534634734834935035135235335435535635735835936036136236336436536636736836937037137237337437537637737837938038138238338438538638738838939039139239339439539639739839940040140240340440540640740840941041141241341441541641741841942042142242342442542642742842943043143243343443543643743843944044144244344444544644744844945045145245345445545645745845946046146246346446546646746846947047147247347447547647747847948048148248348448548648748848949049149249349449549649749849950050150250350450550650750850951051151251351451551651751851952052152252352452552652752852953053153253353453553653753853954054154254354454554654754854955055155255355455555655755855956056156256356456556656756856957057157257357457557657757857958058158258358458558658758858959059159259359459559659759859960060160260360460560660760860961061161261361461561661761861962062162262362462562662762862963063163263363463563663763863964064164264364464564664764864965065165265365465565665765865966066166266366466566666766866967067167267367467567667767867968068168268368468568668768868969069169269369469569669769869970070170270370470570670770870971071171271371471571671771871972072172272372472572672772872973073173273373473573673773873974074174274374474574674774874975075175275375475575675775875976076176276376476576676776876977077177277377477577677777877978078178278378478578678778878979079179279379479579679779879980080180280380480580680780880981081181281381481581681781881982082182282382482582682782882983083183283383483583683783883984084184284384484584684784884985085185285385485585685785885986086186286386486586686786886987087187287387487587687787887988088188288388488588688788888989089189289389489589689789889990090190290390490590690790890991091191291391491591691791891992092192292392492592692792892993093193293393493593693793893994094194294394494594694794894995095195295395495595695795895996096196296396496596696796896997097197297397497597697797897998098198298398498598698798898999099199299399499599699799899910001001100210031004100510061007100810091010101110121013101410151016101710181019102010211022102310241025102610271028102910301031103210331034103510361037103810391040104110421043104410451046104710481049105010511052105310541055105610571058105910601061106210631064106510661067106810691070107110721073107410751076107710781079108010811082108310841085108610871088108910901091109210931094109510961097109810991100110111021103110411051106110711081109111011111112111311141115111611171118111911201121112211231124112511261127112811291130
  1. {
  2. Copyright (c) 2000-2002 by Florian Klaempfl
  3. This unit implements some basic nodes
  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. unit nbas;
  18. {$i fpcdefs.inc}
  19. interface
  20. uses
  21. globtype,
  22. cpuinfo,cpubase,cgbase,cgutils,
  23. aasmbase,aasmtai,aasmdata,aasmcpu,
  24. node,
  25. symtype;
  26. type
  27. tnothingnode = class(tnode)
  28. constructor create;virtual;
  29. function pass_1 : tnode;override;
  30. function pass_typecheck:tnode;override;
  31. end;
  32. tnothingnodeclass = class of tnothingnode;
  33. terrornode = class(tnode)
  34. constructor create;virtual;
  35. function pass_1 : tnode;override;
  36. function pass_typecheck:tnode;override;
  37. procedure mark_write;override;
  38. end;
  39. terrornodeclass = class of terrornode;
  40. tasmnode = class(tnode)
  41. p_asm : TAsmList;
  42. currenttai : tai;
  43. { Used registers in assembler block }
  44. used_regs_int,
  45. used_regs_fpu : tcpuregisterset;
  46. constructor create(p : TAsmList);virtual;
  47. constructor create_get_position;
  48. destructor destroy;override;
  49. constructor ppuload(t:tnodetype;ppufile:tcompilerppufile);override;
  50. procedure ppuwrite(ppufile:tcompilerppufile);override;
  51. procedure buildderefimpl;override;
  52. procedure derefimpl;override;
  53. function dogetcopy : tnode;override;
  54. function pass_1 : tnode;override;
  55. function pass_typecheck:tnode;override;
  56. function docompare(p: tnode): boolean; override;
  57. end;
  58. tasmnodeclass = class of tasmnode;
  59. tstatementnode = class(tbinarynode)
  60. constructor create(l,r : tnode);virtual;
  61. function simplify(forinline : boolean) : tnode; override;
  62. function pass_1 : tnode;override;
  63. function pass_typecheck:tnode;override;
  64. procedure printnodetree(var t:text);override;
  65. property statement : tnode read left write left;
  66. property next : tnode read right write right;
  67. end;
  68. tstatementnodeclass = class of tstatementnode;
  69. tblocknode = class(tunarynode)
  70. constructor create(l : tnode);virtual;
  71. destructor destroy; override;
  72. function simplify(forinline : boolean) : tnode; override;
  73. function pass_1 : tnode;override;
  74. function pass_typecheck:tnode;override;
  75. {$ifdef state_tracking}
  76. function track_state_pass(exec_known:boolean):boolean;override;
  77. {$endif state_tracking}
  78. property statements : tnode read left write left;
  79. end;
  80. tblocknodeclass = class of tblocknode;
  81. ttempcreatenode = class;
  82. ttempinfoflag = (ti_may_be_in_reg,ti_valid,ti_nextref_set_hookoncopy_nil,
  83. ti_addr_taken,ti_executeinitialisation);
  84. ttempinfoflags = set of ttempinfoflag;
  85. const
  86. tempinfostoreflags = [ti_may_be_in_reg,ti_addr_taken];
  87. type
  88. { to allow access to the location by temp references even after the temp has }
  89. { already been disposed and to make sure the coherency between temps and }
  90. { temp references is kept after a getcopy }
  91. ptempinfo = ^ttempinfo;
  92. ttempinfo = record
  93. { set to the copy of a tempcreate pnode (if it gets copied) so that the }
  94. { refs and deletenode can hook to this copy once they get copied too }
  95. hookoncopy : ptempinfo;
  96. typedef : tdef;
  97. typedefderef : tderef;
  98. temptype : ttemptype;
  99. owner : ttempcreatenode;
  100. withnode : tnode;
  101. location : tlocation;
  102. flags : ttempinfoflags;
  103. tempinitcode : tnode;
  104. end;
  105. { a node which will create a (non)persistent temp of a given type with a given }
  106. { size (the size is separate to allow creating "void" temps with a custom size) }
  107. ttempcreatenode = class(tnode)
  108. size: tcgint;
  109. tempinfo: ptempinfo;
  110. ftemplvalue : tnode;
  111. { * persistent temps are used in manually written code where the temp }
  112. { be usable among different statements and where you can manually say }
  113. { when the temp has to be freed (using a ttempdeletenode) }
  114. { * non-persistent temps are mostly used in typeconversion helpers, }
  115. { where the node that receives the temp becomes responsible for }
  116. { freeing it. In this last case, you must use only one reference }
  117. { to it and *not* generate a ttempdeletenode }
  118. constructor create(_typedef: tdef; _size: tcgint; _temptype: ttemptype;allowreg:boolean); virtual;
  119. constructor create_withnode(_typedef: tdef; _size: tcgint; _temptype: ttemptype; allowreg:boolean; withnode: tnode); virtual;
  120. constructor create_value(_typedef:tdef; _size: tcgint; _temptype: ttemptype;allowreg:boolean; templvalue: tnode);
  121. constructor ppuload(t:tnodetype;ppufile:tcompilerppufile);override;
  122. procedure ppuwrite(ppufile:tcompilerppufile);override;
  123. procedure buildderefimpl;override;
  124. procedure derefimpl;override;
  125. function dogetcopy: tnode; override;
  126. function pass_1 : tnode; override;
  127. function pass_typecheck: tnode; override;
  128. function docompare(p: tnode): boolean; override;
  129. procedure printnodedata(var t:text);override;
  130. end;
  131. ttempcreatenodeclass = class of ttempcreatenode;
  132. { a node which is a reference to a certain temp }
  133. ttemprefnode = class(tnode)
  134. tempinfo: ptempinfo;
  135. constructor create(const temp: ttempcreatenode); virtual;
  136. constructor create_offset(const temp: ttempcreatenode;aoffset:longint);
  137. constructor ppuload(t:tnodetype;ppufile:tcompilerppufile);override;
  138. procedure ppuwrite(ppufile:tcompilerppufile);override;
  139. procedure resolveppuidx;override;
  140. function dogetcopy: tnode; override;
  141. function pass_1 : tnode; override;
  142. function pass_typecheck : tnode; override;
  143. procedure mark_write;override;
  144. function docompare(p: tnode): boolean; override;
  145. procedure printnodedata(var t:text);override;
  146. protected
  147. offset : longint;
  148. private
  149. tempidx : longint;
  150. end;
  151. ttemprefnodeclass = class of ttemprefnode;
  152. { a node which removes a temp }
  153. ttempdeletenode = class(tnode)
  154. tempinfo: ptempinfo;
  155. constructor create(const temp: ttempcreatenode); virtual;
  156. { this will convert the persistant temp to a normal temp
  157. for returning to the other nodes }
  158. constructor create_normal_temp(const temp: ttempcreatenode);
  159. constructor ppuload(t:tnodetype;ppufile:tcompilerppufile);override;
  160. procedure ppuwrite(ppufile:tcompilerppufile);override;
  161. procedure resolveppuidx;override;
  162. function dogetcopy: tnode; override;
  163. function pass_1: tnode; override;
  164. function pass_typecheck: tnode; override;
  165. function docompare(p: tnode): boolean; override;
  166. destructor destroy; override;
  167. procedure printnodedata(var t:text);override;
  168. protected
  169. release_to_normal : boolean;
  170. private
  171. tempidx : longint;
  172. end;
  173. ttempdeletenodeclass = class of ttempdeletenode;
  174. var
  175. cnothingnode : tnothingnodeclass = tnothingnode;
  176. cerrornode : terrornodeclass = terrornode;
  177. casmnode : tasmnodeclass = tasmnode;
  178. cstatementnode : tstatementnodeclass = tstatementnode;
  179. cblocknode : tblocknodeclass = tblocknode;
  180. ctempcreatenode : ttempcreatenodeclass = ttempcreatenode;
  181. ctemprefnode : ttemprefnodeclass = ttemprefnode;
  182. ctempdeletenode : ttempdeletenodeclass = ttempdeletenode;
  183. { Create a blocknode and statement node for multiple statements
  184. generated internally by the parser }
  185. function internalstatements(var laststatement:tstatementnode):tblocknode;
  186. function laststatement(block:tblocknode):tstatementnode;
  187. procedure addstatement(var laststatement:tstatementnode;n:tnode);
  188. implementation
  189. uses
  190. cutils,
  191. verbose,globals,systems,
  192. symconst,symdef,defutil,defcmp,
  193. pass_1,
  194. nutils,nld,ncal,nflw,
  195. procinfo
  196. ;
  197. {*****************************************************************************
  198. Helpers
  199. *****************************************************************************}
  200. function internalstatements(var laststatement:tstatementnode):tblocknode;
  201. begin
  202. { create dummy initial statement }
  203. laststatement := cstatementnode.create(cnothingnode.create,nil);
  204. internalstatements := cblocknode.create(laststatement);
  205. end;
  206. function laststatement(block:tblocknode):tstatementnode;
  207. begin
  208. result:=tstatementnode(block.left);
  209. while assigned(result) and assigned(result.right) do
  210. result:=tstatementnode(result.right);
  211. end;
  212. procedure addstatement(var laststatement:tstatementnode;n:tnode);
  213. begin
  214. if assigned(laststatement.right) then
  215. internalerror(200204201);
  216. laststatement.right:=cstatementnode.create(n,nil);
  217. laststatement:=tstatementnode(laststatement.right);
  218. end;
  219. {*****************************************************************************
  220. TFIRSTNOTHING
  221. *****************************************************************************}
  222. constructor tnothingnode.create;
  223. begin
  224. inherited create(nothingn);
  225. end;
  226. function tnothingnode.pass_typecheck:tnode;
  227. begin
  228. result:=nil;
  229. resultdef:=voidtype;
  230. end;
  231. function tnothingnode.pass_1 : tnode;
  232. begin
  233. result:=nil;
  234. expectloc:=LOC_VOID;
  235. end;
  236. {*****************************************************************************
  237. TFIRSTERROR
  238. *****************************************************************************}
  239. constructor terrornode.create;
  240. begin
  241. inherited create(errorn);
  242. end;
  243. function terrornode.pass_typecheck:tnode;
  244. begin
  245. result:=nil;
  246. include(flags,nf_error);
  247. codegenerror:=true;
  248. resultdef:=generrordef;
  249. end;
  250. function terrornode.pass_1 : tnode;
  251. begin
  252. result:=nil;
  253. expectloc:=LOC_VOID;
  254. codegenerror:=true;
  255. end;
  256. procedure terrornode.mark_write;
  257. begin
  258. end;
  259. {*****************************************************************************
  260. TSTATEMENTNODE
  261. *****************************************************************************}
  262. constructor tstatementnode.create(l,r : tnode);
  263. begin
  264. inherited create(statementn,l,r);
  265. end;
  266. function is_exit_statement(var n: tnode; arg: pointer): foreachnoderesult;
  267. begin
  268. if (n.nodetype<>exitn) then
  269. result:=fen_false
  270. else
  271. result:=fen_norecurse_true;
  272. end;
  273. function no_exit_statement_in_block(n: tnode): boolean;
  274. begin
  275. result:=not foreachnodestatic(n,@is_exit_statement,nil);
  276. end;
  277. function tstatementnode.simplify(forinline: boolean) : tnode;
  278. begin
  279. result:=nil;
  280. { these "optimizations" are only to make it more easy to recognise }
  281. { blocknodes which at the end of inlining only contain one single }
  282. { statement. Simplifying inside blocknode.simplify could be dangerous }
  283. { because if the main blocknode which makes up a procedure/function }
  284. { body were replaced with a statementn/nothingn, this could cause }
  285. { problems elsewhere in the compiler which expects a blocknode }
  286. { remove next statement if it's a nothing-statement (since if it's }
  287. { the last, it won't remove itself -- see next simplification) }
  288. while assigned(right) and
  289. (tstatementnode(right).left.nodetype = nothingn) do
  290. begin
  291. result:=tstatementnode(right).right;
  292. tstatementnode(right).right:=nil;
  293. right.free;
  294. right:=result;
  295. result:=nil;
  296. end;
  297. { Remove initial nothingn if there are other statements. If there }
  298. { are no other statements, returning nil doesn't help (will be }
  299. { interpreted as "can't be simplified") and replacing the }
  300. { statementnode with a nothingnode cannot be done (because it's }
  301. { possible this statementnode is a child of a blocknode, and }
  302. { blocknodes are expected to only contain statementnodes) }
  303. if (left.nodetype = nothingn) and
  304. assigned(right) then
  305. begin
  306. result:=right;
  307. right:=nil;
  308. exit;
  309. end;
  310. { if the current statement contains a block with one statement, }
  311. { replace the current statement with that block's statement }
  312. { (but only if the block does not have nf_block_with_exit set }
  313. { or has no exit statement, because otherwise it needs an own }
  314. { exit label, see tests/test/tinline10) }
  315. if (left.nodetype = blockn) and
  316. (not(nf_block_with_exit in left.flags) or
  317. no_exit_statement_in_block(left)) and
  318. assigned(tblocknode(left).left) and
  319. not assigned(tstatementnode(tblocknode(left).left).right) then
  320. begin
  321. result:=tblocknode(left).left;
  322. tstatementnode(result).right:=right;
  323. right:=nil;
  324. tblocknode(left).left:=nil;
  325. exit;
  326. end;
  327. end;
  328. function tstatementnode.pass_typecheck:tnode;
  329. begin
  330. result:=nil;
  331. resultdef:=voidtype;
  332. { left is the statement itself calln assignn or a complex one }
  333. typecheckpass(left);
  334. if codegenerror then
  335. exit;
  336. { right is the next statement in the list }
  337. if assigned(right) then
  338. typecheckpass(right);
  339. if codegenerror then
  340. exit;
  341. end;
  342. function tstatementnode.pass_1 : tnode;
  343. begin
  344. result:=nil;
  345. { left is the statement itself calln assignn or a complex one }
  346. firstpass(left);
  347. if codegenerror then
  348. exit;
  349. expectloc:=left.expectloc;
  350. { right is the next in the list }
  351. if assigned(right) then
  352. firstpass(right);
  353. if codegenerror then
  354. exit;
  355. end;
  356. procedure tstatementnode.printnodetree(var t:text);
  357. begin
  358. printnodelist(t);
  359. end;
  360. {*****************************************************************************
  361. TBLOCKNODE
  362. *****************************************************************************}
  363. constructor tblocknode.create(l : tnode);
  364. begin
  365. inherited create(blockn,l);
  366. end;
  367. destructor tblocknode.destroy;
  368. var
  369. hp, next: tstatementnode;
  370. begin
  371. hp := tstatementnode(left);
  372. left := nil;
  373. while assigned(hp) do
  374. begin
  375. next := tstatementnode(hp.right);
  376. hp.right := nil;
  377. hp.free;
  378. hp := next;
  379. end;
  380. inherited destroy;
  381. end;
  382. function tblocknode.simplify(forinline : boolean): tnode;
  383. begin
  384. result := nil;
  385. { Warning: never replace a blocknode with another node type, }
  386. { since the block may be the main block of a procedure/function/ }
  387. { main program body, and those nodes should always be blocknodes }
  388. { since that's what the compiler expects elsewhere. }
  389. { if the current block contains only one statement, and }
  390. { this one statement only contains another block, replace }
  391. { this block with that other block. }
  392. if assigned(left) and
  393. not assigned(tstatementnode(left).right) and
  394. (tstatementnode(left).left.nodetype = blockn) then
  395. begin
  396. result:=tstatementnode(left).left;
  397. tstatementnode(left).left:=nil;
  398. { make sure the nf_block_with_exit flag is safeguarded }
  399. result.flags:=result.flags+(flags * [nf_block_with_exit]);
  400. exit;
  401. end;
  402. end;
  403. function tblocknode.pass_typecheck:tnode;
  404. var
  405. hp : tstatementnode;
  406. begin
  407. result:=nil;
  408. resultdef:=voidtype;
  409. hp:=tstatementnode(left);
  410. while assigned(hp) do
  411. begin
  412. if assigned(hp.left) then
  413. begin
  414. codegenerror:=false;
  415. typecheckpass(hp.left);
  416. { the resultdef of the block is the last type that is
  417. returned. Normally this is a voidtype. But when the
  418. compiler inserts a block of multiple statements then the
  419. last entry can return a value }
  420. resultdef:=hp.left.resultdef;
  421. end;
  422. hp:=tstatementnode(hp.right);
  423. end;
  424. end;
  425. function tblocknode.pass_1 : tnode;
  426. var
  427. hp : tstatementnode;
  428. count : longint;
  429. begin
  430. result:=nil;
  431. expectloc:=LOC_VOID;
  432. count:=0;
  433. hp:=tstatementnode(left);
  434. while assigned(hp) do
  435. begin
  436. if assigned(hp.left) then
  437. begin
  438. codegenerror:=false;
  439. firstpass(hp.left);
  440. hp.expectloc:=hp.left.expectloc;
  441. end;
  442. expectloc:=hp.expectloc;
  443. inc(count);
  444. hp:=tstatementnode(hp.right);
  445. end;
  446. end;
  447. {$ifdef state_tracking}
  448. function Tblocknode.track_state_pass(exec_known:boolean):boolean;
  449. var hp:Tstatementnode;
  450. begin
  451. track_state_pass:=false;
  452. hp:=Tstatementnode(left);
  453. while assigned(hp) do
  454. begin
  455. if hp.left.track_state_pass(exec_known) then
  456. track_state_pass:=true;
  457. hp:=Tstatementnode(hp.right);
  458. end;
  459. end;
  460. {$endif state_tracking}
  461. {*****************************************************************************
  462. TASMNODE
  463. *****************************************************************************}
  464. constructor tasmnode.create(p : TAsmList);
  465. begin
  466. inherited create(asmn);
  467. p_asm:=p;
  468. currenttai:=nil;
  469. used_regs_int:=[];
  470. used_regs_fpu:=[];
  471. end;
  472. constructor tasmnode.create_get_position;
  473. begin
  474. inherited create(asmn);
  475. p_asm:=nil;
  476. include(flags,nf_get_asm_position);
  477. currenttai:=nil;
  478. end;
  479. destructor tasmnode.destroy;
  480. begin
  481. if assigned(p_asm) then
  482. p_asm.free;
  483. inherited destroy;
  484. end;
  485. constructor tasmnode.ppuload(t:tnodetype;ppufile:tcompilerppufile);
  486. var
  487. hp : tai;
  488. begin
  489. inherited ppuload(t,ppufile);
  490. if not(nf_get_asm_position in flags) then
  491. begin
  492. p_asm:=TAsmList.create;
  493. repeat
  494. hp:=ppuloadai(ppufile);
  495. if hp=nil then
  496. break;
  497. p_asm.concat(hp);
  498. until false;
  499. end
  500. else
  501. p_asm:=nil;
  502. currenttai:=nil;
  503. end;
  504. procedure tasmnode.ppuwrite(ppufile:tcompilerppufile);
  505. var
  506. hp : tai;
  507. begin
  508. inherited ppuwrite(ppufile);
  509. { TODO: FIXME Add saving of register sets}
  510. if not(nf_get_asm_position in flags) then
  511. begin
  512. hp:=tai(p_asm.first);
  513. while assigned(hp) do
  514. begin
  515. ppuwriteai(ppufile,hp);
  516. hp:=tai(hp.next);
  517. end;
  518. { end is marked by a nil }
  519. ppuwriteai(ppufile,nil);
  520. end;
  521. end;
  522. procedure tasmnode.buildderefimpl;
  523. var
  524. hp : tai;
  525. begin
  526. inherited buildderefimpl;
  527. if not(nf_get_asm_position in flags) then
  528. begin
  529. hp:=tai(p_asm.first);
  530. while assigned(hp) do
  531. begin
  532. hp.buildderefimpl;
  533. hp:=tai(hp.next);
  534. end;
  535. end;
  536. end;
  537. procedure tasmnode.derefimpl;
  538. var
  539. hp : tai;
  540. begin
  541. inherited derefimpl;
  542. if not(nf_get_asm_position in flags) then
  543. begin
  544. hp:=tai(p_asm.first);
  545. while assigned(hp) do
  546. begin
  547. hp.derefimpl;
  548. hp:=tai(hp.next);
  549. end;
  550. end;
  551. end;
  552. function tasmnode.dogetcopy: tnode;
  553. var
  554. n: tasmnode;
  555. begin
  556. n := tasmnode(inherited dogetcopy);
  557. if assigned(p_asm) then
  558. begin
  559. n.p_asm:=TAsmList.create;
  560. n.p_asm.concatlistcopy(p_asm);
  561. end
  562. else n.p_asm := nil;
  563. n.currenttai:=currenttai;
  564. result:=n;
  565. end;
  566. function tasmnode.pass_typecheck:tnode;
  567. begin
  568. result:=nil;
  569. resultdef:=voidtype;
  570. if not(nf_get_asm_position in flags) then
  571. include(current_procinfo.flags,pi_has_assembler_block);
  572. end;
  573. function tasmnode.pass_1 : tnode;
  574. begin
  575. result:=nil;
  576. expectloc:=LOC_VOID;
  577. end;
  578. function tasmnode.docompare(p: tnode): boolean;
  579. begin
  580. { comparing of asmlists is not implemented (JM) }
  581. docompare := false;
  582. end;
  583. {*****************************************************************************
  584. TEMPCREATENODE
  585. *****************************************************************************}
  586. constructor ttempcreatenode.create(_typedef:tdef; _size: tcgint; _temptype: ttemptype;allowreg:boolean);
  587. begin
  588. inherited create(tempcreaten);
  589. size := _size;
  590. new(tempinfo);
  591. fillchar(tempinfo^,sizeof(tempinfo^),0);
  592. tempinfo^.typedef := _typedef;
  593. tempinfo^.temptype := _temptype;
  594. tempinfo^.owner := self;
  595. tempinfo^.withnode := nil;
  596. if allowreg and
  597. { temp must fit a single register }
  598. (tstoreddef(_typedef).is_fpuregable or
  599. (tstoreddef(_typedef).is_intregable and
  600. (_size<=TCGSize2Size[OS_64]))) and
  601. { size of register operations must be known }
  602. (def_cgsize(_typedef)<>OS_NO) and
  603. { no init/final needed }
  604. not is_managed_type(_typedef) then
  605. include(tempinfo^.flags,ti_may_be_in_reg);
  606. end;
  607. constructor ttempcreatenode.create_withnode(_typedef: tdef; _size: tcgint; _temptype: ttemptype; allowreg:boolean; withnode: tnode);
  608. begin
  609. self.create(_typedef,_size,_temptype,allowreg);
  610. tempinfo^.withnode:=withnode.getcopy;
  611. end;
  612. constructor ttempcreatenode.create_value(_typedef:tdef; _size: tcgint; _temptype: ttemptype;allowreg:boolean; templvalue: tnode);
  613. begin
  614. self.create(_typedef,_size,_temptype,allowreg);
  615. // store in ppuwrite
  616. ftemplvalue:=templvalue;
  617. // create from stored ftemplvalue in ppuload
  618. tempinfo^.tempinitcode:=cassignmentnode.create(ctemprefnode.create(self),ftemplvalue);
  619. end;
  620. function ttempcreatenode.dogetcopy: tnode;
  621. var
  622. n: ttempcreatenode;
  623. begin
  624. n := ttempcreatenode(inherited dogetcopy);
  625. n.size := size;
  626. new(n.tempinfo);
  627. fillchar(n.tempinfo^,sizeof(n.tempinfo^),0);
  628. n.tempinfo^.owner:=n;
  629. n.tempinfo^.typedef := tempinfo^.typedef;
  630. n.tempinfo^.temptype := tempinfo^.temptype;
  631. n.tempinfo^.flags := tempinfo^.flags * tempinfostoreflags;
  632. { when the tempinfo has already a hookoncopy then it is not
  633. reset by a tempdeletenode }
  634. if assigned(tempinfo^.hookoncopy) then
  635. internalerror(200211262);
  636. { signal the temprefs that the temp they point to has been copied, }
  637. { so that if the refs get copied as well, they can hook themselves }
  638. { to the copy of the temp }
  639. tempinfo^.hookoncopy := n.tempinfo;
  640. exclude(tempinfo^.flags,ti_nextref_set_hookoncopy_nil);
  641. if assigned(tempinfo^.withnode) then
  642. n.tempinfo^.withnode := tempinfo^.withnode.getcopy
  643. else
  644. n.tempinfo^.withnode := nil;
  645. if assigned(tempinfo^.tempinitcode) then
  646. n.tempinfo^.tempinitcode := tempinfo^.tempinitcode.getcopy
  647. else
  648. n.tempinfo^.tempinitcode := nil;
  649. result := n;
  650. end;
  651. constructor ttempcreatenode.ppuload(t:tnodetype;ppufile:tcompilerppufile);
  652. begin
  653. inherited ppuload(t,ppufile);
  654. size:=ppufile.getlongint;
  655. new(tempinfo);
  656. fillchar(tempinfo^,sizeof(tempinfo^),0);
  657. ppufile.getsmallset(tempinfo^.flags);
  658. ppufile.getderef(tempinfo^.typedefderef);
  659. tempinfo^.temptype := ttemptype(ppufile.getbyte);
  660. tempinfo^.owner:=self;
  661. tempinfo^.withnode:=ppuloadnode(ppufile);
  662. ftemplvalue:=ppuloadnode(ppufile);
  663. end;
  664. procedure ttempcreatenode.ppuwrite(ppufile:tcompilerppufile);
  665. begin
  666. inherited ppuwrite(ppufile);
  667. ppufile.putlongint(size);
  668. ppufile.putsmallset(tempinfo^.flags);
  669. ppufile.putderef(tempinfo^.typedefderef);
  670. ppufile.putbyte(byte(tempinfo^.temptype));
  671. ppuwritenode(ppufile,tempinfo^.withnode);
  672. ppuwritenode(ppufile,ftemplvalue);
  673. end;
  674. procedure ttempcreatenode.buildderefimpl;
  675. begin
  676. inherited buildderefimpl;
  677. tempinfo^.typedefderef.build(tempinfo^.typedef);
  678. if assigned(tempinfo^.withnode) then
  679. tempinfo^.withnode.buildderefimpl;
  680. if assigned(ftemplvalue) then
  681. ftemplvalue.buildderefimpl;
  682. end;
  683. procedure ttempcreatenode.derefimpl;
  684. begin
  685. inherited derefimpl;
  686. tempinfo^.typedef:=tdef(tempinfo^.typedefderef.resolve);
  687. if assigned(tempinfo^.withnode) then
  688. tempinfo^.withnode.derefimpl;
  689. if assigned(ftemplvalue) then
  690. begin
  691. ftemplvalue.derefimpl;
  692. tempinfo^.tempinitcode:=cassignmentnode.create(ctemprefnode.create(self),ftemplvalue);
  693. end;
  694. end;
  695. function ttempcreatenode.pass_1 : tnode;
  696. begin
  697. result := nil;
  698. expectloc:=LOC_VOID;
  699. if (tempinfo^.typedef.needs_inittable) then
  700. include(current_procinfo.flags,pi_needs_implicit_finally);
  701. if assigned(tempinfo^.withnode) then
  702. firstpass(tempinfo^.withnode);
  703. if assigned(tempinfo^.tempinitcode) then
  704. firstpass(tempinfo^.tempinitcode);
  705. end;
  706. function ttempcreatenode.pass_typecheck: tnode;
  707. begin
  708. result := nil;
  709. { a tempcreatenode doesn't have a resultdef, only temprefnodes do }
  710. resultdef := voidtype;
  711. if assigned(tempinfo^.withnode) then
  712. typecheckpass(tempinfo^.withnode);
  713. if assigned(tempinfo^.tempinitcode) then
  714. typecheckpass(tempinfo^.tempinitcode);
  715. end;
  716. function ttempcreatenode.docompare(p: tnode): boolean;
  717. begin
  718. result :=
  719. inherited docompare(p) and
  720. (ttempcreatenode(p).size = size) and
  721. (ttempcreatenode(p).tempinfo^.flags*tempinfostoreflags=tempinfo^.flags*tempinfostoreflags) and
  722. equal_defs(ttempcreatenode(p).tempinfo^.typedef,tempinfo^.typedef) and
  723. (ttempcreatenode(p).tempinfo^.withnode.isequal(tempinfo^.withnode)) and
  724. (ttempcreatenode(p).tempinfo^.tempinitcode.isequal(tempinfo^.tempinitcode));
  725. end;
  726. procedure ttempcreatenode.printnodedata(var t:text);
  727. begin
  728. inherited printnodedata(t);
  729. writeln(t,printnodeindention,'size = ',size,', temptypedef = ',tempinfo^.typedef.typesymbolprettyname,' = "',
  730. tempinfo^.typedef.GetTypeName,'", tempinfo = $',hexstr(ptrint(tempinfo),sizeof(ptrint)*2));
  731. end;
  732. {*****************************************************************************
  733. TEMPREFNODE
  734. *****************************************************************************}
  735. constructor ttemprefnode.create(const temp: ttempcreatenode);
  736. begin
  737. inherited create(temprefn);
  738. tempinfo := temp.tempinfo;
  739. offset:=0;
  740. end;
  741. constructor ttemprefnode.create_offset(const temp: ttempcreatenode;aoffset:longint);
  742. begin
  743. self.create(temp);
  744. offset := aoffset;
  745. end;
  746. function ttemprefnode.dogetcopy: tnode;
  747. var
  748. n: ttemprefnode;
  749. begin
  750. n := ttemprefnode(inherited dogetcopy);
  751. n.offset := offset;
  752. if assigned(tempinfo^.hookoncopy) then
  753. { if the temp has been copied, assume it becomes a new }
  754. { temp which has to be hooked by the copied reference }
  755. begin
  756. { hook the ref to the copied temp }
  757. n.tempinfo := tempinfo^.hookoncopy;
  758. { if we passed a ttempdeletenode that changed the temp }
  759. { from a persistent one into a normal one, we must be }
  760. { the last reference (since our parent should free the }
  761. { temp (JM) }
  762. if (ti_nextref_set_hookoncopy_nil in tempinfo^.flags) then
  763. tempinfo^.hookoncopy := nil;
  764. end
  765. else
  766. { if the temp we refer to hasn't been copied, assume }
  767. { we're just a new reference to that temp }
  768. begin
  769. n.tempinfo := tempinfo;
  770. end;
  771. if not assigned(n.tempinfo) then
  772. internalerror(2005071901);
  773. result := n;
  774. end;
  775. constructor ttemprefnode.ppuload(t:tnodetype;ppufile:tcompilerppufile);
  776. begin
  777. inherited ppuload(t,ppufile);
  778. tempidx:=ppufile.getlongint;
  779. offset:=ppufile.getlongint;
  780. end;
  781. procedure ttemprefnode.ppuwrite(ppufile:tcompilerppufile);
  782. begin
  783. inherited ppuwrite(ppufile);
  784. ppufile.putlongint(tempinfo^.owner.ppuidx);
  785. ppufile.putlongint(offset);
  786. end;
  787. procedure ttemprefnode.resolveppuidx;
  788. var
  789. temp : ttempcreatenode;
  790. begin
  791. temp:=ttempcreatenode(nodeppuidxget(tempidx));
  792. if temp.nodetype<>tempcreaten then
  793. internalerror(200311075);
  794. tempinfo:=temp.tempinfo;
  795. end;
  796. function ttemprefnode.pass_1 : tnode;
  797. begin
  798. expectloc := LOC_REFERENCE;
  799. if not tempinfo^.typedef.needs_inittable and
  800. (ti_may_be_in_reg in tempinfo^.flags) then
  801. begin
  802. if tempinfo^.typedef.typ=floatdef then
  803. begin
  804. if not use_vectorfpu(tempinfo^.typedef) then
  805. if (tempinfo^.temptype = tt_persistent) then
  806. expectloc := LOC_CFPUREGISTER
  807. else
  808. expectloc := LOC_FPUREGISTER
  809. else
  810. if (tempinfo^.temptype = tt_persistent) then
  811. expectloc := LOC_CMMREGISTER
  812. else
  813. expectloc := LOC_MMREGISTER
  814. end
  815. else
  816. begin
  817. if (tempinfo^.temptype = tt_persistent) then
  818. expectloc := LOC_CREGISTER
  819. else
  820. expectloc := LOC_REGISTER;
  821. end;
  822. end;
  823. result := nil;
  824. end;
  825. function ttemprefnode.pass_typecheck: tnode;
  826. begin
  827. { check if the temp is already resultdef passed }
  828. if not assigned(tempinfo^.typedef) then
  829. internalerror(200108233);
  830. result := nil;
  831. resultdef := tempinfo^.typedef;
  832. end;
  833. function ttemprefnode.docompare(p: tnode): boolean;
  834. begin
  835. result :=
  836. inherited docompare(p) and
  837. (ttemprefnode(p).tempinfo = tempinfo) and
  838. (ttemprefnode(p).offset = offset);
  839. end;
  840. procedure ttemprefnode.mark_write;
  841. begin
  842. include(flags,nf_write);
  843. end;
  844. procedure ttemprefnode.printnodedata(var t:text);
  845. begin
  846. inherited printnodedata(t);
  847. writeln(t,printnodeindention,'temptypedef = ',tempinfo^.typedef.typesymbolprettyname,' = "',
  848. tempinfo^.typedef.GetTypeName,'", tempinfo = $',hexstr(ptrint(tempinfo),sizeof(ptrint)*2));
  849. end;
  850. {*****************************************************************************
  851. TEMPDELETENODE
  852. *****************************************************************************}
  853. constructor ttempdeletenode.create(const temp: ttempcreatenode);
  854. begin
  855. inherited create(tempdeleten);
  856. tempinfo := temp.tempinfo;
  857. release_to_normal := false;
  858. end;
  859. constructor ttempdeletenode.create_normal_temp(const temp: ttempcreatenode);
  860. begin
  861. inherited create(tempdeleten);
  862. tempinfo := temp.tempinfo;
  863. release_to_normal := true;
  864. if tempinfo^.temptype <> tt_persistent then
  865. internalerror(200204211);
  866. end;
  867. function ttempdeletenode.dogetcopy: tnode;
  868. var
  869. n: ttempdeletenode;
  870. begin
  871. n:=ttempdeletenode(inherited dogetcopy);
  872. n.release_to_normal:=release_to_normal;
  873. if assigned(tempinfo^.hookoncopy) then
  874. { if the temp has been copied, assume it becomes a new }
  875. { temp which has to be hooked by the copied deletenode }
  876. begin
  877. { hook the tempdeletenode to the copied temp }
  878. n.tempinfo:=tempinfo^.hookoncopy;
  879. { the temp shall not be used, reset hookoncopy }
  880. { Only if release_to_normal is false, otherwise }
  881. { the temp can still be referenced once more (JM) }
  882. if (not release_to_normal) then
  883. tempinfo^.hookoncopy:=nil
  884. else
  885. include(tempinfo^.flags,ti_nextref_set_hookoncopy_nil);
  886. end
  887. else
  888. { if the temp we refer to hasn't been copied, we have a }
  889. { problem since that means we now have two delete nodes }
  890. { for one temp }
  891. internalerror(200108234);
  892. result:=n;
  893. end;
  894. constructor ttempdeletenode.ppuload(t:tnodetype;ppufile:tcompilerppufile);
  895. begin
  896. inherited ppuload(t,ppufile);
  897. tempidx:=ppufile.getlongint;
  898. release_to_normal:=(ppufile.getbyte<>0);
  899. end;
  900. procedure ttempdeletenode.ppuwrite(ppufile:tcompilerppufile);
  901. begin
  902. inherited ppuwrite(ppufile);
  903. ppufile.putlongint(tempinfo^.owner.ppuidx);
  904. ppufile.putbyte(byte(release_to_normal));
  905. end;
  906. procedure ttempdeletenode.resolveppuidx;
  907. var
  908. temp : ttempcreatenode;
  909. begin
  910. temp:=ttempcreatenode(nodeppuidxget(tempidx));
  911. if temp.nodetype<>tempcreaten then
  912. internalerror(200311075);
  913. tempinfo:=temp.tempinfo;
  914. end;
  915. function ttempdeletenode.pass_1 : tnode;
  916. begin
  917. expectloc:=LOC_VOID;
  918. result := nil;
  919. end;
  920. function ttempdeletenode.pass_typecheck: tnode;
  921. begin
  922. result := nil;
  923. resultdef := voidtype;
  924. end;
  925. function ttempdeletenode.docompare(p: tnode): boolean;
  926. begin
  927. result :=
  928. inherited docompare(p) and
  929. (ttemprefnode(p).tempinfo = tempinfo);
  930. end;
  931. destructor ttempdeletenode.destroy;
  932. begin
  933. if assigned(tempinfo^.withnode) then
  934. begin
  935. tempinfo^.withnode.free;
  936. end;
  937. dispose(tempinfo);
  938. end;
  939. procedure ttempdeletenode.printnodedata(var t:text);
  940. begin
  941. inherited printnodedata(t);
  942. writeln(t,printnodeindention,'release_to_normal: ',release_to_normal,', temptypedef = ',tempinfo^.typedef.typesymbolprettyname,' = "',
  943. tempinfo^.typedef.GetTypeName,'", tempinfo = $',hexstr(ptrint(tempinfo),sizeof(ptrint)*2));
  944. end;
  945. end.