nbas.pas 36 KB

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