node.pas 35 KB

123456789101112131415161718192021222324252627282930313233343536373839404142434445464748495051525354555657585960616263646566676869707172737475767778798081828384858687888990919293949596979899100101102103104105106107108109110111112113114115116117118119120121122123124125126127128129130131132133134135136137138139140141142143144145146147148149150151152153154155156157158159160161162163164165166167168169170171172173174175176177178179180181182183184185186187188189190191192193194195196197198199200201202203204205206207208209210211212213214215216217218219220221222223224225226227228229230231232233234235236237238239240241242243244245246247248249250251252253254255256257258259260261262263264265266267268269270271272273274275276277278279280281282283284285286287288289290291292293294295296297298299300301302303304305306307308309310311312313314315316317318319320321322323324325326327328329330331332333334335336337338339340341342343344345346347348349350351352353354355356357358359360361362363364365366367368369370371372373374375376377378379380381382383384385386387388389390391392393394395396397398399400401402403404405406407408409410411412413414415416417418419420421422423424425426427428429430431432433434435436437438439440441442443444445446447448449450451452453454455456457458459460461462463464465466467468469470471472473474475476477478479480481482483484485486487488489490491492493494495496497498499500501502503504505506507508509510511512513514515516517518519520521522523524525526527528529530531532533534535536537538539540541542543544545546547548549550551552553554555556557558559560561562563564565566567568569570571572573574575576577578579580581582583584585586587588589590591592593594595596597598599600601602603604605606607608609610611612613614615616617618619620621622623624625626627628629630631632633634635636637638639640641642643644645646647648649650651652653654655656657658659660661662663664665666667668669670671672673674675676677678679680681682683684685686687688689690691692693694695696697698699700701702703704705706707708709710711712713714715716717718719720721722723724725726727728729730731732733734735736737738739740741742743744745746747748749750751752753754755756757758759760761762763764765766767768769770771772773774775776777778779780781782783784785786787788789790791792793794795796797798799800801802803804805806807808809810811812813814815816817818819820821822823824825826827828829830831832833834835836837838839840841842843844845846847848849850851852853854855856857858859860861862863864865866867868869870871872873874875876877878879880881882883884885886887888889890891892893894895896897898899900901902903904905906907908909910911912913914915916917918919920921922923924925926927928929930931932933934935936937938939940941942943944945946947948949950951952953954955956957958959960961962963964965966967968969970971972973974975976977978979980981982983984985986987988989990991992993994995996997998999100010011002100310041005100610071008100910101011101210131014101510161017101810191020102110221023102410251026102710281029103010311032103310341035103610371038103910401041104210431044104510461047104810491050105110521053105410551056105710581059106010611062106310641065106610671068106910701071107210731074107510761077107810791080108110821083108410851086108710881089109010911092109310941095109610971098109911001101110211031104110511061107110811091110111111121113111411151116111711181119112011211122112311241125112611271128112911301131113211331134113511361137113811391140114111421143114411451146114711481149115011511152115311541155115611571158115911601161116211631164116511661167
  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,cginfo,
  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. emptynode, {No node (returns nil when loading from ppu)}
  38. addn, {Represents the + operator}
  39. muln, {Represents the * operator}
  40. subn, {Represents the - operator}
  41. divn, {Represents the div operator}
  42. symdifn, {Represents the >< operator}
  43. modn, {Represents the mod operator}
  44. assignn, {Represents an assignment}
  45. loadn, {Represents the use of a variabele}
  46. rangen, {Represents a range (i.e. 0..9)}
  47. ltn, {Represents the < operator}
  48. lten, {Represents the <= operator}
  49. gtn, {Represents the > operator}
  50. gten, {Represents the >= operator}
  51. equaln, {Represents the = operator}
  52. unequaln, {Represents the <> operator}
  53. inn, {Represents the in operator}
  54. orn, {Represents the or operator}
  55. xorn, {Represents the xor operator}
  56. shrn, {Represents the shr operator}
  57. shln, {Represents the shl operator}
  58. slashn, {Represents the / operator}
  59. andn, {Represents the and operator}
  60. subscriptn, {Field in a record/object}
  61. derefn, {Dereferences a pointer}
  62. addrn, {Represents the @ operator}
  63. doubleaddrn, {Represents the @@ operator}
  64. ordconstn, {Represents an ordinal value}
  65. typeconvn, {Represents type-conversion/typecast}
  66. calln, {Represents a call node}
  67. callparan, {Represents a parameter}
  68. realconstn, {Represents a real value}
  69. unaryminusn, {Represents a sign change (i.e. -2)}
  70. asmn, {Represents an assembler node }
  71. vecn, {Represents array indexing}
  72. pointerconstn, {Represents a pointer constant}
  73. stringconstn, {Represents a string constant}
  74. funcretn, {Represents the function result var}
  75. selfn, {Represents the self parameter}
  76. notn, {Represents the not operator}
  77. inlinen, {Internal procedures (i.e. writeln)}
  78. niln, {Represents the nil pointer}
  79. errorn, {This part of the tree could not be
  80. parsed because of a compiler error}
  81. typen, {A type name. Used for i.e. typeof(obj)}
  82. hnewn, {The new operation, constructor call}
  83. hdisposen, {The dispose operation with destructor call}
  84. setelementn, {A set element(s) (i.e. [a,b] and also [a..b])}
  85. setconstn, {A set constant (i.e. [1,2])}
  86. blockn, {A block of statements}
  87. statementn, {One statement in a block of nodes}
  88. ifn, {An if statement}
  89. breakn, {A break statement}
  90. continuen, {A continue statement}
  91. whilerepeatn, {A while or repeat statement}
  92. forn, {A for loop}
  93. exitn, {An exit statement}
  94. withn, {A with statement}
  95. casen, {A case statement}
  96. labeln, {A label}
  97. goton, {A goto statement}
  98. tryexceptn, {A try except block}
  99. raisen, {A raise statement}
  100. tryfinallyn, {A try finally statement}
  101. onn, {For an on statement in exception code}
  102. isn, {Represents the is operator}
  103. asn, {Represents the as typecast}
  104. caretn, {Represents the ^ operator}
  105. failn, {Represents the fail statement}
  106. starstarn, {Represents the ** operator exponentiation }
  107. procinlinen, {Procedures that can be inlined }
  108. arrayconstructorn, {Construction node for [...] parsing}
  109. arrayconstructorrangen, {Range element to allow sets in array construction tree}
  110. tempcreaten, { for temps in the result/firstpass }
  111. temprefn, { references to temps }
  112. tempdeleten, { for temps in the result/firstpass }
  113. addoptn, { added for optimizations where we cannot suppress }
  114. nothingn, {NOP, Do nothing}
  115. loadvmtn, {Load the address of the VMT of a class/object}
  116. guidconstn, {A GUID COM Interface constant }
  117. rttin {Rtti information so they can be accessed in result/firstpass}
  118. );
  119. const
  120. nodetype2str : array[tnodetype] of string[20] = (
  121. '<emptynode>',
  122. 'addn',
  123. 'muln',
  124. 'subn',
  125. 'divn',
  126. 'symdifn',
  127. 'modn',
  128. 'assignn',
  129. 'loadn',
  130. 'rangen',
  131. 'ltn',
  132. 'lten',
  133. 'gtn',
  134. 'gten',
  135. 'equaln',
  136. 'unequaln',
  137. 'inn',
  138. 'orn',
  139. 'xorn',
  140. 'shrn',
  141. 'shln',
  142. 'slashn',
  143. 'andn',
  144. 'subscriptn',
  145. 'derefn',
  146. 'addrn',
  147. 'doubleaddrn',
  148. 'ordconstn',
  149. 'typeconvn',
  150. 'calln',
  151. 'callparan',
  152. 'realconstn',
  153. 'unaryminusn',
  154. 'asmn',
  155. 'vecn',
  156. 'pointerconstn',
  157. 'stringconstn',
  158. 'funcretn',
  159. 'selfn',
  160. 'notn',
  161. 'inlinen',
  162. 'niln',
  163. 'errorn',
  164. 'typen',
  165. 'hnewn',
  166. 'hdisposen',
  167. 'setelementn',
  168. 'setconstn',
  169. 'blockn',
  170. 'statementn',
  171. 'ifn',
  172. 'breakn',
  173. 'continuen',
  174. 'whilerepeatn',
  175. 'forn',
  176. 'exitn',
  177. 'withn',
  178. 'casen',
  179. 'labeln',
  180. 'goton',
  181. 'tryexceptn',
  182. 'raisen',
  183. 'tryfinallyn',
  184. 'onn',
  185. 'isn',
  186. 'asn',
  187. 'caretn',
  188. 'failn',
  189. 'starstarn',
  190. 'procinlinen',
  191. 'arrayconstructn',
  192. 'arrayconstructrangen',
  193. 'tempcreaten',
  194. 'temprefn',
  195. 'tempdeleten',
  196. 'addoptn',
  197. 'nothingn',
  198. 'loadvmtn',
  199. 'guidconstn',
  200. 'rttin');
  201. type
  202. { all boolean field of ttree are now collected in flags }
  203. tnodeflags = (
  204. nf_swapable, { tbinop operands can be swaped }
  205. nf_swaped, { tbinop operands are swaped }
  206. nf_error,
  207. { general }
  208. nf_write, { Node is written to }
  209. nf_first_use, { First node that uses a variable after declared }
  210. nf_varstateset,
  211. nf_isproperty,
  212. { flags used by tcallnode }
  213. nf_return_value_used,
  214. nf_anon_inherited,
  215. { flags used by tcallparanode }
  216. nf_varargs_para, { belongs this para to varargs }
  217. { taddrnode }
  218. nf_procvarload,
  219. { tvecnode }
  220. nf_memindex,
  221. nf_memseg,
  222. nf_callunique,
  223. { twithnode }
  224. nf_islocal,
  225. { tloadnode }
  226. nf_absolute,
  227. { taddnode }
  228. nf_is_currency,
  229. { tassignmentnode }
  230. nf_concat_string,
  231. nf_use_strconcat,
  232. { tarrayconstructnode }
  233. nf_cargs,
  234. nf_cargswap,
  235. nf_forcevaria,
  236. nf_novariaallowed,
  237. { ttypeconvnode }
  238. nf_explicit,
  239. { tinlinenode }
  240. nf_inlineconst
  241. );
  242. tnodeflagset = set of tnodeflags;
  243. const
  244. { contains the flags which must be equal for the equality }
  245. { of nodes }
  246. flagsequal : tnodeflagset = [nf_error];
  247. type
  248. tnodelist = class
  249. end;
  250. { later (for the newcg) tnode will inherit from tlinkedlist_item }
  251. tnode = class
  252. public
  253. { type of this node }
  254. nodetype : tnodetype;
  255. { type of the current code block, general/const/type }
  256. blocktype : tblock_type;
  257. { expected location of the result of this node (pass1) }
  258. expectloc : tcgloc;
  259. { the location of the result of this node (pass2) }
  260. location : tlocation;
  261. { the parent node of this is node }
  262. { this field is set by concattolist }
  263. parent : tnode;
  264. { there are some properties about the node stored }
  265. flags : tnodeflagset;
  266. { the number of registers needed to evalute the node }
  267. registers32,registersfpu : longint; { must be longint !!!! }
  268. {$ifdef SUPPORT_MMX}
  269. registersmmx,registerskni : longint;
  270. {$endif SUPPORT_MMX}
  271. resulttype : ttype;
  272. fileinfo : tfileposinfo;
  273. localswitches : tlocalswitches;
  274. {$ifdef extdebug}
  275. maxfirstpasscount,
  276. firstpasscount : longint;
  277. {$endif extdebug}
  278. constructor create(t:tnodetype);
  279. { this constructor is only for creating copies of class }
  280. { the fields are copied by getcopy }
  281. constructor createforcopy;
  282. constructor ppuload(t:tnodetype;ppufile:tcompilerppufile);virtual;
  283. destructor destroy;override;
  284. procedure ppuwrite(ppufile:tcompilerppufile);virtual;
  285. procedure derefimpl;virtual;
  286. { toggles the flag }
  287. procedure toggleflag(f : tnodeflags);
  288. { the 1.1 code generator may override pass_1 }
  289. { and it need not to implement det_* then }
  290. { 1.1: pass_1 returns a value<>0 if the node has been transformed }
  291. { 2.0: runs det_resulttype and det_temp }
  292. function pass_1 : tnode;virtual;abstract;
  293. { dermines the resulttype of the node }
  294. function det_resulttype : tnode;virtual;abstract;
  295. { dermines the number of necessary temp. locations to evaluate
  296. the node }
  297. {$ifdef state_tracking}
  298. { Does optimizations by keeping track of the variable states
  299. in a procedure }
  300. function track_state_pass(exec_known:boolean):boolean;virtual;
  301. {$endif}
  302. { For a t1:=t2 tree, mark the part of the tree t1 that gets
  303. written to (normally the loadnode) as write access. }
  304. procedure mark_write;virtual;
  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;
  319. procedure dowritenodetype;virtual;
  320. procedure _dowrite;virtual;
  321. {$endif EXTDEBUG}
  322. procedure concattolist(l : tlinkedlist);virtual;
  323. function ischild(p : tnode) : boolean;virtual;
  324. procedure set_file_line(from : tnode);
  325. procedure set_tree_filepos(const filepos : tfileposinfo);
  326. end;
  327. tnodeclass = class of tnode;
  328. tnodeclassarray = array[tnodetype] of tnodeclass;
  329. { this node is the anchestor for all nodes with at least }
  330. { one child, you have to use it if you want to use }
  331. { true- and falselabel }
  332. punarynode = ^tunarynode;
  333. tunarynode = class(tnode)
  334. left : tnode;
  335. constructor create(t:tnodetype;l : tnode);
  336. constructor ppuload(t:tnodetype;ppufile:tcompilerppufile);override;
  337. destructor destroy;override;
  338. procedure ppuwrite(ppufile:tcompilerppufile);override;
  339. procedure derefimpl;override;
  340. procedure concattolist(l : tlinkedlist);override;
  341. function ischild(p : tnode) : boolean;override;
  342. function docompare(p : tnode) : boolean;override;
  343. function getcopy : tnode;override;
  344. procedure insertintolist(l : tnodelist);override;
  345. procedure left_max;
  346. {$ifdef extdebug}
  347. procedure _dowrite;override;
  348. {$endif extdebug}
  349. end;
  350. pbinarynode = ^tbinarynode;
  351. tbinarynode = class(tunarynode)
  352. right : tnode;
  353. constructor create(t:tnodetype;l,r : tnode);
  354. constructor ppuload(t:tnodetype;ppufile:tcompilerppufile);override;
  355. destructor destroy;override;
  356. procedure ppuwrite(ppufile:tcompilerppufile);override;
  357. procedure derefimpl;override;
  358. procedure concattolist(l : tlinkedlist);override;
  359. function ischild(p : tnode) : boolean;override;
  360. function docompare(p : tnode) : boolean;override;
  361. procedure swapleftright;
  362. function getcopy : tnode;override;
  363. procedure insertintolist(l : tnodelist);override;
  364. procedure left_right_max;
  365. {$ifdef extdebug}
  366. procedure _dowrite;override;
  367. {$endif extdebug}
  368. end;
  369. tbinopnode = class(tbinarynode)
  370. constructor create(t:tnodetype;l,r : tnode);virtual;
  371. function docompare(p : tnode) : boolean;override;
  372. end;
  373. {$ifdef tempregdebug}
  374. type
  375. pptree = ^tnode;
  376. var
  377. curptree: pptree;
  378. {$endif tempregdebug}
  379. var
  380. { array with all class types for tnodes }
  381. nodeclass : tnodeclassarray;
  382. {$ifdef EXTDEBUG}
  383. { indention used when writing the tree to the screen }
  384. writenodeindention : string;
  385. {$endif EXTDEBUG}
  386. function ppuloadnode(ppufile:tcompilerppufile):tnode;
  387. procedure ppuwritenode(ppufile:tcompilerppufile;n:tnode);
  388. {$ifdef EXTDEBUG}
  389. procedure writenode(t:tnode);
  390. {$endif EXTDEBUG}
  391. implementation
  392. uses
  393. cutils,verbose;
  394. const
  395. ppunodemarker = 255;
  396. {****************************************************************************
  397. Helpers
  398. ****************************************************************************}
  399. function ppuloadnode(ppufile:tcompilerppufile):tnode;
  400. var
  401. b : byte;
  402. t : tnodetype;
  403. begin
  404. { marker }
  405. b:=ppufile.getbyte;
  406. if b<>ppunodemarker then
  407. internalerror(200208151);
  408. { load nodetype }
  409. t:=tnodetype(ppufile.getbyte);
  410. if t>high(tnodetype) then
  411. internalerror(200208152);
  412. if t<>emptynode then
  413. begin
  414. if not assigned(nodeclass[t]) then
  415. internalerror(200208153);
  416. //writeln('load: ',nodetype2str[t]);
  417. { generate node of the correct class }
  418. ppuloadnode:=nodeclass[t].ppuload(t,ppufile);
  419. end
  420. else
  421. ppuloadnode:=nil;
  422. end;
  423. procedure ppuwritenode(ppufile:tcompilerppufile;n:tnode);
  424. begin
  425. { marker, read by ppuloadnode }
  426. ppufile.putbyte(ppunodemarker);
  427. { type, read by ppuloadnode }
  428. if assigned(n) then
  429. begin
  430. ppufile.putbyte(byte(n.nodetype));
  431. //writeln('write: ',nodetype2str[n.nodetype]);
  432. n.ppuwrite(ppufile);
  433. end
  434. else
  435. ppufile.putbyte(byte(emptynode));
  436. end;
  437. {$ifdef EXTDEBUG}
  438. procedure writenode(t:tnode);
  439. begin
  440. if assigned(t) then
  441. t.dowrite
  442. else
  443. write(writenodeindention,'nil');
  444. if writenodeindention='' then
  445. writeln;
  446. end;
  447. {$endif EXTDEBUG}
  448. {****************************************************************************
  449. TNODE
  450. ****************************************************************************}
  451. constructor tnode.create(t:tnodetype);
  452. begin
  453. inherited create;
  454. nodetype:=t;
  455. blocktype:=block_type;
  456. { updated by firstpass }
  457. expectloc:=LOC_INVALID;
  458. { updated by secondpass }
  459. location.loc:=LOC_INVALID;
  460. { save local info }
  461. fileinfo:=aktfilepos;
  462. localswitches:=aktlocalswitches;
  463. resulttype.reset;
  464. registers32:=0;
  465. registersfpu:=0;
  466. {$ifdef SUPPORT_MMX}
  467. registersmmx:=0;
  468. {$endif SUPPORT_MMX}
  469. {$ifdef EXTDEBUG}
  470. maxfirstpasscount:=0;
  471. firstpasscount:=0;
  472. {$endif EXTDEBUG}
  473. flags:=[];
  474. end;
  475. constructor tnode.createforcopy;
  476. begin
  477. end;
  478. constructor tnode.ppuload(t:tnodetype;ppufile:tcompilerppufile);
  479. begin
  480. nodetype:=t;
  481. { tnode fields }
  482. blocktype:=tblock_type(ppufile.getbyte);
  483. ppufile.getposinfo(fileinfo);
  484. ppufile.getsmallset(localswitches);
  485. ppufile.gettype(resulttype);
  486. ppufile.getsmallset(flags);
  487. { updated by firstpass }
  488. expectloc:=LOC_INVALID;
  489. { updated by secondpass }
  490. location.loc:=LOC_INVALID;
  491. registers32:=0;
  492. registersfpu:=0;
  493. {$ifdef SUPPORT_MMX}
  494. registersmmx:=0;
  495. {$endif SUPPORT_MMX}
  496. {$ifdef EXTDEBUG}
  497. maxfirstpasscount:=0;
  498. firstpasscount:=0;
  499. {$endif EXTDEBUG}
  500. end;
  501. procedure tnode.ppuwrite(ppufile:tcompilerppufile);
  502. begin
  503. ppufile.putbyte(byte(block_type));
  504. ppufile.putposinfo(fileinfo);
  505. ppufile.putsmallset(localswitches);
  506. ppufile.puttype(resulttype);
  507. ppufile.putsmallset(flags);
  508. end;
  509. procedure tnode.derefimpl;
  510. begin
  511. resulttype.resolve;
  512. end;
  513. procedure tnode.toggleflag(f : tnodeflags);
  514. begin
  515. if f in flags then
  516. exclude(flags,f)
  517. else
  518. include(flags,f);
  519. end;
  520. destructor tnode.destroy;
  521. begin
  522. {$ifdef EXTDEBUG}
  523. if firstpasscount>maxfirstpasscount then
  524. maxfirstpasscount:=firstpasscount;
  525. {$endif EXTDEBUG}
  526. end;
  527. procedure tnode.concattolist(l : tlinkedlist);
  528. begin
  529. end;
  530. function tnode.ischild(p : tnode) : boolean;
  531. begin
  532. ischild:=false;
  533. end;
  534. procedure tnode.mark_write;
  535. begin
  536. {$ifdef EXTDEBUG}
  537. Comment(V_Warning,'mark_write not implemented for '+nodetype2str[nodetype]);
  538. {$endif EXTDEBUG}
  539. end;
  540. {$ifdef EXTDEBUG}
  541. procedure tnode._dowrite;
  542. const
  543. loc2str : array[TCGLoc] of string[18] = (
  544. 'LOC_INVALID',
  545. 'LOC_VOID',
  546. 'LOC_CONSTANT',
  547. 'LOC_JUMP',
  548. 'LOC_FLAGS',
  549. 'LOC_CREFERENCE',
  550. 'LOC_REFERENCE',
  551. 'LOC_REGISTER',
  552. 'LOC_CREGISTER',
  553. 'LOC_FPUREGISTER',
  554. 'LOC_CFPUREGISTER',
  555. 'LOC_MMXREGISTER',
  556. 'LOC_CMMXREGISTER',
  557. 'LOC_SSEREGISTER',
  558. 'LOC_CSSEREGISTER',
  559. 'LOC_MMREGISTER',
  560. 'LOC_CMMREGISTER');
  561. begin
  562. dowritenodetype;
  563. if assigned(resulttype.def) then
  564. write(',resulttype = "',resulttype.def.gettypename,'"')
  565. else
  566. write(',resulttype = <nil>');
  567. write(',location.loc = ',loc2str[location.loc]);
  568. write(',registersint = ',registers32);
  569. write(',registersfpu = ',registersfpu);
  570. end;
  571. procedure tnode.dowritenodetype;
  572. begin
  573. write(nodetype2str[nodetype]);
  574. end;
  575. procedure tnode.dowrite;
  576. begin
  577. write(writenodeindention,'(');
  578. writenodeindention:=writenodeindention+' ';
  579. _dowrite;
  580. writeln;
  581. delete(writenodeindention,1,4);
  582. write(writenodeindention,')');
  583. end;
  584. {$endif EXTDEBUG}
  585. function tnode.isequal(p : tnode) : boolean;
  586. begin
  587. isequal:=
  588. (not assigned(self) and not assigned(p)) or
  589. (assigned(self) and assigned(p) and
  590. { optimized subclasses have the same nodetype as their }
  591. { superclass (for compatibility), so also check the classtype (JM) }
  592. (p.classtype=classtype) and
  593. (p.nodetype=nodetype) and
  594. (flags*flagsequal=p.flags*flagsequal) and
  595. docompare(p));
  596. end;
  597. {$ifdef state_tracking}
  598. function Tnode.track_state_pass(exec_known:boolean):boolean;
  599. begin
  600. track_state_pass:=false;
  601. end;
  602. {$endif state_tracking}
  603. function tnode.docompare(p : tnode) : boolean;
  604. begin
  605. docompare:=true;
  606. end;
  607. function tnode.getcopy : tnode;
  608. var
  609. p : tnode;
  610. begin
  611. { this is quite tricky because we need a node of the current }
  612. { node type and not one of tnode! }
  613. p:=tnodeclass(classtype).createforcopy;
  614. p.nodetype:=nodetype;
  615. p.location:=location;
  616. p.parent:=parent;
  617. p.flags:=flags;
  618. p.registers32:=registers32;
  619. p.registersfpu:=registersfpu;
  620. {$ifdef SUPPORT_MMX}
  621. p.registersmmx:=registersmmx;
  622. p.registerskni:=registerskni;
  623. {$endif SUPPORT_MMX}
  624. p.resulttype:=resulttype;
  625. p.fileinfo:=fileinfo;
  626. p.localswitches:=localswitches;
  627. {$ifdef extdebug}
  628. p.firstpasscount:=firstpasscount;
  629. {$endif extdebug}
  630. { p.list:=list; }
  631. getcopy:=p;
  632. end;
  633. { procedure tnode.mark_write;
  634. begin
  635. end;}
  636. procedure tnode.insertintolist(l : tnodelist);
  637. begin
  638. end;
  639. procedure tnode.set_file_line(from : tnode);
  640. begin
  641. if assigned(from) then
  642. fileinfo:=from.fileinfo;
  643. end;
  644. procedure tnode.set_tree_filepos(const filepos : tfileposinfo);
  645. begin
  646. fileinfo:=filepos;
  647. end;
  648. {****************************************************************************
  649. TUNARYNODE
  650. ****************************************************************************}
  651. constructor tunarynode.create(t:tnodetype;l : tnode);
  652. begin
  653. inherited create(t);
  654. left:=l;
  655. end;
  656. constructor tunarynode.ppuload(t:tnodetype;ppufile:tcompilerppufile);
  657. begin
  658. inherited ppuload(t,ppufile);
  659. left:=ppuloadnode(ppufile);
  660. end;
  661. destructor tunarynode.destroy;
  662. begin
  663. left.free;
  664. inherited destroy;
  665. end;
  666. procedure tunarynode.ppuwrite(ppufile:tcompilerppufile);
  667. begin
  668. inherited ppuwrite(ppufile);
  669. ppuwritenode(ppufile,left);
  670. end;
  671. procedure tunarynode.derefimpl;
  672. begin
  673. inherited derefimpl;
  674. if assigned(left) then
  675. left.derefimpl;
  676. end;
  677. function tunarynode.docompare(p : tnode) : boolean;
  678. begin
  679. docompare:=(inherited docompare(p) and
  680. ((left=nil) or left.isequal(tunarynode(p).left))
  681. );
  682. end;
  683. function tunarynode.getcopy : tnode;
  684. var
  685. p : tunarynode;
  686. begin
  687. p:=tunarynode(inherited getcopy);
  688. if assigned(left) then
  689. p.left:=left.getcopy
  690. else
  691. p.left:=nil;
  692. getcopy:=p;
  693. end;
  694. procedure tunarynode.insertintolist(l : tnodelist);
  695. begin
  696. end;
  697. {$ifdef extdebug}
  698. procedure tunarynode._dowrite;
  699. begin
  700. inherited _dowrite;
  701. writeln(',');
  702. writenode(left);
  703. end;
  704. {$endif}
  705. procedure tunarynode.left_max;
  706. begin
  707. registers32:=left.registers32;
  708. registersfpu:=left.registersfpu;
  709. {$ifdef SUPPORT_MMX}
  710. registersmmx:=left.registersmmx;
  711. {$endif SUPPORT_MMX}
  712. end;
  713. procedure tunarynode.concattolist(l : tlinkedlist);
  714. begin
  715. left.parent:=self;
  716. left.concattolist(l);
  717. inherited concattolist(l);
  718. end;
  719. function tunarynode.ischild(p : tnode) : boolean;
  720. begin
  721. ischild:=p=left;
  722. end;
  723. {****************************************************************************
  724. TBINARYNODE
  725. ****************************************************************************}
  726. constructor tbinarynode.create(t:tnodetype;l,r : tnode);
  727. begin
  728. inherited create(t,l);
  729. right:=r
  730. end;
  731. constructor tbinarynode.ppuload(t:tnodetype;ppufile:tcompilerppufile);
  732. begin
  733. inherited ppuload(t,ppufile);
  734. right:=ppuloadnode(ppufile);
  735. end;
  736. destructor tbinarynode.destroy;
  737. begin
  738. right.free;
  739. inherited destroy;
  740. end;
  741. procedure tbinarynode.ppuwrite(ppufile:tcompilerppufile);
  742. begin
  743. inherited ppuwrite(ppufile);
  744. ppuwritenode(ppufile,right);
  745. end;
  746. procedure tbinarynode.derefimpl;
  747. begin
  748. inherited derefimpl;
  749. if assigned(right) then
  750. right.derefimpl;
  751. end;
  752. procedure tbinarynode.concattolist(l : tlinkedlist);
  753. begin
  754. { we could change that depending on the number of }
  755. { required registers }
  756. left.parent:=self;
  757. left.concattolist(l);
  758. left.parent:=self;
  759. left.concattolist(l);
  760. inherited concattolist(l);
  761. end;
  762. function tbinarynode.ischild(p : tnode) : boolean;
  763. begin
  764. ischild:=(p=right);
  765. end;
  766. function tbinarynode.docompare(p : tnode) : boolean;
  767. begin
  768. docompare:=(inherited docompare(p) and
  769. ((right=nil) or right.isequal(tbinarynode(p).right))
  770. );
  771. end;
  772. function tbinarynode.getcopy : tnode;
  773. var
  774. p : tbinarynode;
  775. begin
  776. p:=tbinarynode(inherited getcopy);
  777. if assigned(right) then
  778. p.right:=right.getcopy
  779. else
  780. p.right:=nil;
  781. getcopy:=p;
  782. end;
  783. procedure tbinarynode.insertintolist(l : tnodelist);
  784. begin
  785. end;
  786. procedure tbinarynode.swapleftright;
  787. var
  788. swapp : tnode;
  789. begin
  790. swapp:=right;
  791. right:=left;
  792. left:=swapp;
  793. if nf_swaped in flags then
  794. exclude(flags,nf_swaped)
  795. else
  796. include(flags,nf_swaped);
  797. end;
  798. procedure tbinarynode.left_right_max;
  799. begin
  800. if assigned(left) then
  801. begin
  802. if assigned(right) then
  803. begin
  804. registers32:=max(left.registers32,right.registers32);
  805. registersfpu:=max(left.registersfpu,right.registersfpu);
  806. {$ifdef SUPPORT_MMX}
  807. registersmmx:=max(left.registersmmx,right.registersmmx);
  808. {$endif SUPPORT_MMX}
  809. end
  810. else
  811. begin
  812. registers32:=left.registers32;
  813. registersfpu:=left.registersfpu;
  814. {$ifdef SUPPORT_MMX}
  815. registersmmx:=left.registersmmx;
  816. {$endif SUPPORT_MMX}
  817. end;
  818. end;
  819. end;
  820. {$ifdef extdebug}
  821. procedure tbinarynode._dowrite;
  822. begin
  823. inherited _dowrite;
  824. writeln(',');
  825. writenode(right);
  826. end;
  827. {$endif}
  828. {****************************************************************************
  829. TBINOPYNODE
  830. ****************************************************************************}
  831. constructor tbinopnode.create(t:tnodetype;l,r : tnode);
  832. begin
  833. inherited create(t,l,r);
  834. end;
  835. function tbinopnode.docompare(p : tnode) : boolean;
  836. begin
  837. docompare:=(inherited docompare(p)) or
  838. { if that's in the flags, is p then always a tbinopnode (?) (JM) }
  839. ((nf_swapable in flags) and
  840. left.isequal(tbinopnode(p).right) and
  841. right.isequal(tbinopnode(p).left));
  842. end;
  843. end.
  844. {
  845. $Log$
  846. Revision 1.56 2003-04-24 22:29:58 florian
  847. * fixed a lot of PowerPC related stuff
  848. Revision 1.55 2003/04/23 10:12:14 peter
  849. * allow multi pass2 changed to global boolean instead of node flag
  850. Revision 1.54 2003/04/22 23:50:23 peter
  851. * firstpass uses expectloc
  852. * checks if there are differences between the expectloc and
  853. location.loc from secondpass in EXTDEBUG
  854. Revision 1.53 2003/04/22 09:52:00 peter
  855. * mark_write implemented for default with a warning in EXTDEBUG, this
  856. is required for error recovery where the left node can be also a non
  857. writable node
  858. Revision 1.52 2003/04/10 17:57:52 peter
  859. * vs_hidden released
  860. Revision 1.51 2003/03/28 19:16:56 peter
  861. * generic constructor working for i386
  862. * remove fixed self register
  863. * esi added as address register for i386
  864. Revision 1.50 2003/03/17 16:54:41 peter
  865. * support DefaultHandler and anonymous inheritance fixed
  866. for message methods
  867. Revision 1.49 2003/01/04 15:54:03 daniel
  868. * Fixed mark_write for @ operator
  869. (can happen when compiling @procvar:=nil (Delphi mode construction))
  870. Revision 1.48 2003/01/03 21:03:02 peter
  871. * made mark_write dummy instead of abstract
  872. Revision 1.47 2003/01/03 12:15:56 daniel
  873. * Removed ifdefs around notifications
  874. ifdefs around for loop optimizations remain
  875. Revision 1.46 2002/12/26 18:24:33 jonas
  876. * fixed check for whether or not a high parameter was already generated
  877. * no type checking/conversions for invisible parameters
  878. Revision 1.45 2002/11/28 11:17:04 florian
  879. * loop node flags from node flags splitted
  880. Revision 1.44 2002/10/05 00:48:57 peter
  881. * support inherited; support for overload as it is handled by
  882. delphi. This is only for delphi mode as it is working is
  883. undocumented and hard to predict what is done
  884. Revision 1.43 2002/09/07 15:25:03 peter
  885. * old logs removed and tabs fixed
  886. Revision 1.42 2002/09/03 16:26:26 daniel
  887. * Make Tprocdef.defs protected
  888. Revision 1.41 2002/09/01 13:28:38 daniel
  889. - write_access fields removed in favor of a flag
  890. Revision 1.40 2002/09/01 08:01:16 daniel
  891. * Removed sets from Tcallnode.det_resulttype
  892. + Added read/write notifications of variables. These will be usefull
  893. for providing information for several optimizations. For example
  894. the value of the loop variable of a for loop does matter is the
  895. variable is read after the for loop, but if it's no longer used
  896. or written, it doesn't matter and this can be used to optimize
  897. the loop code generation.
  898. Revision 1.39 2002/08/22 11:21:45 florian
  899. + register32 is now written by tnode.dowrite
  900. * fixed write of value of tconstnode
  901. Revision 1.38 2002/08/19 19:36:44 peter
  902. * More fixes for cross unit inlining, all tnodes are now implemented
  903. * Moved pocall_internconst to po_internconst because it is not a
  904. calling type at all and it conflicted when inlining of these small
  905. functions was requested
  906. Revision 1.37 2002/08/18 20:06:24 peter
  907. * inlining is now also allowed in interface
  908. * renamed write/load to ppuwrite/ppuload
  909. * tnode storing in ppu
  910. * nld,ncon,nbas are already updated for storing in ppu
  911. Revision 1.36 2002/08/17 22:09:46 florian
  912. * result type handling in tcgcal.pass_2 overhauled
  913. * better tnode.dowrite
  914. * some ppc stuff fixed
  915. Revision 1.35 2002/08/15 19:10:35 peter
  916. * first things tai,tnode storing in ppu
  917. Revision 1.34 2002/08/09 19:15:41 carl
  918. - removed newcg define
  919. Revision 1.33 2002/07/23 12:34:30 daniel
  920. * Readded old set code. To use it define 'oldset'. Activated by default
  921. for ppc.
  922. Revision 1.32 2002/07/22 11:48:04 daniel
  923. * Sets are now internally sets.
  924. Revision 1.31 2002/07/21 06:58:49 daniel
  925. * Changed booleans into flags
  926. Revision 1.30 2002/07/19 11:41:36 daniel
  927. * State tracker work
  928. * The whilen and repeatn are now completely unified into whilerepeatn. This
  929. allows the state tracker to change while nodes automatically into
  930. repeat nodes.
  931. * Resulttypepass improvements to the notn. 'not not a' is optimized away and
  932. 'not(a>b)' is optimized into 'a<=b'.
  933. * Resulttypepass improvements to the whilerepeatn. 'while not a' is optimized
  934. by removing the notn and later switchting the true and falselabels. The
  935. same is done with 'repeat until not a'.
  936. Revision 1.29 2002/07/14 18:00:44 daniel
  937. + Added the beginning of a state tracker. This will track the values of
  938. variables through procedures and optimize things away.
  939. Revision 1.28 2002/07/01 18:46:24 peter
  940. * internal linker
  941. * reorganized aasm layer
  942. Revision 1.27 2002/05/18 13:34:10 peter
  943. * readded missing revisions
  944. Revision 1.26 2002/05/16 19:46:39 carl
  945. + defines.inc -> fpcdefs.inc to avoid conflicts if compiling by hand
  946. + try to fix temp allocation (still in ifdef)
  947. + generic constructor calls
  948. + start of tassembler / tmodulebase class cleanup
  949. Revision 1.24 2002/04/21 19:02:04 peter
  950. * removed newn and disposen nodes, the code is now directly
  951. inlined from pexpr
  952. * -an option that will write the secondpass nodes to the .s file, this
  953. requires EXTDEBUG define to actually write the info
  954. * fixed various internal errors and crashes due recent code changes
  955. Revision 1.23 2002/04/06 18:13:01 jonas
  956. * several powerpc-related additions and fixes
  957. Revision 1.22 2002/03/31 20:26:35 jonas
  958. + a_loadfpu_* and a_loadmm_* methods in tcg
  959. * register allocation is now handled by a class and is mostly processor
  960. independent (+rgobj.pas and i386/rgcpu.pas)
  961. * temp allocation is now handled by a class (+tgobj.pas, -i386\tgcpu.pas)
  962. * some small improvements and fixes to the optimizer
  963. * some register allocation fixes
  964. * some fpuvaroffset fixes in the unary minus node
  965. * push/popusedregisters is now called rg.save/restoreusedregisters and
  966. (for i386) uses temps instead of push/pop's when using -Op3 (that code is
  967. also better optimizable)
  968. * fixed and optimized register saving/restoring for new/dispose nodes
  969. * LOC_FPU locations now also require their "register" field to be set to
  970. R_ST, not R_ST0 (the latter is used for LOC_CFPUREGISTER locations only)
  971. - list field removed of the tnode class because it's not used currently
  972. and can cause hard-to-find bugs
  973. }