nbas.pas 32 KB

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