nbas.pas 34 KB

123456789101112131415161718192021222324252627282930313233343536373839404142434445464748495051525354555657585960616263646566676869707172737475767778798081828384858687888990919293949596979899100101102103104105106107108109110111112113114115116117118119120121122123124125126127128129130131132133134135136137138139140141142143144145146147148149150151152153154155156157158159160161162163164165166167168169170171172173174175176177178179180181182183184185186187188189190191192193194195196197198199200201202203204205206207208209210211212213214215216217218219220221222223224225226227228229230231232233234235236237238239240241242243244245246247248249250251252253254255256257258259260261262263264265266267268269270271272273274275276277278279280281282283284285286287288289290291292293294295296297298299300301302303304305306307308309310311312313314315316317318319320321322323324325326327328329330331332333334335336337338339340341342343344345346347348349350351352353354355356357358359360361362363364365366367368369370371372373374375376377378379380381382383384385386387388389390391392393394395396397398399400401402403404405406407408409410411412413414415416417418419420421422423424425426427428429430431432433434435436437438439440441442443444445446447448449450451452453454455456457458459460461462463464465466467468469470471472473474475476477478479480481482483484485486487488489490491492493494495496497498499500501502503504505506507508509510511512513514515516517518519520521522523524525526527528529530531532533534535536537538539540541542543544545546547548549550551552553554555556557558559560561562563564565566567568569570571572573574575576577578579580581582583584585586587588589590591592593594595596597598599600601602603604605606607608609610611612613614615616617618619620621622623624625626627628629630631632633634635636637638639640641642643644645646647648649650651652653654655656657658659660661662663664665666667668669670671672673674675676677678679680681682683684685686687688689690691692693694695696697698699700701702703704705706707708709710711712713714715716717718719720721722723724725726727728729730731732733734735736737738739740741742743744745746747748749750751752753754755756757758759760761762763764765766767768769770771772773774775776777778779780781782783784785786787788789790791792793794795796797798799800801802803804805806807808809810811812813814815816817818819820821822823824825826827828829830831832833834835836837838839840841842843844845846847848849850851852853854855856857858859860861862863864865866867868869870871872873874875876877878879880881882883884885886887888889890891892893894895896897898899900901902903904905906907908909910911912913914915916917918919920921922923924925926927928929930931932933934935936937938939940941942943944945946947948949950951952953954955956957958959960961962963964965966967968969970971972973974975976977978979980981982983984985986987988989990991
  1. {
  2. $Id$
  3. Copyright (c) 2000-2002 by Florian Klaempfl
  4. This unit implements some basic nodes
  5. This program is free software; you can redistribute it and/or modify
  6. it under the terms of the GNU General Public License as published by
  7. the Free Software Foundation; either version 2 of the License, or
  8. (at your option) any later version.
  9. This program is distributed in the hope that it will be useful,
  10. but WITHOUT ANY WARRANTY; without even the implied warranty of
  11. MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
  12. GNU General Public License for more details.
  13. You should have received a copy of the GNU General Public License
  14. along with this program; if not, write to the Free Software
  15. Foundation, Inc., 675 Mass Ave, Cambridge, MA 02139, USA.
  16. ****************************************************************************
  17. }
  18. unit nbas;
  19. {$i fpcdefs.inc}
  20. interface
  21. uses
  22. cpubase,
  23. aasmbase,aasmtai,aasmcpu,
  24. node,
  25. tgobj,
  26. symtype,symppu;
  27. type
  28. tnothingnode = class(tnode)
  29. constructor create;virtual;
  30. function pass_1 : tnode;override;
  31. function det_resulttype:tnode;override;
  32. end;
  33. tnothingnodeclass = class of tnothingnode;
  34. terrornode = class(tnode)
  35. constructor create;virtual;
  36. function pass_1 : tnode;override;
  37. function det_resulttype:tnode;override;
  38. procedure mark_write;override;
  39. end;
  40. terrornodeclass = class of terrornode;
  41. tasmnode = class(tnode)
  42. p_asm : taasmoutput;
  43. constructor create(p : taasmoutput);virtual;
  44. destructor destroy;override;
  45. constructor ppuload(t:tnodetype;ppufile:tcompilerppufile);override;
  46. procedure ppuwrite(ppufile:tcompilerppufile);override;
  47. procedure derefimpl;override;
  48. function getcopy : tnode;override;
  49. function pass_1 : tnode;override;
  50. function det_resulttype:tnode;override;
  51. function docompare(p: tnode): boolean; override;
  52. end;
  53. tasmnodeclass = class of tasmnode;
  54. tstatementnode = class(tbinarynode)
  55. constructor create(l,r : tnode);virtual;
  56. function pass_1 : tnode;override;
  57. function det_resulttype:tnode;override;
  58. procedure printnodetree(var t:text);override;
  59. end;
  60. tstatementnodeclass = class of tstatementnode;
  61. tblocknode = class(tunarynode)
  62. constructor create(l : tnode;releasetemp : boolean);virtual;
  63. function pass_1 : tnode;override;
  64. function det_resulttype:tnode;override;
  65. {$ifdef state_tracking}
  66. function track_state_pass(exec_known:boolean):boolean;override;
  67. {$endif state_tracking}
  68. end;
  69. tblocknodeclass = class of tblocknode;
  70. { to allow access to the location by temp references even after the temp has }
  71. { already been disposed and to make sure the coherency between temps and }
  72. { temp references is kept after a getcopy }
  73. ptempinfo = ^ttempinfo;
  74. ttempinfo = record
  75. { set to the copy of a tempcreate pnode (if it gets copied) so that the }
  76. { refs and deletenode can hook to this copy once they get copied too }
  77. hookoncopy : ptempinfo;
  78. ref : treference;
  79. restype : ttype;
  80. temptype : ttemptype;
  81. valid : boolean;
  82. nextref_set_hookoncopy_nil : boolean;
  83. end;
  84. { a node which will create a (non)persistent temp of a given type with a given }
  85. { size (the size is separate to allow creating "void" temps with a custom size) }
  86. ttempcreatenode = class(tnode)
  87. size: longint;
  88. temptype: ttemptype;
  89. tempinfo: ptempinfo;
  90. { * persistent temps are used in manually written code where the temp }
  91. { be usable among different statements and where you can manually say }
  92. { when the temp has to be freed (using a ttempdeletenode) }
  93. { * non-persistent temps are mostly used in typeconversion helpers, }
  94. { where the node that receives the temp becomes responsible for }
  95. { freeing it. In this last case, you should use only one reference }
  96. { to it and *not* generate a ttempdeletenode }
  97. constructor create(const _restype: ttype; _size: longint; _temptype: ttemptype); virtual;
  98. function getcopy: tnode; override;
  99. function pass_1 : tnode; override;
  100. function det_resulttype: tnode; override;
  101. function docompare(p: tnode): boolean; override;
  102. procedure printnodedata(var t:text);override;
  103. end;
  104. ttempcreatenodeclass = class of ttempcreatenode;
  105. { a node which is a reference to a certain temp }
  106. ttemprefnode = class(tnode)
  107. constructor create(const temp: ttempcreatenode); virtual;
  108. constructor create_offset(const temp: ttempcreatenode;aoffset:longint);
  109. function getcopy: tnode; override;
  110. function pass_1 : tnode; override;
  111. function det_resulttype : tnode; override;
  112. procedure mark_write;override;
  113. function docompare(p: tnode): boolean; override;
  114. protected
  115. tempinfo: ptempinfo;
  116. offset : longint;
  117. end;
  118. ttemprefnodeclass = class of ttemprefnode;
  119. { a node which removes a temp }
  120. ttempdeletenode = class(tnode)
  121. constructor create(const temp: ttempcreatenode);
  122. { this will convert the persistant temp to a normal temp
  123. for returning to the other nodes }
  124. constructor create_normal_temp(const temp: ttempcreatenode);
  125. function getcopy: tnode; override;
  126. function pass_1: tnode; override;
  127. function det_resulttype: tnode; override;
  128. function docompare(p: tnode): boolean; override;
  129. destructor destroy; override;
  130. protected
  131. tempinfo: ptempinfo;
  132. release_to_normal : boolean;
  133. end;
  134. ttempdeletenodeclass = class of ttempdeletenode;
  135. var
  136. cnothingnode : tnothingnodeclass;
  137. cerrornode : terrornodeclass;
  138. casmnode : tasmnodeclass;
  139. cstatementnode : tstatementnodeclass;
  140. cblocknode : tblocknodeclass;
  141. ctempcreatenode : ttempcreatenodeclass;
  142. ctemprefnode : ttemprefnodeclass;
  143. ctempdeletenode : ttempdeletenodeclass;
  144. { Create a blocknode and statement node for multiple statements
  145. generated internally by the parser }
  146. function internalstatements(var laststatement:tstatementnode;releasetemp : boolean):tblocknode;
  147. procedure addstatement(var laststatement:tstatementnode;n:tnode);
  148. implementation
  149. uses
  150. cutils,
  151. verbose,globals,globtype,systems,
  152. symconst,symdef,symsym,symutil,defutil,defcmp,
  153. pass_1,
  154. nld,ncal,nflw,rgobj,cginfo,cgbase
  155. ;
  156. {*****************************************************************************
  157. Helpers
  158. *****************************************************************************}
  159. function internalstatements(var laststatement:tstatementnode;releasetemp : boolean):tblocknode;
  160. begin
  161. { create dummy initial statement }
  162. laststatement := cstatementnode.create(cnothingnode.create,nil);
  163. internalstatements := cblocknode.create(laststatement,releasetemp);
  164. end;
  165. procedure addstatement(var laststatement:tstatementnode;n:tnode);
  166. begin
  167. if assigned(laststatement.right) then
  168. internalerror(200204201);
  169. laststatement.right:=cstatementnode.create(n,nil);
  170. laststatement:=tstatementnode(laststatement.right);
  171. end;
  172. {*****************************************************************************
  173. TFIRSTNOTHING
  174. *****************************************************************************}
  175. constructor tnothingnode.create;
  176. begin
  177. inherited create(nothingn);
  178. end;
  179. function tnothingnode.det_resulttype:tnode;
  180. begin
  181. result:=nil;
  182. resulttype:=voidtype;
  183. end;
  184. function tnothingnode.pass_1 : tnode;
  185. begin
  186. result:=nil;
  187. expectloc:=LOC_VOID;
  188. end;
  189. {*****************************************************************************
  190. TFIRSTERROR
  191. *****************************************************************************}
  192. constructor terrornode.create;
  193. begin
  194. inherited create(errorn);
  195. end;
  196. function terrornode.det_resulttype:tnode;
  197. begin
  198. result:=nil;
  199. include(flags,nf_error);
  200. codegenerror:=true;
  201. resulttype:=generrortype;
  202. end;
  203. function terrornode.pass_1 : tnode;
  204. begin
  205. result:=nil;
  206. expectloc:=LOC_VOID;
  207. codegenerror:=true;
  208. end;
  209. procedure terrornode.mark_write;
  210. begin
  211. end;
  212. {*****************************************************************************
  213. TSTATEMENTNODE
  214. *****************************************************************************}
  215. constructor tstatementnode.create(l,r : tnode);
  216. begin
  217. inherited create(statementn,l,r);
  218. end;
  219. function tstatementnode.det_resulttype:tnode;
  220. begin
  221. result:=nil;
  222. resulttype:=voidtype;
  223. { left is the statement itself calln assignn or a complex one }
  224. resulttypepass(left);
  225. if (not (cs_extsyntax in aktmoduleswitches)) and
  226. assigned(left.resulttype.def) and
  227. not((left.nodetype=calln) and
  228. { don't complain when funcretrefnode is set, because then the
  229. value is already used. And also not for constructors }
  230. (assigned(tcallnode(left).funcretnode) or
  231. (tcallnode(left).procdefinition.proctypeoption=potype_constructor))) and
  232. not(is_void(left.resulttype.def)) then
  233. CGMessage(cg_e_illegal_expression);
  234. if codegenerror then
  235. exit;
  236. { right is the next statement in the list }
  237. if assigned(right) then
  238. resulttypepass(right);
  239. if codegenerror then
  240. exit;
  241. end;
  242. function tstatementnode.pass_1 : tnode;
  243. begin
  244. result:=nil;
  245. { left is the statement itself calln assignn or a complex one }
  246. firstpass(left);
  247. if codegenerror then
  248. exit;
  249. expectloc:=left.expectloc;
  250. registers32:=left.registers32;
  251. registersfpu:=left.registersfpu;
  252. {$ifdef SUPPORT_MMX}
  253. registersmmx:=left.registersmmx;
  254. {$endif SUPPORT_MMX}
  255. { right is the next in the list }
  256. if assigned(right) then
  257. firstpass(right);
  258. if codegenerror then
  259. exit;
  260. end;
  261. procedure tstatementnode.printnodetree(var t:text);
  262. begin
  263. printnodelist(t);
  264. end;
  265. {*****************************************************************************
  266. TBLOCKNODE
  267. *****************************************************************************}
  268. constructor tblocknode.create(l : tnode;releasetemp : boolean);
  269. begin
  270. inherited create(blockn,l);
  271. {$ifndef newra}
  272. if releasetemp then
  273. include(flags,nf_releasetemps);
  274. {$endif newra}
  275. end;
  276. function tblocknode.det_resulttype:tnode;
  277. var
  278. hp : tstatementnode;
  279. begin
  280. result:=nil;
  281. resulttype:=voidtype;
  282. hp:=tstatementnode(left);
  283. while assigned(hp) do
  284. begin
  285. if assigned(hp.left) then
  286. begin
  287. codegenerror:=false;
  288. resulttypepass(hp.left);
  289. if (not (cs_extsyntax in aktmoduleswitches)) and
  290. assigned(hp.left.resulttype.def) and
  291. not((hp.left.nodetype=calln) and
  292. { don't complain when funcretnode is set, because then the
  293. value is already used. And also not for constructors }
  294. (assigned(tcallnode(hp.left).funcretnode) or
  295. (tcallnode(hp.left).procdefinition.proctypeoption=potype_constructor))) and
  296. not(is_void(hp.left.resulttype.def)) then
  297. CGMessagePos(hp.left.fileinfo,cg_e_illegal_expression);
  298. { the resulttype of the block is the last type that is
  299. returned. Normally this is a voidtype. But when the
  300. compiler inserts a block of multiple statements then the
  301. last entry can return a value }
  302. resulttype:=hp.left.resulttype;
  303. end;
  304. hp:=tstatementnode(hp.right);
  305. end;
  306. end;
  307. function tblocknode.pass_1 : tnode;
  308. var
  309. hp : tstatementnode;
  310. count : longint;
  311. begin
  312. result:=nil;
  313. expectloc:=LOC_VOID;
  314. count:=0;
  315. hp:=tstatementnode(left);
  316. while assigned(hp) do
  317. begin
  318. (*
  319. if cs_regalloc in aktglobalswitches then
  320. begin
  321. { node transformations }
  322. { concat function result to exit }
  323. { this is wrong for string or other complex
  324. result types !!! }
  325. if {ret_in_acc(current_procdef.rettype.def) and }
  326. (is_ordinal(current_procdef.rettype.def) or
  327. is_smallset(current_procdef.rettype.def)) and
  328. assigned(hp.right) and
  329. assigned(tstatementnode(hp.right).left) and
  330. (tstatementnode(hp.right).left.nodetype=exitn) and
  331. (hp.left.nodetype=assignn) and
  332. { !!!! this tbinarynode should be tassignmentnode }
  333. (tbinarynode(hp.left).left.nodetype=loadn) and
  334. (is_funcret_sym(tloadnode(tbinarynode(hp.left).left).symtableentry)) then
  335. begin
  336. if assigned(texitnode(tstatementnode(hp.right).left).left) then
  337. CGMessage(cg_n_inefficient_code)
  338. else
  339. begin
  340. texitnode(tstatementnode(hp.right).left).left:=tassignmentnode(hp.left).right;
  341. tassignmentnode(hp.left).right:=nil;
  342. hp.left.free;
  343. hp.left:=nil;
  344. end;
  345. end
  346. { warning if unreachable code occurs and elimate this }
  347. else if (hp.left.nodetype in
  348. [exitn,breakn,continuen,goton]) and
  349. { statement node (JM) }
  350. assigned(hp.right) and
  351. { kind of statement! (JM) }
  352. assigned(tstatementnode(hp.right).left) and
  353. (tstatementnode(hp.right).left.nodetype<>labeln) then
  354. begin
  355. { use correct line number }
  356. aktfilepos:=hp.right.fileinfo;
  357. hp.right.free;
  358. hp.right:=nil;
  359. CGMessage(cg_w_unreachable_code);
  360. { old lines }
  361. aktfilepos:=hp.left.fileinfo;
  362. end;
  363. end;
  364. *)
  365. if assigned(hp.left) then
  366. begin
  367. codegenerror:=false;
  368. firstpass(hp.left);
  369. hp.expectloc:=hp.left.expectloc;
  370. hp.registers32:=hp.left.registers32;
  371. hp.registersfpu:=hp.left.registersfpu;
  372. {$ifdef SUPPORT_MMX}
  373. hp.registersmmx:=hp.left.registersmmx;
  374. {$endif SUPPORT_MMX}
  375. end
  376. else
  377. hp.registers32:=0;
  378. if hp.registers32>registers32 then
  379. registers32:=hp.registers32;
  380. if hp.registersfpu>registersfpu then
  381. registersfpu:=hp.registersfpu;
  382. {$ifdef SUPPORT_MMX}
  383. if hp.registersmmx>registersmmx then
  384. registersmmx:=hp.registersmmx;
  385. {$endif}
  386. expectloc:=hp.expectloc;
  387. inc(count);
  388. hp:=tstatementnode(hp.right);
  389. end;
  390. end;
  391. {$ifdef state_tracking}
  392. function Tblocknode.track_state_pass(exec_known:boolean):boolean;
  393. var hp:Tstatementnode;
  394. begin
  395. track_state_pass:=false;
  396. hp:=Tstatementnode(left);
  397. while assigned(hp) do
  398. begin
  399. if hp.left.track_state_pass(exec_known) then
  400. track_state_pass:=true;
  401. hp:=Tstatementnode(hp.right);
  402. end;
  403. end;
  404. {$endif state_tracking}
  405. {*****************************************************************************
  406. TASMNODE
  407. *****************************************************************************}
  408. constructor tasmnode.create(p : taasmoutput);
  409. begin
  410. inherited create(asmn);
  411. p_asm:=p;
  412. end;
  413. destructor tasmnode.destroy;
  414. begin
  415. if assigned(p_asm) then
  416. p_asm.free;
  417. inherited destroy;
  418. end;
  419. constructor tasmnode.ppuload(t:tnodetype;ppufile:tcompilerppufile);
  420. var
  421. hp : tai;
  422. begin
  423. inherited ppuload(t,ppufile);
  424. p_asm:=taasmoutput.create;
  425. repeat
  426. hp:=ppuloadai(ppufile);
  427. if hp=nil then
  428. break;
  429. p_asm.concat(hp);
  430. until false;
  431. end;
  432. procedure tasmnode.ppuwrite(ppufile:tcompilerppufile);
  433. var
  434. hp : tai;
  435. begin
  436. inherited ppuwrite(ppufile);
  437. hp:=tai(p_asm.first);
  438. while assigned(hp) do
  439. begin
  440. ppuwriteai(ppufile,hp);
  441. hp:=tai(hp.next);
  442. end;
  443. { end is marked by a nil }
  444. ppuwriteai(ppufile,nil);
  445. end;
  446. procedure tasmnode.derefimpl;
  447. var
  448. hp : tai;
  449. begin
  450. inherited derefimpl;
  451. hp:=tai(p_asm.first);
  452. while assigned(hp) do
  453. begin
  454. hp.derefimpl;
  455. hp:=tai(hp.next);
  456. end;
  457. end;
  458. function tasmnode.getcopy: tnode;
  459. var
  460. n: tasmnode;
  461. begin
  462. n := tasmnode(inherited getcopy);
  463. if assigned(p_asm) then
  464. begin
  465. n.p_asm:=taasmoutput.create;
  466. n.p_asm.concatlistcopy(p_asm);
  467. end
  468. else n.p_asm := nil;
  469. getcopy := n;
  470. end;
  471. function tasmnode.det_resulttype:tnode;
  472. begin
  473. result:=nil;
  474. resulttype:=voidtype;
  475. include(current_procinfo.flags,pi_uses_asm);
  476. end;
  477. function tasmnode.pass_1 : tnode;
  478. begin
  479. result:=nil;
  480. expectloc:=LOC_VOID;
  481. end;
  482. function tasmnode.docompare(p: tnode): boolean;
  483. begin
  484. { comparing of asmlists is not implemented (JM) }
  485. docompare := false;
  486. end;
  487. {*****************************************************************************
  488. TEMPCREATENODE
  489. *****************************************************************************}
  490. constructor ttempcreatenode.create(const _restype: ttype; _size: longint; _temptype: ttemptype);
  491. begin
  492. inherited create(tempcreaten);
  493. size := _size;
  494. new(tempinfo);
  495. fillchar(tempinfo^,sizeof(tempinfo^),0);
  496. tempinfo^.restype := _restype;
  497. temptype := _temptype;
  498. end;
  499. function ttempcreatenode.getcopy: tnode;
  500. var
  501. n: ttempcreatenode;
  502. begin
  503. n := ttempcreatenode(inherited getcopy);
  504. n.size := size;
  505. n.temptype := temptype;
  506. new(n.tempinfo);
  507. fillchar(n.tempinfo^,sizeof(n.tempinfo^),0);
  508. n.tempinfo^.restype := tempinfo^.restype;
  509. { when the tempinfo has already a hookoncopy then it is not
  510. reset by a tempdeletenode }
  511. if assigned(tempinfo^.hookoncopy) then
  512. internalerror(200211262);
  513. { signal the temprefs that the temp they point to has been copied, }
  514. { so that if the refs get copied as well, they can hook themselves }
  515. { to the copy of the temp }
  516. tempinfo^.hookoncopy := n.tempinfo;
  517. tempinfo^.nextref_set_hookoncopy_nil := false;
  518. result := n;
  519. end;
  520. function ttempcreatenode.pass_1 : tnode;
  521. begin
  522. result := nil;
  523. expectloc:=LOC_VOID;
  524. end;
  525. function ttempcreatenode.det_resulttype: tnode;
  526. begin
  527. result := nil;
  528. { a tempcreatenode doesn't have a resulttype, only temprefnodes do }
  529. resulttype := voidtype;
  530. end;
  531. function ttempcreatenode.docompare(p: tnode): boolean;
  532. begin
  533. result :=
  534. inherited docompare(p) and
  535. (ttempcreatenode(p).size = size) and
  536. equal_defs(ttempcreatenode(p).tempinfo^.restype.def,tempinfo^.restype.def);
  537. end;
  538. procedure ttempcreatenode.printnodedata(var t:text);
  539. begin
  540. inherited printnodedata(t);
  541. writeln(t,printnodeindention,'size = ',size);
  542. end;
  543. {*****************************************************************************
  544. TEMPREFNODE
  545. *****************************************************************************}
  546. constructor ttemprefnode.create(const temp: ttempcreatenode);
  547. begin
  548. inherited create(temprefn);
  549. tempinfo := temp.tempinfo;
  550. offset:=0;
  551. end;
  552. constructor ttemprefnode.create_offset(const temp: ttempcreatenode;aoffset:longint);
  553. begin
  554. self.create(temp);
  555. offset := aoffset;
  556. end;
  557. function ttemprefnode.getcopy: tnode;
  558. var
  559. n: ttemprefnode;
  560. begin
  561. n := ttemprefnode(inherited getcopy);
  562. n.offset := offset;
  563. if assigned(tempinfo^.hookoncopy) then
  564. { if the temp has been copied, assume it becomes a new }
  565. { temp which has to be hooked by the copied reference }
  566. begin
  567. { hook the ref to the copied temp }
  568. n.tempinfo := tempinfo^.hookoncopy;
  569. { if we passed a ttempdeletenode that changed the temp }
  570. { from a persistent one into a normal one, we must be }
  571. { the last reference (since our parent should free the }
  572. { temp (JM) }
  573. if (tempinfo^.nextref_set_hookoncopy_nil) then
  574. tempinfo^.hookoncopy := nil;
  575. end
  576. else
  577. { if the temp we refer to hasn't been copied, assume }
  578. { we're just a new reference to that temp }
  579. begin
  580. n.tempinfo := tempinfo;
  581. end;
  582. result := n;
  583. end;
  584. function ttemprefnode.pass_1 : tnode;
  585. begin
  586. expectloc:=LOC_REFERENCE;
  587. result := nil;
  588. end;
  589. function ttemprefnode.det_resulttype: tnode;
  590. begin
  591. { check if the temp is already resulttype passed }
  592. if not assigned(tempinfo^.restype.def) then
  593. internalerror(200108233);
  594. result := nil;
  595. resulttype := tempinfo^.restype;
  596. end;
  597. function ttemprefnode.docompare(p: tnode): boolean;
  598. begin
  599. result :=
  600. inherited docompare(p) and
  601. (ttemprefnode(p).tempinfo = tempinfo) and
  602. (ttemprefnode(p).offset = offset);
  603. end;
  604. procedure Ttemprefnode.mark_write;
  605. begin
  606. include(flags,nf_write);
  607. end;
  608. {*****************************************************************************
  609. TEMPDELETENODE
  610. *****************************************************************************}
  611. constructor ttempdeletenode.create(const temp: ttempcreatenode);
  612. begin
  613. inherited create(tempdeleten);
  614. tempinfo := temp.tempinfo;
  615. release_to_normal := false;
  616. end;
  617. constructor ttempdeletenode.create_normal_temp(const temp: ttempcreatenode);
  618. begin
  619. inherited create(tempdeleten);
  620. tempinfo := temp.tempinfo;
  621. release_to_normal := true;
  622. if temp.temptype <> tt_persistent then
  623. internalerror(200204211);
  624. end;
  625. function ttempdeletenode.getcopy: tnode;
  626. var
  627. n: ttempdeletenode;
  628. begin
  629. n := ttempdeletenode(inherited getcopy);
  630. n.release_to_normal := release_to_normal;
  631. if assigned(tempinfo^.hookoncopy) then
  632. { if the temp has been copied, assume it becomes a new }
  633. { temp which has to be hooked by the copied deletenode }
  634. begin
  635. { hook the tempdeletenode to the copied temp }
  636. n.tempinfo := tempinfo^.hookoncopy;
  637. { the temp shall not be used, reset hookoncopy }
  638. { Only if release_to_normal is false, otherwise }
  639. { the temp can still be referenced once more (JM) }
  640. if (not release_to_normal) then
  641. tempinfo^.hookoncopy:=nil
  642. else
  643. tempinfo^.nextref_set_hookoncopy_nil := true;
  644. end
  645. else
  646. { if the temp we refer to hasn't been copied, we have a }
  647. { problem since that means we now have two delete nodes }
  648. { for one temp }
  649. internalerror(200108234);
  650. result := n;
  651. end;
  652. function ttempdeletenode.pass_1 : tnode;
  653. begin
  654. expectloc:=LOC_VOID;
  655. result := nil;
  656. end;
  657. function ttempdeletenode.det_resulttype: tnode;
  658. begin
  659. result := nil;
  660. resulttype := voidtype;
  661. end;
  662. function ttempdeletenode.docompare(p: tnode): boolean;
  663. begin
  664. result :=
  665. inherited docompare(p) and
  666. (ttemprefnode(p).tempinfo = tempinfo);
  667. end;
  668. destructor ttempdeletenode.destroy;
  669. begin
  670. dispose(tempinfo);
  671. end;
  672. begin
  673. cnothingnode:=tnothingnode;
  674. cerrornode:=terrornode;
  675. casmnode:=tasmnode;
  676. cstatementnode:=tstatementnode;
  677. cblocknode:=tblocknode;
  678. ctempcreatenode:=ttempcreatenode;
  679. ctemprefnode:=ttemprefnode;
  680. ctempdeletenode:=ttempdeletenode;
  681. end.
  682. {
  683. $Log$
  684. Revision 1.53 2003-05-30 21:01:44 jonas
  685. - disabled "result := value; exit;" -> exit(value) optimization because
  686. a) it was wrong
  687. b) exit(value) works now exactly the same as that
  688. (it was only activated with -Or)
  689. Revision 1.52 2003/05/23 14:27:35 peter
  690. * remove some unit dependencies
  691. * current_procinfo changes to store more info
  692. Revision 1.51 2003/05/17 13:30:08 jonas
  693. * changed tt_persistant to tt_persistent :)
  694. * tempcreatenode now doesn't accept a boolean anymore for persistent
  695. temps, but a ttemptype, so you can also create ansistring temps etc
  696. Revision 1.50 2003/05/13 19:14:41 peter
  697. * failn removed
  698. * inherited result code check moven to pexpr
  699. Revision 1.49 2003/05/11 14:45:12 peter
  700. * tloadnode does not support objectsymtable,withsymtable anymore
  701. * withnode cleanup
  702. * direct with rewritten to use temprefnode
  703. Revision 1.48 2003/04/27 11:21:33 peter
  704. * aktprocdef renamed to current_procdef
  705. * procinfo renamed to current_procinfo
  706. * procinfo will now be stored in current_module so it can be
  707. cleaned up properly
  708. * gen_main_procsym changed to create_main_proc and release_main_proc
  709. to also generate a tprocinfo structure
  710. * fixed unit implicit initfinal
  711. Revision 1.47 2003/04/25 20:59:33 peter
  712. * removed funcretn,funcretsym, function result is now in varsym
  713. and aliases for result and function name are added using absolutesym
  714. * vs_hidden parameter for funcret passed in parameter
  715. * vs_hidden fixes
  716. * writenode changed to printnode and released from extdebug
  717. * -vp option added to generate a tree.log with the nodetree
  718. * nicer printnode for statements, callnode
  719. Revision 1.46 2002/04/25 20:15:39 florian
  720. * block nodes within expressions shouldn't release the used registers,
  721. fixed using a flag till the new rg is ready
  722. Revision 1.45 2003/04/23 08:41:34 jonas
  723. * fixed ttemprefnode.compare and .getcopy to take offset field into
  724. account
  725. Revision 1.44 2003/04/22 23:50:22 peter
  726. * firstpass uses expectloc
  727. * checks if there are differences between the expectloc and
  728. location.loc from secondpass in EXTDEBUG
  729. Revision 1.43 2003/04/21 15:00:22 jonas
  730. * fixed tstatementnode.det_resulttype and tststatementnode.pass_1
  731. * fixed some getcopy issues with ttemp*nodes
  732. Revision 1.42 2003/04/17 07:50:24 daniel
  733. * Some work on interference graph construction
  734. Revision 1.41 2003/04/12 14:53:59 jonas
  735. * ttempdeletenode.create now sets the nodetype to tempdeleten instead of
  736. temprefn
  737. Revision 1.40 2003/03/17 20:30:46 peter
  738. * errornode.mark_write added
  739. Revision 1.39 2003/01/03 12:15:55 daniel
  740. * Removed ifdefs around notifications
  741. ifdefs around for loop optimizations remain
  742. Revision 1.38 2002/11/27 02:37:12 peter
  743. * case statement inlining added
  744. * fixed inlining of write()
  745. * switched statementnode left and right parts so the statements are
  746. processed in the correct order when getcopy is used. This is
  747. required for tempnodes
  748. Revision 1.37 2002/11/25 17:43:17 peter
  749. * splitted defbase in defutil,symutil,defcmp
  750. * merged isconvertable and is_equal into compare_defs(_ext)
  751. * made operator search faster by walking the list only once
  752. Revision 1.36 2002/10/05 15:15:19 peter
  753. * don't complain in X- mode for internal generated function calls
  754. with funcretrefnode set
  755. * give statement error at the correct line position instead of the
  756. block begin
  757. Revision 1.35 2002/09/01 08:01:16 daniel
  758. * Removed sets from Tcallnode.det_resulttype
  759. + Added read/write notifications of variables. These will be usefull
  760. for providing information for several optimizations. For example
  761. the value of the loop variable of a for loop does matter is the
  762. variable is read after the for loop, but if it's no longer used
  763. or written, it doesn't matter and this can be used to optimize
  764. the loop code generation.
  765. Revision 1.34 2002/08/18 20:06:23 peter
  766. * inlining is now also allowed in interface
  767. * renamed write/load to ppuwrite/ppuload
  768. * tnode storing in ppu
  769. * nld,ncon,nbas are already updated for storing in ppu
  770. Revision 1.33 2002/08/17 22:09:44 florian
  771. * result type handling in tcgcal.pass_2 overhauled
  772. * better tnode.printnodetree
  773. * some ppc stuff fixed
  774. Revision 1.32 2002/08/17 09:23:34 florian
  775. * first part of procinfo rewrite
  776. Revision 1.31 2002/08/15 19:10:35 peter
  777. * first things tai,tnode storing in ppu
  778. Revision 1.30 2002/07/20 11:57:53 florian
  779. * types.pas renamed to defbase.pas because D6 contains a types
  780. unit so this would conflicts if D6 programms are compiled
  781. + Willamette/SSE2 instructions to assembler added
  782. Revision 1.29 2002/07/19 11:41:35 daniel
  783. * State tracker work
  784. * The whilen and repeatn are now completely unified into whilerepeatn. This
  785. allows the state tracker to change while nodes automatically into
  786. repeat nodes.
  787. * Resulttypepass improvements to the notn. 'not not a' is optimized away and
  788. 'not(a>b)' is optimized into 'a<=b'.
  789. * Resulttypepass improvements to the whilerepeatn. 'while not a' is optimized
  790. by removing the notn and later switchting the true and falselabels. The
  791. same is done with 'repeat until not a'.
  792. Revision 1.28 2002/07/14 18:00:43 daniel
  793. + Added the beginning of a state tracker. This will track the values of
  794. variables through procedures and optimize things away.
  795. Revision 1.27 2002/07/01 18:46:22 peter
  796. * internal linker
  797. * reorganized aasm layer
  798. Revision 1.26 2002/06/24 12:43:00 jonas
  799. * fixed errors found with new -CR code from Peter when cycling with -O2p3r
  800. Revision 1.25 2002/05/18 13:34:09 peter
  801. * readded missing revisions
  802. Revision 1.24 2002/05/16 19:46:37 carl
  803. + defines.inc -> fpcdefs.inc to avoid conflicts if compiling by hand
  804. + try to fix temp allocation (still in ifdef)
  805. + generic constructor calls
  806. + start of tassembler / tmodulebase class cleanup
  807. Revision 1.22 2002/04/23 19:16:34 peter
  808. * add pinline unit that inserts compiler supported functions using
  809. one or more statements
  810. * moved finalize and setlength from ninl to pinline
  811. Revision 1.21 2002/04/21 19:02:03 peter
  812. * removed newn and disposen nodes, the code is now directly
  813. inlined from pexpr
  814. * -an option that will write the secondpass nodes to the .s file, this
  815. requires EXTDEBUG define to actually write the info
  816. * fixed various internal errors and crashes due recent code changes
  817. Revision 1.20 2002/04/04 19:05:57 peter
  818. * removed unused units
  819. * use tlocation.size in cg.a_*loc*() routines
  820. Revision 1.19 2002/03/31 20:26:33 jonas
  821. + a_loadfpu_* and a_loadmm_* methods in tcg
  822. * register allocation is now handled by a class and is mostly processor
  823. independent (+rgobj.pas and i386/rgcpu.pas)
  824. * temp allocation is now handled by a class (+tgobj.pas, -i386\tgcpu.pas)
  825. * some small improvements and fixes to the optimizer
  826. * some register allocation fixes
  827. * some fpuvaroffset fixes in the unary minus node
  828. * push/popusedregisters is now called rg.save/restoreusedregisters and
  829. (for i386) uses temps instead of push/pop's when using -Op3 (that code is
  830. also better optimizable)
  831. * fixed and optimized register saving/restoring for new/dispose nodes
  832. * LOC_FPU locations now also require their "register" field to be set to
  833. R_ST, not R_ST0 (the latter is used for LOC_CFPUREGISTER locations only)
  834. - list field removed of the tnode class because it's not used currently
  835. and can cause hard-to-find bugs
  836. }