nbas.pas 30 KB

123456789101112131415161718192021222324252627282930313233343536373839404142434445464748495051525354555657585960616263646566676869707172737475767778798081828384858687888990919293949596979899100101102103104105106107108109110111112113114115116117118119120121122123124125126127128129130131132133134135136137138139140141142143144145146147148149150151152153154155156157158159160161162163164165166167168169170171172173174175176177178179180181182183184185186187188189190191192193194195196197198199200201202203204205206207208209210211212213214215216217218219220221222223224225226227228229230231232233234235236237238239240241242243244245246247248249250251252253254255256257258259260261262263264265266267268269270271272273274275276277278279280281282283284285286287288289290291292293294295296297298299300301302303304305306307308309310311312313314315316317318319320321322323324325326327328329330331332333334335336337338339340341342343344345346347348349350351352353354355356357358359360361362363364365366367368369370371372373374375376377378379380381382383384385386387388389390391392393394395396397398399400401402403404405406407408409410411412413414415416417418419420421422423424425426427428429430431432433434435436437438439440441442443444445446447448449450451452453454455456457458459460461462463464465466467468469470471472473474475476477478479480481482483484485486487488489490491492493494495496497498499500501502503504505506507508509510511512513514515516517518519520521522523524525526527528529530531532533534535536537538539540541542543544545546547548549550551552553554555556557558559560561562563564565566567568569570571572573574575576577578579580581582583584585586587588589590591592593594595596597598599600601602603604605606607608609610611612613614615616617618619620621622623624625626627628629630631632633634635636637638639640641642643644645646647648649650651652653654655656657658659660661662663664665666667668669670671672673674675676677678679680681682683684685686687688689690691692693694695696697698699700701702703704705706707708709710711712713714715716717718719720721722723724725726727728729730731732733734735736737738739740741742743744745746747748749750751752753754755756757758759760761762763764765766767768769770771772773774775776777778779780781782783784785786787788789790791792793794795796797798799800801802803804805806807808809810811812813814815816817818819820821822823824825826827828829830831832833834835836837838839840841842843844845846847848849850851852853854855856857858859860861862863864865866867868869870871872873874875876877878879880881882883884885886887
  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. {$ifdef extdebug}
  58. procedure _dowrite;override;
  59. {$endif extdebug}
  60. end;
  61. tstatementnodeclass = class of tstatementnode;
  62. tblocknode = class(tunarynode)
  63. constructor create(l : tnode);virtual;
  64. function pass_1 : tnode;override;
  65. function det_resulttype:tnode;override;
  66. {$ifdef state_tracking}
  67. function track_state_pass(exec_known:boolean):boolean;override;
  68. {$endif state_tracking}
  69. end;
  70. tblocknodeclass = class of tblocknode;
  71. { to allow access to the location by temp references even after the temp has }
  72. { already been disposed and to make sure the coherency between temps and }
  73. { temp references is kept after a getcopy }
  74. ptempinfo = ^ttempinfo;
  75. ttempinfo = record
  76. { set to the copy of a tempcreate pnode (if it gets copied) so that the }
  77. { refs and deletenode can hook to this copy once they get copied too }
  78. hookoncopy : ptempinfo;
  79. ref : treference;
  80. restype : ttype;
  81. valid : boolean;
  82. end;
  83. { a node which will create a (non)persistent temp of a given type with a given }
  84. { size (the size is separate to allow creating "void" temps with a custom size) }
  85. ttempcreatenode = class(tnode)
  86. size: longint;
  87. tempinfo: ptempinfo;
  88. persistent: boolean;
  89. { * persistent temps are used in manually written code where the temp }
  90. { be usable among different statements and where you can manually say }
  91. { when the temp has to be freed (using a ttempdeletenode) }
  92. { * non-persistent temps are mostly used in typeconversion helpers, }
  93. { where the node that receives the temp becomes responsible for }
  94. { freeing it. In this last case, you should use only one reference }
  95. { to it and *not* generate a ttempdeletenode }
  96. constructor create(const _restype: ttype; _size: longint; _persistent: boolean); virtual;
  97. function getcopy: tnode; override;
  98. function pass_1 : tnode; override;
  99. function det_resulttype: tnode; override;
  100. function docompare(p: tnode): boolean; 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):tblocknode;
  145. procedure addstatement(var laststatement:tstatementnode;n:tnode);
  146. implementation
  147. uses
  148. cutils,
  149. verbose,globals,globtype,systems,
  150. symconst,symdef,symsym,defutil,defcmp,
  151. pass_1,
  152. nld,ncal,nflw,rgobj,cgbase
  153. ;
  154. {*****************************************************************************
  155. Helpers
  156. *****************************************************************************}
  157. function internalstatements(var laststatement:tstatementnode):tblocknode;
  158. begin
  159. { create dummy initial statement }
  160. laststatement := cstatementnode.create(cnothingnode.create,nil);
  161. internalstatements := cblocknode.create(laststatement);
  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. end;
  186. {*****************************************************************************
  187. TFIRSTERROR
  188. *****************************************************************************}
  189. constructor terrornode.create;
  190. begin
  191. inherited create(errorn);
  192. end;
  193. function terrornode.det_resulttype:tnode;
  194. begin
  195. result:=nil;
  196. include(flags,nf_error);
  197. codegenerror:=true;
  198. resulttype:=generrortype;
  199. end;
  200. function terrornode.pass_1 : tnode;
  201. begin
  202. result:=nil;
  203. codegenerror:=true;
  204. end;
  205. procedure terrornode.mark_write;
  206. begin
  207. end;
  208. {*****************************************************************************
  209. TSTATEMENTNODE
  210. *****************************************************************************}
  211. constructor tstatementnode.create(l,r : tnode);
  212. begin
  213. inherited create(statementn,l,r);
  214. end;
  215. function tstatementnode.det_resulttype:tnode;
  216. begin
  217. result:=nil;
  218. resulttype:=voidtype;
  219. { left is the statement itself calln assignn or a complex one }
  220. resulttypepass(left);
  221. if (not (cs_extsyntax in aktmoduleswitches)) and
  222. assigned(left.resulttype.def) and
  223. not((left.nodetype=calln) and
  224. { don't complain when funcretrefnode is set, because then the
  225. value is already used. And also not for constructors }
  226. (assigned(tcallnode(left).funcretrefnode) or
  227. (tcallnode(left).procdefinition.proctypeoption=potype_constructor))) and
  228. not(is_void(left.resulttype.def)) then
  229. CGMessage(cg_e_illegal_expression);
  230. if codegenerror then
  231. exit;
  232. { right is the next statement in the list }
  233. resulttypepass(right);
  234. if codegenerror then
  235. exit;
  236. end;
  237. function tstatementnode.pass_1 : tnode;
  238. begin
  239. result:=nil;
  240. { no temps over several statements }
  241. rg.cleartempgen;
  242. { left is the statement itself calln assignn or a complex one }
  243. firstpass(left);
  244. if codegenerror then
  245. exit;
  246. location.loc:=left.location.loc;
  247. registers32:=left.registers32;
  248. registersfpu:=left.registersfpu;
  249. {$ifdef SUPPORT_MMX}
  250. registersmmx:=left.registersmmx;
  251. {$endif SUPPORT_MMX}
  252. { right is the next in the list }
  253. firstpass(right);
  254. if codegenerror then
  255. exit;
  256. end;
  257. {$ifdef extdebug}
  258. procedure tstatementnode._dowrite;
  259. begin
  260. { can't use inherited dowrite, because that will use the
  261. binary which we don't want for statements }
  262. dowritenodetype;
  263. writeln(',');
  264. { write the statement }
  265. writenodeindention:=writenodeindention+' ';
  266. writenode(left);
  267. writeln(')');
  268. delete(writenodeindention,1,4);
  269. { go on with the next statement }
  270. writenode(right);
  271. end;
  272. {$endif}
  273. {*****************************************************************************
  274. TBLOCKNODE
  275. *****************************************************************************}
  276. constructor tblocknode.create(l : tnode);
  277. begin
  278. inherited create(blockn,l);
  279. end;
  280. function tblocknode.det_resulttype:tnode;
  281. var
  282. hp : tstatementnode;
  283. begin
  284. result:=nil;
  285. resulttype:=voidtype;
  286. hp:=tstatementnode(left);
  287. while assigned(hp) do
  288. begin
  289. if assigned(hp.left) then
  290. begin
  291. codegenerror:=false;
  292. resulttypepass(hp.left);
  293. if (not (cs_extsyntax in aktmoduleswitches)) and
  294. assigned(hp.left.resulttype.def) and
  295. not((hp.left.nodetype=calln) and
  296. { don't complain when funcretrefnode is set, because then the
  297. value is already used. And also not for constructors }
  298. (assigned(tcallnode(hp.left).funcretrefnode) or
  299. (tcallnode(hp.left).procdefinition.proctypeoption=potype_constructor))) and
  300. not(is_void(hp.left.resulttype.def)) then
  301. CGMessagePos(hp.left.fileinfo,cg_e_illegal_expression);
  302. { the resulttype of the block is the last type that is
  303. returned. Normally this is a voidtype. But when the
  304. compiler inserts a block of multiple statements then the
  305. last entry can return a value }
  306. resulttype:=hp.left.resulttype;
  307. end;
  308. hp:=tstatementnode(hp.right);
  309. end;
  310. end;
  311. function tblocknode.pass_1 : tnode;
  312. var
  313. hp : tstatementnode;
  314. count : longint;
  315. begin
  316. result:=nil;
  317. count:=0;
  318. hp:=tstatementnode(left);
  319. while assigned(hp) do
  320. begin
  321. if cs_regalloc in aktglobalswitches then
  322. begin
  323. { node transformations }
  324. { concat function result to exit }
  325. { this is wrong for string or other complex
  326. result types !!! }
  327. if {ret_in_acc(aktprocdef.rettype.def) and }
  328. (is_ordinal(aktprocdef.rettype.def) or
  329. is_smallset(aktprocdef.rettype.def)) and
  330. assigned(hp.right) and
  331. assigned(tstatementnode(hp.right).left) and
  332. (tstatementnode(hp.right).left.nodetype=exitn) and
  333. (hp.left.nodetype=assignn) and
  334. { !!!! this tbinarynode should be tassignmentnode }
  335. (tbinarynode(hp.left).left.nodetype=funcretn) 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. rg.cleartempgen;
  368. codegenerror:=false;
  369. firstpass(hp.left);
  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. location.loc:=hp.location.loc;
  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. end;
  476. function tasmnode.pass_1 : tnode;
  477. begin
  478. result:=nil;
  479. procinfo.flags:=procinfo.flags or pi_uses_asm;
  480. end;
  481. function tasmnode.docompare(p: tnode): boolean;
  482. begin
  483. { comparing of asmlists is not implemented (JM) }
  484. docompare := false;
  485. end;
  486. {*****************************************************************************
  487. TEMPCREATENODE
  488. *****************************************************************************}
  489. constructor ttempcreatenode.create(const _restype: ttype; _size: longint; _persistent: boolean);
  490. begin
  491. inherited create(tempcreaten);
  492. size := _size;
  493. new(tempinfo);
  494. fillchar(tempinfo^,sizeof(tempinfo^),0);
  495. tempinfo^.restype := _restype;
  496. persistent := _persistent;
  497. end;
  498. function ttempcreatenode.getcopy: tnode;
  499. var
  500. n: ttempcreatenode;
  501. begin
  502. n := ttempcreatenode(inherited getcopy);
  503. n.size := size;
  504. new(n.tempinfo);
  505. fillchar(n.tempinfo^,sizeof(n.tempinfo^),0);
  506. n.tempinfo^.restype := tempinfo^.restype;
  507. { when the tempinfo has already a hookoncopy then it is not
  508. reset by a tempdeletenode }
  509. if assigned(tempinfo^.hookoncopy) then
  510. internalerror(200211262);
  511. { signal the temprefs that the temp they point to has been copied, }
  512. { so that if the refs get copied as well, they can hook themselves }
  513. { to the copy of the temp }
  514. tempinfo^.hookoncopy := n.tempinfo;
  515. result := n;
  516. end;
  517. function ttempcreatenode.pass_1 : tnode;
  518. begin
  519. result := nil;
  520. end;
  521. function ttempcreatenode.det_resulttype: tnode;
  522. begin
  523. result := nil;
  524. { a tempcreatenode doesn't have a resulttype, only temprefnodes do }
  525. resulttype := voidtype;
  526. end;
  527. function ttempcreatenode.docompare(p: tnode): boolean;
  528. begin
  529. result :=
  530. inherited docompare(p) and
  531. (ttempcreatenode(p).size = size) and
  532. equal_defs(ttempcreatenode(p).tempinfo^.restype.def,tempinfo^.restype.def);
  533. end;
  534. {*****************************************************************************
  535. TEMPREFNODE
  536. *****************************************************************************}
  537. constructor ttemprefnode.create(const temp: ttempcreatenode);
  538. begin
  539. inherited create(temprefn);
  540. tempinfo := temp.tempinfo;
  541. offset:=0;
  542. end;
  543. constructor ttemprefnode.create_offset(const temp: ttempcreatenode;aoffset:longint);
  544. begin
  545. self.create(temp);
  546. offset := aoffset;
  547. end;
  548. function ttemprefnode.getcopy: tnode;
  549. var
  550. n: ttemprefnode;
  551. begin
  552. n := ttemprefnode(inherited getcopy);
  553. if assigned(tempinfo^.hookoncopy) then
  554. { if the temp has been copied, assume it becomes a new }
  555. { temp which has to be hooked by the copied reference }
  556. begin
  557. { hook the ref to the copied temp }
  558. n.tempinfo := tempinfo^.hookoncopy;
  559. end
  560. else
  561. { if the temp we refer to hasn't been copied, assume }
  562. { we're just a new reference to that temp }
  563. begin
  564. n.tempinfo := tempinfo;
  565. end;
  566. result := n;
  567. end;
  568. function ttemprefnode.pass_1 : tnode;
  569. begin
  570. location.loc:=LOC_REFERENCE;
  571. result := nil;
  572. end;
  573. function ttemprefnode.det_resulttype: tnode;
  574. begin
  575. { check if the temp is already resulttype passed }
  576. if not assigned(tempinfo^.restype.def) then
  577. internalerror(200108233);
  578. result := nil;
  579. resulttype := tempinfo^.restype;
  580. end;
  581. function ttemprefnode.docompare(p: tnode): boolean;
  582. begin
  583. result :=
  584. inherited docompare(p) and
  585. (ttemprefnode(p).tempinfo = tempinfo);
  586. end;
  587. procedure Ttemprefnode.mark_write;
  588. begin
  589. include(flags,nf_write);
  590. end;
  591. {*****************************************************************************
  592. TEMPDELETENODE
  593. *****************************************************************************}
  594. constructor ttempdeletenode.create(const temp: ttempcreatenode);
  595. begin
  596. inherited create(temprefn);
  597. tempinfo := temp.tempinfo;
  598. release_to_normal := false;
  599. if not temp.persistent then
  600. internalerror(200204211);
  601. end;
  602. constructor ttempdeletenode.create_normal_temp(const temp: ttempcreatenode);
  603. begin
  604. inherited create(tempdeleten);
  605. tempinfo := temp.tempinfo;
  606. release_to_normal := true;
  607. end;
  608. function ttempdeletenode.getcopy: tnode;
  609. var
  610. n: ttempdeletenode;
  611. begin
  612. n := ttempdeletenode(inherited getcopy);
  613. if assigned(tempinfo^.hookoncopy) then
  614. { if the temp has been copied, assume it becomes a new }
  615. { temp which has to be hooked by the copied deletenode }
  616. begin
  617. { hook the tempdeletenode to the copied temp }
  618. n.tempinfo := tempinfo^.hookoncopy;
  619. { the temp shall not be used, reset hookoncopy }
  620. tempinfo^.hookoncopy:=nil;
  621. end
  622. else
  623. { if the temp we refer to hasn't been copied, we have a }
  624. { problem since that means we now have two delete nodes }
  625. { for one temp }
  626. internalerror(200108234);
  627. result := n;
  628. end;
  629. function ttempdeletenode.pass_1 : tnode;
  630. begin
  631. result := nil;
  632. end;
  633. function ttempdeletenode.det_resulttype: tnode;
  634. begin
  635. result := nil;
  636. resulttype := voidtype;
  637. end;
  638. function ttempdeletenode.docompare(p: tnode): boolean;
  639. begin
  640. result :=
  641. inherited docompare(p) and
  642. (ttemprefnode(p).tempinfo = tempinfo);
  643. end;
  644. destructor ttempdeletenode.destroy;
  645. begin
  646. dispose(tempinfo);
  647. end;
  648. begin
  649. cnothingnode:=tnothingnode;
  650. cerrornode:=terrornode;
  651. casmnode:=tasmnode;
  652. cstatementnode:=tstatementnode;
  653. cblocknode:=tblocknode;
  654. ctempcreatenode:=ttempcreatenode;
  655. ctemprefnode:=ttemprefnode;
  656. ctempdeletenode:=ttempdeletenode;
  657. end.
  658. {
  659. $Log$
  660. Revision 1.40 2003-03-17 20:30:46 peter
  661. * errornode.mark_write added
  662. Revision 1.39 2003/01/03 12:15:55 daniel
  663. * Removed ifdefs around notifications
  664. ifdefs around for loop optimizations remain
  665. Revision 1.38 2002/11/27 02:37:12 peter
  666. * case statement inlining added
  667. * fixed inlining of write()
  668. * switched statementnode left and right parts so the statements are
  669. processed in the correct order when getcopy is used. This is
  670. required for tempnodes
  671. Revision 1.37 2002/11/25 17:43:17 peter
  672. * splitted defbase in defutil,symutil,defcmp
  673. * merged isconvertable and is_equal into compare_defs(_ext)
  674. * made operator search faster by walking the list only once
  675. Revision 1.36 2002/10/05 15:15:19 peter
  676. * don't complain in X- mode for internal generated function calls
  677. with funcretrefnode set
  678. * give statement error at the correct line position instead of the
  679. block begin
  680. Revision 1.35 2002/09/01 08:01:16 daniel
  681. * Removed sets from Tcallnode.det_resulttype
  682. + Added read/write notifications of variables. These will be usefull
  683. for providing information for several optimizations. For example
  684. the value of the loop variable of a for loop does matter is the
  685. variable is read after the for loop, but if it's no longer used
  686. or written, it doesn't matter and this can be used to optimize
  687. the loop code generation.
  688. Revision 1.34 2002/08/18 20:06:23 peter
  689. * inlining is now also allowed in interface
  690. * renamed write/load to ppuwrite/ppuload
  691. * tnode storing in ppu
  692. * nld,ncon,nbas are already updated for storing in ppu
  693. Revision 1.33 2002/08/17 22:09:44 florian
  694. * result type handling in tcgcal.pass_2 overhauled
  695. * better tnode.dowrite
  696. * some ppc stuff fixed
  697. Revision 1.32 2002/08/17 09:23:34 florian
  698. * first part of procinfo rewrite
  699. Revision 1.31 2002/08/15 19:10:35 peter
  700. * first things tai,tnode storing in ppu
  701. Revision 1.30 2002/07/20 11:57:53 florian
  702. * types.pas renamed to defbase.pas because D6 contains a types
  703. unit so this would conflicts if D6 programms are compiled
  704. + Willamette/SSE2 instructions to assembler added
  705. Revision 1.29 2002/07/19 11:41:35 daniel
  706. * State tracker work
  707. * The whilen and repeatn are now completely unified into whilerepeatn. This
  708. allows the state tracker to change while nodes automatically into
  709. repeat nodes.
  710. * Resulttypepass improvements to the notn. 'not not a' is optimized away and
  711. 'not(a>b)' is optimized into 'a<=b'.
  712. * Resulttypepass improvements to the whilerepeatn. 'while not a' is optimized
  713. by removing the notn and later switchting the true and falselabels. The
  714. same is done with 'repeat until not a'.
  715. Revision 1.28 2002/07/14 18:00:43 daniel
  716. + Added the beginning of a state tracker. This will track the values of
  717. variables through procedures and optimize things away.
  718. Revision 1.27 2002/07/01 18:46:22 peter
  719. * internal linker
  720. * reorganized aasm layer
  721. Revision 1.26 2002/06/24 12:43:00 jonas
  722. * fixed errors found with new -CR code from Peter when cycling with -O2p3r
  723. Revision 1.25 2002/05/18 13:34:09 peter
  724. * readded missing revisions
  725. Revision 1.24 2002/05/16 19:46:37 carl
  726. + defines.inc -> fpcdefs.inc to avoid conflicts if compiling by hand
  727. + try to fix temp allocation (still in ifdef)
  728. + generic constructor calls
  729. + start of tassembler / tmodulebase class cleanup
  730. Revision 1.22 2002/04/23 19:16:34 peter
  731. * add pinline unit that inserts compiler supported functions using
  732. one or more statements
  733. * moved finalize and setlength from ninl to pinline
  734. Revision 1.21 2002/04/21 19:02:03 peter
  735. * removed newn and disposen nodes, the code is now directly
  736. inlined from pexpr
  737. * -an option that will write the secondpass nodes to the .s file, this
  738. requires EXTDEBUG define to actually write the info
  739. * fixed various internal errors and crashes due recent code changes
  740. Revision 1.20 2002/04/04 19:05:57 peter
  741. * removed unused units
  742. * use tlocation.size in cg.a_*loc*() routines
  743. Revision 1.19 2002/03/31 20:26:33 jonas
  744. + a_loadfpu_* and a_loadmm_* methods in tcg
  745. * register allocation is now handled by a class and is mostly processor
  746. independent (+rgobj.pas and i386/rgcpu.pas)
  747. * temp allocation is now handled by a class (+tgobj.pas, -i386\tgcpu.pas)
  748. * some small improvements and fixes to the optimizer
  749. * some register allocation fixes
  750. * some fpuvaroffset fixes in the unary minus node
  751. * push/popusedregisters is now called rg.save/restoreusedregisters and
  752. (for i386) uses temps instead of push/pop's when using -Op3 (that code is
  753. also better optimizable)
  754. * fixed and optimized register saving/restoring for new/dispose nodes
  755. * LOC_FPU locations now also require their "register" field to be set to
  756. R_ST, not R_ST0 (the latter is used for LOC_CFPUREGISTER locations only)
  757. - list field removed of the tnode class because it's not used currently
  758. and can cause hard-to-find bugs
  759. }