nbas.pas 36 KB

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