nbas.pas 37 KB

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