nbas.pas 29 KB

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