node.pas 29 KB

123456789101112131415161718192021222324252627282930313233343536373839404142434445464748495051525354555657585960616263646566676869707172737475767778798081828384858687888990919293949596979899100101102103104105106107108109110111112113114115116117118119120121122123124125126127128129130131132133134135136137138139140141142143144145146147148149150151152153154155156157158159160161162163164165166167168169170171172173174175176177178179180181182183184185186187188189190191192193194195196197198199200201202203204205206207208209210211212213214215216217218219220221222223224225226227228229230231232233234235236237238239240241242243244245246247248249250251252253254255256257258259260261262263264265266267268269270271272273274275276277278279280281282283284285286287288289290291292293294295296297298299300301302303304305306307308309310311312313314315316317318319320321322323324325326327328329330331332333334335336337338339340341342343344345346347348349350351352353354355356357358359360361362363364365366367368369370371372373374375376377378379380381382383384385386387388389390391392393394395396397398399400401402403404405406407408409410411412413414415416417418419420421422423424425426427428429430431432433434435436437438439440441442443444445446447448449450451452453454455456457458459460461462463464465466467468469470471472473474475476477478479480481482483484485486487488489490491492493494495496497498499500501502503504505506507508509510511512513514515516517518519520521522523524525526527528529530531532533534535536537538539540541542543544545546547548549550551552553554555556557558559560561562563564565566567568569570571572573574575576577578579580581582583584585586587588589590591592593594595596597598599600601602603604605606607608609610611612613614615616617618619620621622623624625626627628629630631632633634635636637638639640641642643644645646647648649650651652653654655656657658659660661662663664665666667668669670671672673674675676677678679680681682683684685686687688689690691692693694695696697698699700701702703704705706707708709710711712713714715716717718719720721722723724725726727728729730731732733734735736737738739740741742743744745746747748749750751752753754755756757758759760761762763764765766767768769770771772773774775776777778779780781782783784785786787788789790791792793794795796797798799800801802803804805806807808809810811812813814815816817818819820821822823824825826827828829830831832833834835836837838839840841842843844845846847848849850851852853854855856857858859860861862863864865866867868869870871872873874875876877878879880881882883884885886887888889890891892893894895896897898899900901902903904905906907908909910911912913914915916917918919920921922923924925926927928929930931932933934935936937938939940941942943944945946947948949950951952953954955956957958959960961962963964965966967968969970971972973974975976977978979980981982983984985986987
  1. {
  2. $Id$
  3. Copyright (c) 2000-2002 by Florian Klaempfl
  4. Basic node handling
  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 node;
  19. {$i fpcdefs.inc}
  20. interface
  21. uses
  22. cclasses,
  23. globtype,globals,
  24. cpubase,
  25. aasmbase,
  26. symtype,symppu;
  27. type
  28. pconstset = ^tconstset;
  29. {$ifdef oldset}
  30. tconstset = array[0..31] of byte;
  31. pconst32bitset = ^tconst32bitset;
  32. tconst32bitset = array[0..7] of longint;
  33. {$else}
  34. tconstset = set of 0..255;
  35. {$endif}
  36. tnodetype = (
  37. addn, {Represents the + operator}
  38. muln, {Represents the * operator}
  39. subn, {Represents the - operator}
  40. divn, {Represents the div operator}
  41. symdifn, {Represents the >< operator}
  42. modn, {Represents the mod operator}
  43. assignn, {Represents an assignment}
  44. loadn, {Represents the use of a variabele}
  45. rangen, {Represents a range (i.e. 0..9)}
  46. ltn, {Represents the < operator}
  47. lten, {Represents the <= operator}
  48. gtn, {Represents the > operator}
  49. gten, {Represents the >= operator}
  50. equaln, {Represents the = operator}
  51. unequaln, {Represents the <> operator}
  52. inn, {Represents the in operator}
  53. orn, {Represents the or operator}
  54. xorn, {Represents the xor operator}
  55. shrn, {Represents the shr operator}
  56. shln, {Represents the shl operator}
  57. slashn, {Represents the / operator}
  58. andn, {Represents the and operator}
  59. subscriptn, {Field in a record/object}
  60. derefn, {Dereferences a pointer}
  61. addrn, {Represents the @ operator}
  62. doubleaddrn, {Represents the @@ operator}
  63. ordconstn, {Represents an ordinal value}
  64. typeconvn, {Represents type-conversion/typecast}
  65. calln, {Represents a call node}
  66. callparan, {Represents a parameter}
  67. realconstn, {Represents a real value}
  68. unaryminusn, {Represents a sign change (i.e. -2)}
  69. asmn, {Represents an assembler node }
  70. vecn, {Represents array indexing}
  71. pointerconstn, {Represents a pointer constant}
  72. stringconstn, {Represents a string constant}
  73. funcretn, {Represents the function result var}
  74. selfn, {Represents the self parameter}
  75. notn, {Represents the not operator}
  76. inlinen, {Internal procedures (i.e. writeln)}
  77. niln, {Represents the nil pointer}
  78. errorn, {This part of the tree could not be
  79. parsed because of a compiler error}
  80. typen, {A type name. Used for i.e. typeof(obj)}
  81. hnewn, {The new operation, constructor call}
  82. hdisposen, {The dispose operation with destructor call}
  83. setelementn, {A set element(s) (i.e. [a,b] and also [a..b])}
  84. setconstn, {A set constant (i.e. [1,2])}
  85. blockn, {A block of statements}
  86. statementn, {One statement in a block of nodes}
  87. ifn, {An if statement}
  88. breakn, {A break statement}
  89. continuen, {A continue statement}
  90. whilerepeatn, {A while or repeat statement}
  91. forn, {A for loop}
  92. exitn, {An exit statement}
  93. withn, {A with statement}
  94. casen, {A case statement}
  95. labeln, {A label}
  96. goton, {A goto statement}
  97. tryexceptn, {A try except block}
  98. raisen, {A raise statement}
  99. tryfinallyn, {A try finally statement}
  100. onn, {For an on statement in exception code}
  101. isn, {Represents the is operator}
  102. asn, {Represents the as typecast}
  103. caretn, {Represents the ^ operator}
  104. failn, {Represents the fail statement}
  105. starstarn, {Represents the ** operator exponentiation }
  106. procinlinen, {Procedures that can be inlined }
  107. arrayconstructorn, {Construction node for [...] parsing}
  108. arrayconstructorrangen, {Range element to allow sets in array construction tree}
  109. tempcreaten, { for temps in the result/firstpass }
  110. temprefn, { references to temps }
  111. tempdeleten, { for temps in the result/firstpass }
  112. addoptn, { added for optimizations where we cannot suppress }
  113. nothingn, {NOP, Do nothing}
  114. loadvmtn, {Load the address of the VMT of a class/object}
  115. guidconstn, {A GUID COM Interface constant }
  116. rttin {Rtti information so they can be accessed in result/firstpass}
  117. );
  118. const
  119. nodetype2str : array[tnodetype] of string[20] = (
  120. 'addn',
  121. 'muln',
  122. 'subn',
  123. 'divn',
  124. 'symdifn',
  125. 'modn',
  126. 'assignn',
  127. 'loadn',
  128. 'rangen',
  129. 'ltn',
  130. 'lten',
  131. 'gtn',
  132. 'gten',
  133. 'equaln',
  134. 'unequaln',
  135. 'inn',
  136. 'orn',
  137. 'xorn',
  138. 'shrn',
  139. 'shln',
  140. 'slashn',
  141. 'andn',
  142. 'subscriptn',
  143. 'derefn',
  144. 'addrn',
  145. 'doubleaddrn',
  146. 'ordconstn',
  147. 'typeconvn',
  148. 'calln',
  149. 'callparan',
  150. 'realconstn',
  151. 'unaryminusn',
  152. 'asmn',
  153. 'vecn',
  154. 'pointerconstn',
  155. 'stringconstn',
  156. 'funcretn',
  157. 'selfn',
  158. 'notn',
  159. 'inlinen',
  160. 'niln',
  161. 'errorn',
  162. 'typen',
  163. 'hnewn',
  164. 'hdisposen',
  165. 'setelementn',
  166. 'setconstn',
  167. 'blockn',
  168. 'statementn',
  169. 'ifn',
  170. 'breakn',
  171. 'continuen',
  172. 'whilerepeatn',
  173. 'forn',
  174. 'exitn',
  175. 'withn',
  176. 'casen',
  177. 'labeln',
  178. 'goton',
  179. 'tryexceptn',
  180. 'raisen',
  181. 'tryfinallyn',
  182. 'onn',
  183. 'isn',
  184. 'asn',
  185. 'caretn',
  186. 'failn',
  187. 'starstarn',
  188. 'procinlinen',
  189. 'arrayconstructn',
  190. 'arrayconstructrangen',
  191. 'tempcreaten',
  192. 'temprefn',
  193. 'tempdeleten',
  194. 'addoptn',
  195. 'nothingn',
  196. 'loadvmtn',
  197. 'guidconstn',
  198. 'rttin');
  199. type
  200. { all boolean field of ttree are now collected in flags }
  201. tnodeflags = (
  202. nf_needs_truefalselabel,
  203. nf_swapable, { tbinop operands can be swaped }
  204. nf_swaped, { tbinop operands are swaped }
  205. nf_error,
  206. { flags used by tcallnode }
  207. nf_return_value_used,
  208. nf_static_call,
  209. { flags used by tcallparanode }
  210. nf_varargs_para, { belongs this para to varargs }
  211. { flags used by loop nodes }
  212. nf_backward, { set if it is a for ... downto ... do loop }
  213. nf_varstate, { do we need to parse childs to set var state }
  214. nf_testatbegin,{ Do a test at the begin of the loop?}
  215. nf_checknegate,{ Negate the loop test?}
  216. { taddrnode }
  217. nf_procvarload,
  218. { tvecnode }
  219. nf_memindex,
  220. nf_memseg,
  221. nf_callunique,
  222. { twithnode }
  223. nf_islocal,
  224. { tloadnode }
  225. nf_absolute,
  226. nf_first,
  227. { tassignmentnode }
  228. nf_concat_string,
  229. { tfuncretnode }
  230. nf_is_first_funcret, { 20th }
  231. { tarrayconstructnode }
  232. nf_cargs,
  233. nf_cargswap,
  234. nf_forcevaria,
  235. nf_novariaallowed,
  236. { ttypeconvnode }
  237. nf_explizit,
  238. { tinlinenode }
  239. nf_inlineconst,
  240. { general }
  241. nf_isproperty,
  242. nf_varstateset,
  243. { tasmnode }
  244. nf_object_preserved,
  245. { taddnode }
  246. nf_use_strconcat
  247. );
  248. tnodeflagset = set of tnodeflags;
  249. const
  250. { contains the flags which must be equal for the equality }
  251. { of nodes }
  252. flagsequal : tnodeflagset = [nf_error,nf_static_call,nf_backward];
  253. type
  254. tnodelist = class
  255. end;
  256. { later (for the newcg) tnode will inherit from tlinkedlist_item }
  257. tnode = class
  258. public
  259. { type of this node }
  260. nodetype : tnodetype;
  261. { type of the current code block, general/const/type }
  262. blocktype : tblock_type;
  263. { the location of the result of this node }
  264. location : tlocation;
  265. { the parent node of this is node }
  266. { this field is set by concattolist }
  267. parent : tnode;
  268. { there are some properties about the node stored }
  269. flags : tnodeflagset;
  270. { the number of registers needed to evalute the node }
  271. registers32,registersfpu : longint; { must be longint !!!! }
  272. {$ifdef SUPPORT_MMX}
  273. registersmmx,registerskni : longint;
  274. {$endif SUPPORT_MMX}
  275. resulttype : ttype;
  276. fileinfo : tfileposinfo;
  277. localswitches : tlocalswitches;
  278. {$ifdef extdebug}
  279. maxfirstpasscount,
  280. firstpasscount : longint;
  281. {$endif extdebug}
  282. constructor create(tt : tnodetype);
  283. { this constructor is only for creating copies of class }
  284. { the fields are copied by getcopy }
  285. constructor createforcopy;
  286. constructor load(tt : tnodetype;ppufile:tcompilerppufile);
  287. destructor destroy;override;
  288. procedure write(ppufile:tcompilerppufile);virtual;
  289. { toggles the flag }
  290. procedure toggleflag(f : tnodeflags);
  291. { the 1.1 code generator may override pass_1 }
  292. { and it need not to implement det_* then }
  293. { 1.1: pass_1 returns a value<>0 if the node has been transformed }
  294. { 2.0: runs det_resulttype and det_temp }
  295. function pass_1 : tnode;virtual;abstract;
  296. { dermines the resulttype of the node }
  297. function det_resulttype : tnode;virtual;abstract;
  298. { dermines the number of necessary temp. locations to evaluate
  299. the node }
  300. {$ifdef state_tracking}
  301. { Does optimizations by keeping track of the variable states
  302. in a procedure }
  303. function track_state_pass(exec_known:boolean):boolean;virtual;
  304. {$endif}
  305. procedure det_temp;virtual;abstract;
  306. procedure pass_2;virtual;abstract;
  307. { comparing of nodes }
  308. function isequal(p : tnode) : boolean;
  309. { to implement comparisation, override this method }
  310. function docompare(p : tnode) : boolean;virtual;
  311. { gets a copy of the node }
  312. function getcopy : tnode;virtual;
  313. procedure insertintolist(l : tnodelist);virtual;
  314. {$ifdef EXTDEBUG}
  315. { writes a node for debugging purpose, shouldn't be called }
  316. { direct, because there is no test for nil, use writenode }
  317. { to write a complete tree }
  318. procedure dowrite;virtual;
  319. procedure dowritenodetype;virtual;
  320. {$endif EXTDEBUG}
  321. procedure concattolist(l : tlinkedlist);virtual;
  322. function ischild(p : tnode) : boolean;virtual;
  323. procedure set_file_line(from : tnode);
  324. procedure set_tree_filepos(const filepos : tfileposinfo);
  325. end;
  326. tnodeclass = class of tnode;
  327. tnodeclassarray = array[tnodetype] of tnodeclass;
  328. { this node is the anchestor for all nodes with at least }
  329. { one child, you have to use it if you want to use }
  330. { true- and falselabel }
  331. punarynode = ^tunarynode;
  332. tunarynode = class(tnode)
  333. left : tnode;
  334. constructor create(tt : tnodetype;l : tnode);
  335. constructor load(tt:tnodetype;ppufile:tcompilerppufile);
  336. destructor destroy;override;
  337. procedure write(ppufile:tcompilerppufile);override;
  338. procedure concattolist(l : tlinkedlist);override;
  339. function ischild(p : tnode) : boolean;override;
  340. function docompare(p : tnode) : boolean;override;
  341. function getcopy : tnode;override;
  342. procedure insertintolist(l : tnodelist);override;
  343. procedure left_max;
  344. {$ifdef extdebug}
  345. procedure dowrite;override;
  346. {$endif extdebug}
  347. end;
  348. pbinarynode = ^tbinarynode;
  349. tbinarynode = class(tunarynode)
  350. right : tnode;
  351. constructor create(tt : tnodetype;l,r : tnode);
  352. constructor load(tt:tnodetype;ppufile:tcompilerppufile);
  353. destructor destroy;override;
  354. procedure write(ppufile:tcompilerppufile);override;
  355. procedure concattolist(l : tlinkedlist);override;
  356. function ischild(p : tnode) : boolean;override;
  357. function docompare(p : tnode) : boolean;override;
  358. procedure swapleftright;
  359. function getcopy : tnode;override;
  360. procedure insertintolist(l : tnodelist);override;
  361. procedure left_right_max;
  362. {$ifdef extdebug}
  363. procedure dowrite;override;
  364. {$endif extdebug}
  365. end;
  366. tbinopnode = class(tbinarynode)
  367. constructor create(tt : tnodetype;l,r : tnode);virtual;
  368. function docompare(p : tnode) : boolean;override;
  369. end;
  370. {$ifdef tempregdebug}
  371. type
  372. pptree = ^tnode;
  373. var
  374. curptree: pptree;
  375. {$endif tempregdebug}
  376. var
  377. nodeclass : tnodeclassarray;
  378. {$ifdef EXTDEBUG}
  379. writenodeindention : string;
  380. {$endif EXTDEBUG}
  381. function ppuloadnode(ppufile:tcompilerppufile):tnode;
  382. {$ifdef EXTDEBUG}
  383. procedure writenode(t:tnode);
  384. {$endif EXTDEBUG}
  385. implementation
  386. uses
  387. cutils,verbose;
  388. {****************************************************************************
  389. Helpers
  390. ****************************************************************************}
  391. function ppuloadnode(ppufile:tcompilerppufile):tnode;
  392. var
  393. b : byte;
  394. t : tnodetype;
  395. begin
  396. { marker }
  397. b:=ppufile.getbyte;
  398. if b<>255 then
  399. internalerror(200208151);
  400. { load nodetype }
  401. t:=tnodetype(ppufile.getbyte);
  402. if t>high(tnodetype) then
  403. internalerror(200208152);
  404. if not assigned(nodeclass[t]) then
  405. internalerror(200208153);
  406. { generate node of the correct class }
  407. ppuloadnode:=nodeclass[t].load(t,ppufile);
  408. end;
  409. {$ifdef EXTDEBUG}
  410. procedure writenode(t:tnode);
  411. begin
  412. if assigned(t) then
  413. t.dowrite
  414. else
  415. write(writenodeindention,'nil');
  416. if writenodeindention='' then
  417. writeln;
  418. end;
  419. {$endif EXTDEBUG}
  420. {****************************************************************************
  421. TNODE
  422. ****************************************************************************}
  423. constructor tnode.create(tt : tnodetype);
  424. begin
  425. inherited create;
  426. nodetype:=tt;
  427. blocktype:=block_type;
  428. { this allows easier error tracing }
  429. location.loc:=LOC_INVALID;
  430. { save local info }
  431. fileinfo:=aktfilepos;
  432. localswitches:=aktlocalswitches;
  433. resulttype.reset;
  434. registers32:=0;
  435. registersfpu:=0;
  436. {$ifdef SUPPORT_MMX}
  437. registersmmx:=0;
  438. {$endif SUPPORT_MMX}
  439. {$ifdef EXTDEBUG}
  440. maxfirstpasscount:=0;
  441. firstpasscount:=0;
  442. {$endif EXTDEBUG}
  443. flags:=[];
  444. end;
  445. constructor tnode.createforcopy;
  446. begin
  447. end;
  448. constructor tnode.load(tt : tnodetype;ppufile:tcompilerppufile);
  449. begin
  450. { tnode fields }
  451. blocktype:=tblock_type(ppufile.getbyte);
  452. ppufile.getposinfo(fileinfo);
  453. ppufile.getsmallset(localswitches);
  454. ppufile.gettype(resulttype);
  455. ppufile.getsmallset(flags);
  456. { updated by firstpass }
  457. location.loc:=LOC_INVALID;
  458. registers32:=0;
  459. registersfpu:=0;
  460. {$ifdef SUPPORT_MMX}
  461. registersmmx:=0;
  462. {$endif SUPPORT_MMX}
  463. {$ifdef EXTDEBUG}
  464. maxfirstpasscount:=0;
  465. firstpasscount:=0;
  466. {$endif EXTDEBUG}
  467. end;
  468. procedure tnode.write(ppufile:tcompilerppufile);
  469. begin
  470. { marker, read by ppuloadnode }
  471. ppufile.putbyte($ff);
  472. { type, read by ppuloadnode }
  473. ppufile.putbyte(byte(nodetype));
  474. { tnode fields }
  475. ppufile.putbyte(byte(block_type));
  476. ppufile.putposinfo(aktfilepos);
  477. ppufile.putsmallset(localswitches);
  478. ppufile.puttype(resulttype);
  479. ppufile.putsmallset(flags);
  480. end;
  481. procedure tnode.toggleflag(f : tnodeflags);
  482. begin
  483. if f in flags then
  484. exclude(flags,f)
  485. else
  486. include(flags,f);
  487. end;
  488. destructor tnode.destroy;
  489. begin
  490. {$ifdef EXTDEBUG}
  491. if firstpasscount>maxfirstpasscount then
  492. maxfirstpasscount:=firstpasscount;
  493. {$endif EXTDEBUG}
  494. end;
  495. procedure tnode.concattolist(l : tlinkedlist);
  496. begin
  497. end;
  498. function tnode.ischild(p : tnode) : boolean;
  499. begin
  500. ischild:=false;
  501. end;
  502. {$ifdef EXTDEBUG}
  503. procedure tnode.dowrite;
  504. begin
  505. dowritenodetype;
  506. end;
  507. procedure tnode.dowritenodetype;
  508. begin
  509. write(writenodeindention,'(',nodetype2str[nodetype]);
  510. end;
  511. {$endif EXTDEBUG}
  512. function tnode.isequal(p : tnode) : boolean;
  513. begin
  514. isequal:=
  515. (not assigned(self) and not assigned(p)) or
  516. (assigned(self) and assigned(p) and
  517. { optimized subclasses have the same nodetype as their }
  518. { superclass (for compatibility), so also check the classtype (JM) }
  519. (p.classtype=classtype) and
  520. (p.nodetype=nodetype) and
  521. (flags*flagsequal=p.flags*flagsequal) and
  522. docompare(p));
  523. end;
  524. {$ifdef state_tracking}
  525. function Tnode.track_state_pass(exec_known:boolean):boolean;
  526. begin
  527. track_state_pass:=false;
  528. end;
  529. {$endif state_tracking}
  530. function tnode.docompare(p : tnode) : boolean;
  531. begin
  532. docompare:=true;
  533. end;
  534. function tnode.getcopy : tnode;
  535. var
  536. p : tnode;
  537. begin
  538. { this is quite tricky because we need a node of the current }
  539. { node type and not one of tnode! }
  540. p:=tnodeclass(classtype).createforcopy;
  541. p.nodetype:=nodetype;
  542. p.location:=location;
  543. p.parent:=parent;
  544. p.flags:=flags;
  545. p.registers32:=registers32;
  546. p.registersfpu:=registersfpu;
  547. {$ifdef SUPPORT_MMX}
  548. p.registersmmx:=registersmmx;
  549. p.registerskni:=registerskni;
  550. {$endif SUPPORT_MMX}
  551. p.resulttype:=resulttype;
  552. p.fileinfo:=fileinfo;
  553. p.localswitches:=localswitches;
  554. {$ifdef extdebug}
  555. p.firstpasscount:=firstpasscount;
  556. {$endif extdebug}
  557. { p.list:=list; }
  558. getcopy:=p;
  559. end;
  560. procedure tnode.insertintolist(l : tnodelist);
  561. begin
  562. end;
  563. procedure tnode.set_file_line(from : tnode);
  564. begin
  565. if assigned(from) then
  566. fileinfo:=from.fileinfo;
  567. end;
  568. procedure tnode.set_tree_filepos(const filepos : tfileposinfo);
  569. begin
  570. fileinfo:=filepos;
  571. end;
  572. {****************************************************************************
  573. TUNARYNODE
  574. ****************************************************************************}
  575. constructor tunarynode.create(tt : tnodetype;l : tnode);
  576. begin
  577. inherited create(tt);
  578. left:=l;
  579. end;
  580. constructor tunarynode.load(tt : tnodetype;ppufile:tcompilerppufile);
  581. begin
  582. inherited load(tt,ppufile);
  583. left:=ppuloadnode(ppufile);
  584. end;
  585. destructor tunarynode.destroy;
  586. begin
  587. left.free;
  588. inherited destroy;
  589. end;
  590. procedure tunarynode.write(ppufile:tcompilerppufile);
  591. begin
  592. inherited write(ppufile);
  593. left.write(ppufile);
  594. end;
  595. function tunarynode.docompare(p : tnode) : boolean;
  596. begin
  597. docompare:=(inherited docompare(p) and
  598. ((left=nil) or left.isequal(tunarynode(p).left))
  599. );
  600. end;
  601. function tunarynode.getcopy : tnode;
  602. var
  603. p : tunarynode;
  604. begin
  605. p:=tunarynode(inherited getcopy);
  606. if assigned(left) then
  607. p.left:=left.getcopy
  608. else
  609. p.left:=nil;
  610. getcopy:=p;
  611. end;
  612. procedure tunarynode.insertintolist(l : tnodelist);
  613. begin
  614. end;
  615. {$ifdef extdebug}
  616. procedure tunarynode.dowrite;
  617. begin
  618. inherited dowrite;
  619. writeln(',');
  620. writenodeindention:=writenodeindention+' ';
  621. writenode(left);
  622. write(')');
  623. delete(writenodeindention,1,4);
  624. end;
  625. {$endif}
  626. procedure tunarynode.left_max;
  627. begin
  628. registers32:=left.registers32;
  629. registersfpu:=left.registersfpu;
  630. {$ifdef SUPPORT_MMX}
  631. registersmmx:=left.registersmmx;
  632. {$endif SUPPORT_MMX}
  633. end;
  634. procedure tunarynode.concattolist(l : tlinkedlist);
  635. begin
  636. left.parent:=self;
  637. left.concattolist(l);
  638. inherited concattolist(l);
  639. end;
  640. function tunarynode.ischild(p : tnode) : boolean;
  641. begin
  642. ischild:=p=left;
  643. end;
  644. {****************************************************************************
  645. TBINARYNODE
  646. ****************************************************************************}
  647. constructor tbinarynode.create(tt : tnodetype;l,r : tnode);
  648. begin
  649. inherited create(tt,l);
  650. right:=r
  651. end;
  652. constructor tbinarynode.load(tt : tnodetype;ppufile:tcompilerppufile);
  653. begin
  654. inherited load(tt,ppufile);
  655. right:=ppuloadnode(ppufile);
  656. end;
  657. destructor tbinarynode.destroy;
  658. begin
  659. right.free;
  660. inherited destroy;
  661. end;
  662. procedure tbinarynode.write(ppufile:tcompilerppufile);
  663. begin
  664. inherited write(ppufile);
  665. right.write(ppufile);
  666. end;
  667. procedure tbinarynode.concattolist(l : tlinkedlist);
  668. begin
  669. { we could change that depending on the number of }
  670. { required registers }
  671. left.parent:=self;
  672. left.concattolist(l);
  673. left.parent:=self;
  674. left.concattolist(l);
  675. inherited concattolist(l);
  676. end;
  677. function tbinarynode.ischild(p : tnode) : boolean;
  678. begin
  679. ischild:=(p=right);
  680. end;
  681. function tbinarynode.docompare(p : tnode) : boolean;
  682. begin
  683. docompare:=(inherited docompare(p) and
  684. ((right=nil) or right.isequal(tbinarynode(p).right))
  685. );
  686. end;
  687. function tbinarynode.getcopy : tnode;
  688. var
  689. p : tbinarynode;
  690. begin
  691. p:=tbinarynode(inherited getcopy);
  692. if assigned(right) then
  693. p.right:=right.getcopy
  694. else
  695. p.right:=nil;
  696. getcopy:=p;
  697. end;
  698. procedure tbinarynode.insertintolist(l : tnodelist);
  699. begin
  700. end;
  701. procedure tbinarynode.swapleftright;
  702. var
  703. swapp : tnode;
  704. begin
  705. swapp:=right;
  706. right:=left;
  707. left:=swapp;
  708. if nf_swaped in flags then
  709. exclude(flags,nf_swaped)
  710. else
  711. include(flags,nf_swaped);
  712. end;
  713. procedure tbinarynode.left_right_max;
  714. begin
  715. if assigned(left) then
  716. begin
  717. if assigned(right) then
  718. begin
  719. registers32:=max(left.registers32,right.registers32);
  720. registersfpu:=max(left.registersfpu,right.registersfpu);
  721. {$ifdef SUPPORT_MMX}
  722. registersmmx:=max(left.registersmmx,right.registersmmx);
  723. {$endif SUPPORT_MMX}
  724. end
  725. else
  726. begin
  727. registers32:=left.registers32;
  728. registersfpu:=left.registersfpu;
  729. {$ifdef SUPPORT_MMX}
  730. registersmmx:=left.registersmmx;
  731. {$endif SUPPORT_MMX}
  732. end;
  733. end;
  734. end;
  735. {$ifdef extdebug}
  736. procedure tbinarynode.dowrite;
  737. begin
  738. inherited dowrite;
  739. writeln(',');
  740. writenodeindention:=writenodeindention+' ';
  741. writenode(right);
  742. write(')');
  743. delete(writenodeindention,1,4);
  744. end;
  745. {$endif}
  746. {****************************************************************************
  747. TBINOPYNODE
  748. ****************************************************************************}
  749. constructor tbinopnode.create(tt : tnodetype;l,r : tnode);
  750. begin
  751. inherited create(tt,l,r);
  752. end;
  753. function tbinopnode.docompare(p : tnode) : boolean;
  754. begin
  755. docompare:=(inherited docompare(p)) or
  756. { if that's in the flags, is p then always a tbinopnode (?) (JM) }
  757. ((nf_swapable in flags) and
  758. left.isequal(tbinopnode(p).right) and
  759. right.isequal(tbinopnode(p).left));
  760. end;
  761. end.
  762. {
  763. $Log$
  764. Revision 1.35 2002-08-15 19:10:35 peter
  765. * first things tai,tnode storing in ppu
  766. Revision 1.34 2002/08/09 19:15:41 carl
  767. - removed newcg define
  768. Revision 1.33 2002/07/23 12:34:30 daniel
  769. * Readded old set code. To use it define 'oldset'. Activated by default
  770. for ppc.
  771. Revision 1.32 2002/07/22 11:48:04 daniel
  772. * Sets are now internally sets.
  773. Revision 1.31 2002/07/21 06:58:49 daniel
  774. * Changed booleans into flags
  775. Revision 1.30 2002/07/19 11:41:36 daniel
  776. * State tracker work
  777. * The whilen and repeatn are now completely unified into whilerepeatn. This
  778. allows the state tracker to change while nodes automatically into
  779. repeat nodes.
  780. * Resulttypepass improvements to the notn. 'not not a' is optimized away and
  781. 'not(a>b)' is optimized into 'a<=b'.
  782. * Resulttypepass improvements to the whilerepeatn. 'while not a' is optimized
  783. by removing the notn and later switchting the true and falselabels. The
  784. same is done with 'repeat until not a'.
  785. Revision 1.29 2002/07/14 18:00:44 daniel
  786. + Added the beginning of a state tracker. This will track the values of
  787. variables through procedures and optimize things away.
  788. Revision 1.28 2002/07/01 18:46:24 peter
  789. * internal linker
  790. * reorganized aasm layer
  791. Revision 1.27 2002/05/18 13:34:10 peter
  792. * readded missing revisions
  793. Revision 1.26 2002/05/16 19:46:39 carl
  794. + defines.inc -> fpcdefs.inc to avoid conflicts if compiling by hand
  795. + try to fix temp allocation (still in ifdef)
  796. + generic constructor calls
  797. + start of tassembler / tmodulebase class cleanup
  798. Revision 1.24 2002/04/21 19:02:04 peter
  799. * removed newn and disposen nodes, the code is now directly
  800. inlined from pexpr
  801. * -an option that will write the secondpass nodes to the .s file, this
  802. requires EXTDEBUG define to actually write the info
  803. * fixed various internal errors and crashes due recent code changes
  804. Revision 1.23 2002/04/06 18:13:01 jonas
  805. * several powerpc-related additions and fixes
  806. Revision 1.22 2002/03/31 20:26:35 jonas
  807. + a_loadfpu_* and a_loadmm_* methods in tcg
  808. * register allocation is now handled by a class and is mostly processor
  809. independent (+rgobj.pas and i386/rgcpu.pas)
  810. * temp allocation is now handled by a class (+tgobj.pas, -i386\tgcpu.pas)
  811. * some small improvements and fixes to the optimizer
  812. * some register allocation fixes
  813. * some fpuvaroffset fixes in the unary minus node
  814. * push/popusedregisters is now called rg.save/restoreusedregisters and
  815. (for i386) uses temps instead of push/pop's when using -Op3 (that code is
  816. also better optimizable)
  817. * fixed and optimized register saving/restoring for new/dispose nodes
  818. * LOC_FPU locations now also require their "register" field to be set to
  819. R_ST, not R_ST0 (the latter is used for LOC_CFPUREGISTER locations only)
  820. - list field removed of the tnode class because it's not used currently
  821. and can cause hard-to-find bugs
  822. Revision 1.21 2002/01/19 11:52:32 peter
  823. * dynarr:=nil support added
  824. }