node.pas 33 KB

1234567891011121314151617181920212223242526272829303132333435363738394041424344454647484950515253545556575859606162636465666768697071727374757677787980818283848586878889909192939495969798991001011021031041051061071081091101111121131141151161171181191201211221231241251261271281291301311321331341351361371381391401411421431441451461471481491501511521531541551561571581591601611621631641651661671681691701711721731741751761771781791801811821831841851861871881891901911921931941951961971981992002012022032042052062072082092102112122132142152162172182192202212222232242252262272282292302312322332342352362372382392402412422432442452462472482492502512522532542552562572582592602612622632642652662672682692702712722732742752762772782792802812822832842852862872882892902912922932942952962972982993003013023033043053063073083093103113123133143153163173183193203213223233243253263273283293303313323333343353363373383393403413423433443453463473483493503513523533543553563573583593603613623633643653663673683693703713723733743753763773783793803813823833843853863873883893903913923933943953963973983994004014024034044054064074084094104114124134144154164174184194204214224234244254264274284294304314324334344354364374384394404414424434444454464474484494504514524534544554564574584594604614624634644654664674684694704714724734744754764774784794804814824834844854864874884894904914924934944954964974984995005015025035045055065075085095105115125135145155165175185195205215225235245255265275285295305315325335345355365375385395405415425435445455465475485495505515525535545555565575585595605615625635645655665675685695705715725735745755765775785795805815825835845855865875885895905915925935945955965975985996006016026036046056066076086096106116126136146156166176186196206216226236246256266276286296306316326336346356366376386396406416426436446456466476486496506516526536546556566576586596606616626636646656666676686696706716726736746756766776786796806816826836846856866876886896906916926936946956966976986997007017027037047057067077087097107117127137147157167177187197207217227237247257267277287297307317327337347357367377387397407417427437447457467477487497507517527537547557567577587597607617627637647657667677687697707717727737747757767777787797807817827837847857867877887897907917927937947957967977987998008018028038048058068078088098108118128138148158168178188198208218228238248258268278288298308318328338348358368378388398408418428438448458468478488498508518528538548558568578588598608618628638648658668678688698708718728738748758768778788798808818828838848858868878888898908918928938948958968978988999009019029039049059069079089099109119129139149159169179189199209219229239249259269279289299309319329339349359369379389399409419429439449459469479489499509519529539549559569579589599609619629639649659669679689699709719729739749759769779789799809819829839849859869879889899909919929939949959969979989991000100110021003100410051006100710081009101010111012101310141015101610171018101910201021102210231024102510261027102810291030103110321033103410351036103710381039104010411042104310441045104610471048104910501051105210531054105510561057105810591060106110621063106410651066106710681069107010711072107310741075107610771078107910801081108210831084108510861087108810891090109110921093109410951096109710981099
  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. 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_needs_truefalselabel,
  205. nf_swapable, { tbinop operands can be swaped }
  206. nf_swaped, { tbinop operands are swaped }
  207. nf_error,
  208. nf_write, { Node is written to }
  209. { flags used by tcallnode }
  210. nf_return_value_used,
  211. nf_static_call,
  212. nf_auto_inherited,
  213. { flags used by tcallparanode }
  214. nf_varargs_para, { belongs this para to varargs }
  215. nf_hightree_generated, { has the hightree for thispara been generated }
  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,
  231. { tarrayconstructnode }
  232. nf_cargs, { 20th }
  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, { 30th }
  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];
  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(t:tnodetype);
  283. { this constructor is only for creating copies of class }
  284. { the fields are copied by getcopy }
  285. constructor createforcopy;
  286. constructor ppuload(t:tnodetype;ppufile:tcompilerppufile);virtual;
  287. destructor destroy;override;
  288. procedure ppuwrite(ppufile:tcompilerppufile);virtual;
  289. procedure derefimpl;virtual;
  290. { toggles the flag }
  291. procedure toggleflag(f : tnodeflags);
  292. { the 1.1 code generator may override pass_1 }
  293. { and it need not to implement det_* then }
  294. { 1.1: pass_1 returns a value<>0 if the node has been transformed }
  295. { 2.0: runs det_resulttype and det_temp }
  296. function pass_1 : tnode;virtual;abstract;
  297. { dermines the resulttype of the node }
  298. function det_resulttype : tnode;virtual;abstract;
  299. { dermines the number of necessary temp. locations to evaluate
  300. the node }
  301. {$ifdef state_tracking}
  302. { Does optimizations by keeping track of the variable states
  303. in a procedure }
  304. function track_state_pass(exec_known:boolean):boolean;virtual;
  305. {$endif}
  306. {$ifdef var_notification}
  307. { For a t1:=t2 tree, mark the part of the tree t1 that gets
  308. written to (normally the loadnode) as write access. }
  309. procedure mark_write;virtual;abstract;
  310. {$endif}
  311. procedure det_temp;virtual;abstract;
  312. procedure pass_2;virtual;abstract;
  313. { comparing of nodes }
  314. function isequal(p : tnode) : boolean;
  315. { to implement comparisation, override this method }
  316. function docompare(p : tnode) : boolean;virtual;
  317. { gets a copy of the node }
  318. function getcopy : tnode;virtual;
  319. procedure insertintolist(l : tnodelist);virtual;
  320. {$ifdef EXTDEBUG}
  321. { writes a node for debugging purpose, shouldn't be called }
  322. { direct, because there is no test for nil, use writenode }
  323. { to write a complete tree }
  324. procedure dowrite;
  325. procedure dowritenodetype;virtual;
  326. procedure _dowrite;virtual;
  327. {$endif EXTDEBUG}
  328. procedure concattolist(l : tlinkedlist);virtual;
  329. function ischild(p : tnode) : boolean;virtual;
  330. procedure set_file_line(from : tnode);
  331. procedure set_tree_filepos(const filepos : tfileposinfo);
  332. end;
  333. tnodeclass = class of tnode;
  334. tnodeclassarray = array[tnodetype] of tnodeclass;
  335. { this node is the anchestor for all nodes with at least }
  336. { one child, you have to use it if you want to use }
  337. { true- and falselabel }
  338. punarynode = ^tunarynode;
  339. tunarynode = class(tnode)
  340. left : tnode;
  341. constructor create(t:tnodetype;l : tnode);
  342. constructor ppuload(t:tnodetype;ppufile:tcompilerppufile);override;
  343. destructor destroy;override;
  344. procedure ppuwrite(ppufile:tcompilerppufile);override;
  345. procedure derefimpl;override;
  346. procedure concattolist(l : tlinkedlist);override;
  347. function ischild(p : tnode) : boolean;override;
  348. function docompare(p : tnode) : boolean;override;
  349. function getcopy : tnode;override;
  350. procedure insertintolist(l : tnodelist);override;
  351. procedure left_max;
  352. {$ifdef extdebug}
  353. procedure _dowrite;override;
  354. {$endif extdebug}
  355. end;
  356. pbinarynode = ^tbinarynode;
  357. tbinarynode = class(tunarynode)
  358. right : tnode;
  359. constructor create(t:tnodetype;l,r : tnode);
  360. constructor ppuload(t:tnodetype;ppufile:tcompilerppufile);override;
  361. destructor destroy;override;
  362. procedure ppuwrite(ppufile:tcompilerppufile);override;
  363. procedure derefimpl;override;
  364. procedure concattolist(l : tlinkedlist);override;
  365. function ischild(p : tnode) : boolean;override;
  366. function docompare(p : tnode) : boolean;override;
  367. procedure swapleftright;
  368. function getcopy : tnode;override;
  369. procedure insertintolist(l : tnodelist);override;
  370. procedure left_right_max;
  371. {$ifdef extdebug}
  372. procedure _dowrite;override;
  373. {$endif extdebug}
  374. end;
  375. tbinopnode = class(tbinarynode)
  376. constructor create(t:tnodetype;l,r : tnode);virtual;
  377. function docompare(p : tnode) : boolean;override;
  378. end;
  379. {$ifdef tempregdebug}
  380. type
  381. pptree = ^tnode;
  382. var
  383. curptree: pptree;
  384. {$endif tempregdebug}
  385. var
  386. { array with all class types for tnodes }
  387. nodeclass : tnodeclassarray;
  388. {$ifdef EXTDEBUG}
  389. { indention used when writing the tree to the screen }
  390. writenodeindention : string;
  391. {$endif EXTDEBUG}
  392. function ppuloadnode(ppufile:tcompilerppufile):tnode;
  393. procedure ppuwritenode(ppufile:tcompilerppufile;n:tnode);
  394. {$ifdef EXTDEBUG}
  395. procedure writenode(t:tnode);
  396. {$endif EXTDEBUG}
  397. implementation
  398. uses
  399. cutils,verbose;
  400. const
  401. ppunodemarker = 255;
  402. {****************************************************************************
  403. Helpers
  404. ****************************************************************************}
  405. function ppuloadnode(ppufile:tcompilerppufile):tnode;
  406. var
  407. b : byte;
  408. t : tnodetype;
  409. begin
  410. { marker }
  411. b:=ppufile.getbyte;
  412. if b<>ppunodemarker then
  413. internalerror(200208151);
  414. { load nodetype }
  415. t:=tnodetype(ppufile.getbyte);
  416. if t>high(tnodetype) then
  417. internalerror(200208152);
  418. if t<>emptynode then
  419. begin
  420. if not assigned(nodeclass[t]) then
  421. internalerror(200208153);
  422. //writeln('load: ',nodetype2str[t]);
  423. { generate node of the correct class }
  424. ppuloadnode:=nodeclass[t].ppuload(t,ppufile);
  425. end
  426. else
  427. ppuloadnode:=nil;
  428. end;
  429. procedure ppuwritenode(ppufile:tcompilerppufile;n:tnode);
  430. begin
  431. { marker, read by ppuloadnode }
  432. ppufile.putbyte(ppunodemarker);
  433. { type, read by ppuloadnode }
  434. if assigned(n) then
  435. begin
  436. ppufile.putbyte(byte(n.nodetype));
  437. //writeln('write: ',nodetype2str[n.nodetype]);
  438. n.ppuwrite(ppufile);
  439. end
  440. else
  441. ppufile.putbyte(byte(emptynode));
  442. end;
  443. {$ifdef EXTDEBUG}
  444. procedure writenode(t:tnode);
  445. begin
  446. if assigned(t) then
  447. t.dowrite
  448. else
  449. write(writenodeindention,'nil');
  450. if writenodeindention='' then
  451. writeln;
  452. end;
  453. {$endif EXTDEBUG}
  454. {****************************************************************************
  455. TNODE
  456. ****************************************************************************}
  457. constructor tnode.create(t:tnodetype);
  458. begin
  459. inherited create;
  460. nodetype:=t;
  461. blocktype:=block_type;
  462. { this allows easier error tracing }
  463. location.loc:=LOC_INVALID;
  464. { save local info }
  465. fileinfo:=aktfilepos;
  466. localswitches:=aktlocalswitches;
  467. resulttype.reset;
  468. registers32:=0;
  469. registersfpu:=0;
  470. {$ifdef SUPPORT_MMX}
  471. registersmmx:=0;
  472. {$endif SUPPORT_MMX}
  473. {$ifdef EXTDEBUG}
  474. maxfirstpasscount:=0;
  475. firstpasscount:=0;
  476. {$endif EXTDEBUG}
  477. flags:=[];
  478. end;
  479. constructor tnode.createforcopy;
  480. begin
  481. end;
  482. constructor tnode.ppuload(t:tnodetype;ppufile:tcompilerppufile);
  483. begin
  484. nodetype:=t;
  485. { tnode fields }
  486. blocktype:=tblock_type(ppufile.getbyte);
  487. ppufile.getposinfo(fileinfo);
  488. ppufile.getsmallset(localswitches);
  489. ppufile.gettype(resulttype);
  490. ppufile.getsmallset(flags);
  491. { updated by firstpass }
  492. location.loc:=LOC_INVALID;
  493. registers32:=0;
  494. registersfpu:=0;
  495. {$ifdef SUPPORT_MMX}
  496. registersmmx:=0;
  497. {$endif SUPPORT_MMX}
  498. {$ifdef EXTDEBUG}
  499. maxfirstpasscount:=0;
  500. firstpasscount:=0;
  501. {$endif EXTDEBUG}
  502. end;
  503. procedure tnode.ppuwrite(ppufile:tcompilerppufile);
  504. begin
  505. ppufile.putbyte(byte(block_type));
  506. ppufile.putposinfo(fileinfo);
  507. ppufile.putsmallset(localswitches);
  508. ppufile.puttype(resulttype);
  509. ppufile.putsmallset(flags);
  510. end;
  511. procedure tnode.derefimpl;
  512. begin
  513. resulttype.resolve;
  514. end;
  515. procedure tnode.toggleflag(f : tnodeflags);
  516. begin
  517. if f in flags then
  518. exclude(flags,f)
  519. else
  520. include(flags,f);
  521. end;
  522. destructor tnode.destroy;
  523. begin
  524. {$ifdef EXTDEBUG}
  525. if firstpasscount>maxfirstpasscount then
  526. maxfirstpasscount:=firstpasscount;
  527. {$endif EXTDEBUG}
  528. end;
  529. procedure tnode.concattolist(l : tlinkedlist);
  530. begin
  531. end;
  532. function tnode.ischild(p : tnode) : boolean;
  533. begin
  534. ischild:=false;
  535. end;
  536. {$ifdef EXTDEBUG}
  537. procedure tnode._dowrite;
  538. begin
  539. dowritenodetype;
  540. if assigned(resulttype.def) then
  541. write(',resulttype = "',resulttype.def.gettypename,'"')
  542. else
  543. write(',resulttype = <nil>');
  544. write(',location.loc = ',ord(location.loc));
  545. write(',registersint = ',registers32);
  546. write(',registersfpu = ',registersfpu);
  547. end;
  548. procedure tnode.dowritenodetype;
  549. begin
  550. write(nodetype2str[nodetype]);
  551. end;
  552. procedure tnode.dowrite;
  553. begin
  554. write(writenodeindention,'(');
  555. writenodeindention:=writenodeindention+' ';
  556. _dowrite;
  557. writeln;
  558. delete(writenodeindention,1,4);
  559. write(writenodeindention,')');
  560. end;
  561. {$endif EXTDEBUG}
  562. function tnode.isequal(p : tnode) : boolean;
  563. begin
  564. isequal:=
  565. (not assigned(self) and not assigned(p)) or
  566. (assigned(self) and assigned(p) and
  567. { optimized subclasses have the same nodetype as their }
  568. { superclass (for compatibility), so also check the classtype (JM) }
  569. (p.classtype=classtype) and
  570. (p.nodetype=nodetype) and
  571. (flags*flagsequal=p.flags*flagsequal) and
  572. docompare(p));
  573. end;
  574. {$ifdef state_tracking}
  575. function Tnode.track_state_pass(exec_known:boolean):boolean;
  576. begin
  577. track_state_pass:=false;
  578. end;
  579. {$endif state_tracking}
  580. function tnode.docompare(p : tnode) : boolean;
  581. begin
  582. docompare:=true;
  583. end;
  584. function tnode.getcopy : tnode;
  585. var
  586. p : tnode;
  587. begin
  588. { this is quite tricky because we need a node of the current }
  589. { node type and not one of tnode! }
  590. p:=tnodeclass(classtype).createforcopy;
  591. p.nodetype:=nodetype;
  592. p.location:=location;
  593. p.parent:=parent;
  594. p.flags:=flags;
  595. p.registers32:=registers32;
  596. p.registersfpu:=registersfpu;
  597. {$ifdef SUPPORT_MMX}
  598. p.registersmmx:=registersmmx;
  599. p.registerskni:=registerskni;
  600. {$endif SUPPORT_MMX}
  601. p.resulttype:=resulttype;
  602. p.fileinfo:=fileinfo;
  603. p.localswitches:=localswitches;
  604. {$ifdef extdebug}
  605. p.firstpasscount:=firstpasscount;
  606. {$endif extdebug}
  607. { p.list:=list; }
  608. getcopy:=p;
  609. end;
  610. procedure tnode.insertintolist(l : tnodelist);
  611. begin
  612. end;
  613. procedure tnode.set_file_line(from : tnode);
  614. begin
  615. if assigned(from) then
  616. fileinfo:=from.fileinfo;
  617. end;
  618. procedure tnode.set_tree_filepos(const filepos : tfileposinfo);
  619. begin
  620. fileinfo:=filepos;
  621. end;
  622. {****************************************************************************
  623. TUNARYNODE
  624. ****************************************************************************}
  625. constructor tunarynode.create(t:tnodetype;l : tnode);
  626. begin
  627. inherited create(t);
  628. left:=l;
  629. end;
  630. constructor tunarynode.ppuload(t:tnodetype;ppufile:tcompilerppufile);
  631. begin
  632. inherited ppuload(t,ppufile);
  633. left:=ppuloadnode(ppufile);
  634. end;
  635. destructor tunarynode.destroy;
  636. begin
  637. left.free;
  638. inherited destroy;
  639. end;
  640. procedure tunarynode.ppuwrite(ppufile:tcompilerppufile);
  641. begin
  642. inherited ppuwrite(ppufile);
  643. ppuwritenode(ppufile,left);
  644. end;
  645. procedure tunarynode.derefimpl;
  646. begin
  647. inherited derefimpl;
  648. if assigned(left) then
  649. left.derefimpl;
  650. end;
  651. function tunarynode.docompare(p : tnode) : boolean;
  652. begin
  653. docompare:=(inherited docompare(p) and
  654. ((left=nil) or left.isequal(tunarynode(p).left))
  655. );
  656. end;
  657. function tunarynode.getcopy : tnode;
  658. var
  659. p : tunarynode;
  660. begin
  661. p:=tunarynode(inherited getcopy);
  662. if assigned(left) then
  663. p.left:=left.getcopy
  664. else
  665. p.left:=nil;
  666. getcopy:=p;
  667. end;
  668. procedure tunarynode.insertintolist(l : tnodelist);
  669. begin
  670. end;
  671. {$ifdef extdebug}
  672. procedure tunarynode._dowrite;
  673. begin
  674. inherited _dowrite;
  675. writeln(',');
  676. writenode(left);
  677. end;
  678. {$endif}
  679. procedure tunarynode.left_max;
  680. begin
  681. registers32:=left.registers32;
  682. registersfpu:=left.registersfpu;
  683. {$ifdef SUPPORT_MMX}
  684. registersmmx:=left.registersmmx;
  685. {$endif SUPPORT_MMX}
  686. end;
  687. procedure tunarynode.concattolist(l : tlinkedlist);
  688. begin
  689. left.parent:=self;
  690. left.concattolist(l);
  691. inherited concattolist(l);
  692. end;
  693. function tunarynode.ischild(p : tnode) : boolean;
  694. begin
  695. ischild:=p=left;
  696. end;
  697. {****************************************************************************
  698. TBINARYNODE
  699. ****************************************************************************}
  700. constructor tbinarynode.create(t:tnodetype;l,r : tnode);
  701. begin
  702. inherited create(t,l);
  703. right:=r
  704. end;
  705. constructor tbinarynode.ppuload(t:tnodetype;ppufile:tcompilerppufile);
  706. begin
  707. inherited ppuload(t,ppufile);
  708. right:=ppuloadnode(ppufile);
  709. end;
  710. destructor tbinarynode.destroy;
  711. begin
  712. right.free;
  713. inherited destroy;
  714. end;
  715. procedure tbinarynode.ppuwrite(ppufile:tcompilerppufile);
  716. begin
  717. inherited ppuwrite(ppufile);
  718. ppuwritenode(ppufile,right);
  719. end;
  720. procedure tbinarynode.derefimpl;
  721. begin
  722. inherited derefimpl;
  723. if assigned(right) then
  724. right.derefimpl;
  725. end;
  726. procedure tbinarynode.concattolist(l : tlinkedlist);
  727. begin
  728. { we could change that depending on the number of }
  729. { required registers }
  730. left.parent:=self;
  731. left.concattolist(l);
  732. left.parent:=self;
  733. left.concattolist(l);
  734. inherited concattolist(l);
  735. end;
  736. function tbinarynode.ischild(p : tnode) : boolean;
  737. begin
  738. ischild:=(p=right);
  739. end;
  740. function tbinarynode.docompare(p : tnode) : boolean;
  741. begin
  742. docompare:=(inherited docompare(p) and
  743. ((right=nil) or right.isequal(tbinarynode(p).right))
  744. );
  745. end;
  746. function tbinarynode.getcopy : tnode;
  747. var
  748. p : tbinarynode;
  749. begin
  750. p:=tbinarynode(inherited getcopy);
  751. if assigned(right) then
  752. p.right:=right.getcopy
  753. else
  754. p.right:=nil;
  755. getcopy:=p;
  756. end;
  757. procedure tbinarynode.insertintolist(l : tnodelist);
  758. begin
  759. end;
  760. procedure tbinarynode.swapleftright;
  761. var
  762. swapp : tnode;
  763. begin
  764. swapp:=right;
  765. right:=left;
  766. left:=swapp;
  767. if nf_swaped in flags then
  768. exclude(flags,nf_swaped)
  769. else
  770. include(flags,nf_swaped);
  771. end;
  772. procedure tbinarynode.left_right_max;
  773. begin
  774. if assigned(left) then
  775. begin
  776. if assigned(right) then
  777. begin
  778. registers32:=max(left.registers32,right.registers32);
  779. registersfpu:=max(left.registersfpu,right.registersfpu);
  780. {$ifdef SUPPORT_MMX}
  781. registersmmx:=max(left.registersmmx,right.registersmmx);
  782. {$endif SUPPORT_MMX}
  783. end
  784. else
  785. begin
  786. registers32:=left.registers32;
  787. registersfpu:=left.registersfpu;
  788. {$ifdef SUPPORT_MMX}
  789. registersmmx:=left.registersmmx;
  790. {$endif SUPPORT_MMX}
  791. end;
  792. end;
  793. end;
  794. {$ifdef extdebug}
  795. procedure tbinarynode._dowrite;
  796. begin
  797. inherited _dowrite;
  798. writeln(',');
  799. writenode(right);
  800. end;
  801. {$endif}
  802. {****************************************************************************
  803. TBINOPYNODE
  804. ****************************************************************************}
  805. constructor tbinopnode.create(t:tnodetype;l,r : tnode);
  806. begin
  807. inherited create(t,l,r);
  808. end;
  809. function tbinopnode.docompare(p : tnode) : boolean;
  810. begin
  811. docompare:=(inherited docompare(p)) or
  812. { if that's in the flags, is p then always a tbinopnode (?) (JM) }
  813. ((nf_swapable in flags) and
  814. left.isequal(tbinopnode(p).right) and
  815. right.isequal(tbinopnode(p).left));
  816. end;
  817. end.
  818. {
  819. $Log$
  820. Revision 1.46 2002-12-26 18:24:33 jonas
  821. * fixed check for whether or not a high parameter was already generated
  822. * no type checking/conversions for invisible parameters
  823. Revision 1.45 2002/11/28 11:17:04 florian
  824. * loop node flags from node flags splitted
  825. Revision 1.44 2002/10/05 00:48:57 peter
  826. * support inherited; support for overload as it is handled by
  827. delphi. This is only for delphi mode as it is working is
  828. undocumented and hard to predict what is done
  829. Revision 1.43 2002/09/07 15:25:03 peter
  830. * old logs removed and tabs fixed
  831. Revision 1.42 2002/09/03 16:26:26 daniel
  832. * Make Tprocdef.defs protected
  833. Revision 1.41 2002/09/01 13:28:38 daniel
  834. - write_access fields removed in favor of a flag
  835. Revision 1.40 2002/09/01 08:01:16 daniel
  836. * Removed sets from Tcallnode.det_resulttype
  837. + Added read/write notifications of variables. These will be usefull
  838. for providing information for several optimizations. For example
  839. the value of the loop variable of a for loop does matter is the
  840. variable is read after the for loop, but if it's no longer used
  841. or written, it doesn't matter and this can be used to optimize
  842. the loop code generation.
  843. Revision 1.39 2002/08/22 11:21:45 florian
  844. + register32 is now written by tnode.dowrite
  845. * fixed write of value of tconstnode
  846. Revision 1.38 2002/08/19 19:36:44 peter
  847. * More fixes for cross unit inlining, all tnodes are now implemented
  848. * Moved pocall_internconst to po_internconst because it is not a
  849. calling type at all and it conflicted when inlining of these small
  850. functions was requested
  851. Revision 1.37 2002/08/18 20:06:24 peter
  852. * inlining is now also allowed in interface
  853. * renamed write/load to ppuwrite/ppuload
  854. * tnode storing in ppu
  855. * nld,ncon,nbas are already updated for storing in ppu
  856. Revision 1.36 2002/08/17 22:09:46 florian
  857. * result type handling in tcgcal.pass_2 overhauled
  858. * better tnode.dowrite
  859. * some ppc stuff fixed
  860. Revision 1.35 2002/08/15 19:10:35 peter
  861. * first things tai,tnode storing in ppu
  862. Revision 1.34 2002/08/09 19:15:41 carl
  863. - removed newcg define
  864. Revision 1.33 2002/07/23 12:34:30 daniel
  865. * Readded old set code. To use it define 'oldset'. Activated by default
  866. for ppc.
  867. Revision 1.32 2002/07/22 11:48:04 daniel
  868. * Sets are now internally sets.
  869. Revision 1.31 2002/07/21 06:58:49 daniel
  870. * Changed booleans into flags
  871. Revision 1.30 2002/07/19 11:41:36 daniel
  872. * State tracker work
  873. * The whilen and repeatn are now completely unified into whilerepeatn. This
  874. allows the state tracker to change while nodes automatically into
  875. repeat nodes.
  876. * Resulttypepass improvements to the notn. 'not not a' is optimized away and
  877. 'not(a>b)' is optimized into 'a<=b'.
  878. * Resulttypepass improvements to the whilerepeatn. 'while not a' is optimized
  879. by removing the notn and later switchting the true and falselabels. The
  880. same is done with 'repeat until not a'.
  881. Revision 1.29 2002/07/14 18:00:44 daniel
  882. + Added the beginning of a state tracker. This will track the values of
  883. variables through procedures and optimize things away.
  884. Revision 1.28 2002/07/01 18:46:24 peter
  885. * internal linker
  886. * reorganized aasm layer
  887. Revision 1.27 2002/05/18 13:34:10 peter
  888. * readded missing revisions
  889. Revision 1.26 2002/05/16 19:46:39 carl
  890. + defines.inc -> fpcdefs.inc to avoid conflicts if compiling by hand
  891. + try to fix temp allocation (still in ifdef)
  892. + generic constructor calls
  893. + start of tassembler / tmodulebase class cleanup
  894. Revision 1.24 2002/04/21 19:02:04 peter
  895. * removed newn and disposen nodes, the code is now directly
  896. inlined from pexpr
  897. * -an option that will write the secondpass nodes to the .s file, this
  898. requires EXTDEBUG define to actually write the info
  899. * fixed various internal errors and crashes due recent code changes
  900. Revision 1.23 2002/04/06 18:13:01 jonas
  901. * several powerpc-related additions and fixes
  902. Revision 1.22 2002/03/31 20:26:35 jonas
  903. + a_loadfpu_* and a_loadmm_* methods in tcg
  904. * register allocation is now handled by a class and is mostly processor
  905. independent (+rgobj.pas and i386/rgcpu.pas)
  906. * temp allocation is now handled by a class (+tgobj.pas, -i386\tgcpu.pas)
  907. * some small improvements and fixes to the optimizer
  908. * some register allocation fixes
  909. * some fpuvaroffset fixes in the unary minus node
  910. * push/popusedregisters is now called rg.save/restoreusedregisters and
  911. (for i386) uses temps instead of push/pop's when using -Op3 (that code is
  912. also better optimizable)
  913. * fixed and optimized register saving/restoring for new/dispose nodes
  914. * LOC_FPU locations now also require their "register" field to be set to
  915. R_ST, not R_ST0 (the latter is used for LOC_CFPUREGISTER locations only)
  916. - list field removed of the tnode class because it's not used currently
  917. and can cause hard-to-find bugs
  918. }