nbas.pas 33 KB

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