node.pas 36 KB

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