nbas.pas 38 KB

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