node.pas 37 KB

1234567891011121314151617181920212223242526272829303132333435363738394041424344454647484950515253545556575859606162636465666768697071727374757677787980818283848586878889909192939495969798991001011021031041051061071081091101111121131141151161171181191201211221231241251261271281291301311321331341351361371381391401411421431441451461471481491501511521531541551561571581591601611621631641651661671681691701711721731741751761771781791801811821831841851861871881891901911921931941951961971981992002012022032042052062072082092102112122132142152162172182192202212222232242252262272282292302312322332342352362372382392402412422432442452462472482492502512522532542552562572582592602612622632642652662672682692702712722732742752762772782792802812822832842852862872882892902912922932942952962972982993003013023033043053063073083093103113123133143153163173183193203213223233243253263273283293303313323333343353363373383393403413423433443453463473483493503513523533543553563573583593603613623633643653663673683693703713723733743753763773783793803813823833843853863873883893903913923933943953963973983994004014024034044054064074084094104114124134144154164174184194204214224234244254264274284294304314324334344354364374384394404414424434444454464474484494504514524534544554564574584594604614624634644654664674684694704714724734744754764774784794804814824834844854864874884894904914924934944954964974984995005015025035045055065075085095105115125135145155165175185195205215225235245255265275285295305315325335345355365375385395405415425435445455465475485495505515525535545555565575585595605615625635645655665675685695705715725735745755765775785795805815825835845855865875885895905915925935945955965975985996006016026036046056066076086096106116126136146156166176186196206216226236246256266276286296306316326336346356366376386396406416426436446456466476486496506516526536546556566576586596606616626636646656666676686696706716726736746756766776786796806816826836846856866876886896906916926936946956966976986997007017027037047057067077087097107117127137147157167177187197207217227237247257267277287297307317327337347357367377387397407417427437447457467477487497507517527537547557567577587597607617627637647657667677687697707717727737747757767777787797807817827837847857867877887897907917927937947957967977987998008018028038048058068078088098108118128138148158168178188198208218228238248258268278288298308318328338348358368378388398408418428438448458468478488498508518528538548558568578588598608618628638648658668678688698708718728738748758768778788798808818828838848858868878888898908918928938948958968978988999009019029039049059069079089099109119129139149159169179189199209219229239249259269279289299309319329339349359369379389399409419429439449459469479489499509519529539549559569579589599609619629639649659669679689699709719729739749759769779789799809819829839849859869879889899909919929939949959969979989991000100110021003100410051006100710081009101010111012101310141015101610171018101910201021102210231024102510261027102810291030103110321033103410351036103710381039104010411042104310441045104610471048104910501051105210531054105510561057105810591060106110621063106410651066106710681069107010711072107310741075107610771078107910801081108210831084108510861087108810891090109110921093109410951096109710981099110011011102110311041105110611071108110911101111111211131114111511161117111811191120112111221123112411251126112711281129113011311132113311341135113611371138113911401141114211431144114511461147114811491150115111521153115411551156115711581159116011611162116311641165116611671168116911701171117211731174117511761177117811791180118111821183118411851186118711881189119011911192119311941195119611971198119912001201120212031204120512061207120812091210121112121213121412151216121712181219122012211222122312241225122612271228
  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 buildderef;virtual;
  272. procedure derefimpl;virtual;
  273. { toggles the flag }
  274. procedure toggleflag(f : tnodeflag);
  275. { the 1.1 code generator may override pass_1 }
  276. { and it need not to implement det_* then }
  277. { 1.1: pass_1 returns a value<>0 if the node has been transformed }
  278. { 2.0: runs det_resulttype and det_temp }
  279. function pass_1 : tnode;virtual;abstract;
  280. { dermines the resulttype of the node }
  281. function det_resulttype : tnode;virtual;abstract;
  282. { dermines the number of necessary temp. locations to evaluate
  283. the node }
  284. {$ifdef state_tracking}
  285. { Does optimizations by keeping track of the variable states
  286. in a procedure }
  287. function track_state_pass(exec_known:boolean):boolean;virtual;
  288. {$endif}
  289. { For a t1:=t2 tree, mark the part of the tree t1 that gets
  290. written to (normally the loadnode) as write access. }
  291. procedure mark_write;virtual;
  292. procedure det_temp;virtual;abstract;
  293. procedure pass_2;virtual;abstract;
  294. { comparing of nodes }
  295. function isequal(p : tnode) : boolean;
  296. { to implement comparisation, override this method }
  297. function docompare(p : tnode) : boolean;virtual;
  298. { gets a copy of the node }
  299. function getcopy : tnode;virtual;
  300. procedure insertintolist(l : tnodelist);virtual;
  301. { writes a node for debugging purpose, shouldn't be called }
  302. { direct, because there is no test for nil, use printnode }
  303. { to write a complete tree }
  304. procedure printnodeinfo(var t:text);
  305. procedure printnodedata(var t:text);virtual;
  306. procedure printnodetree(var t:text);virtual;
  307. procedure concattolist(l : tlinkedlist);virtual;
  308. function ischild(p : tnode) : boolean;virtual;
  309. procedure set_file_line(from : tnode);
  310. procedure set_tree_filepos(const filepos : tfileposinfo);
  311. end;
  312. tnodeclass = class of tnode;
  313. tnodeclassarray = array[tnodetype] of tnodeclass;
  314. { this node is the anchestor for all nodes with at least }
  315. { one child, you have to use it if you want to use }
  316. { true- and falselabel }
  317. punarynode = ^tunarynode;
  318. tunarynode = class(tnode)
  319. left : tnode;
  320. constructor create(t:tnodetype;l : tnode);
  321. constructor ppuload(t:tnodetype;ppufile:tcompilerppufile);override;
  322. destructor destroy;override;
  323. procedure ppuwrite(ppufile:tcompilerppufile);override;
  324. procedure buildderef;override;
  325. procedure derefimpl;override;
  326. procedure concattolist(l : tlinkedlist);override;
  327. function ischild(p : tnode) : boolean;override;
  328. function docompare(p : tnode) : boolean;override;
  329. function getcopy : tnode;override;
  330. procedure insertintolist(l : tnodelist);override;
  331. procedure left_max;
  332. procedure printnodedata(var t:text);override;
  333. end;
  334. pbinarynode = ^tbinarynode;
  335. tbinarynode = class(tunarynode)
  336. right : tnode;
  337. constructor create(t:tnodetype;l,r : tnode);
  338. constructor ppuload(t:tnodetype;ppufile:tcompilerppufile);override;
  339. destructor destroy;override;
  340. procedure ppuwrite(ppufile:tcompilerppufile);override;
  341. procedure buildderef;override;
  342. procedure derefimpl;override;
  343. procedure concattolist(l : tlinkedlist);override;
  344. function ischild(p : tnode) : boolean;override;
  345. function docompare(p : tnode) : boolean;override;
  346. procedure swapleftright;
  347. function getcopy : tnode;override;
  348. procedure insertintolist(l : tnodelist);override;
  349. procedure left_right_max;
  350. procedure printnodedata(var t:text);override;
  351. procedure printnodelist(var t:text);
  352. end;
  353. tbinopnode = class(tbinarynode)
  354. constructor create(t:tnodetype;l,r : tnode);virtual;
  355. function docompare(p : tnode) : boolean;override;
  356. end;
  357. var
  358. { array with all class types for tnodes }
  359. nodeclass : tnodeclassarray;
  360. function ppuloadnode(ppufile:tcompilerppufile):tnode;
  361. procedure ppuwritenode(ppufile:tcompilerppufile;n:tnode);
  362. const
  363. printnodespacing = ' ';
  364. var
  365. { indention used when writing the tree to the screen }
  366. printnodeindention : string;
  367. procedure printnodeindent;
  368. procedure printnodeunindent;
  369. procedure printnode(var t:text;n:tnode);
  370. implementation
  371. uses
  372. cutils,verbose;
  373. const
  374. ppunodemarker = 255;
  375. {****************************************************************************
  376. Helpers
  377. ****************************************************************************}
  378. function ppuloadnode(ppufile:tcompilerppufile):tnode;
  379. var
  380. b : byte;
  381. t : tnodetype;
  382. begin
  383. { marker }
  384. b:=ppufile.getbyte;
  385. if b<>ppunodemarker then
  386. internalerror(200208151);
  387. { load nodetype }
  388. t:=tnodetype(ppufile.getbyte);
  389. if t>high(tnodetype) then
  390. internalerror(200208152);
  391. if t<>emptynode then
  392. begin
  393. if not assigned(nodeclass[t]) then
  394. internalerror(200208153);
  395. //writeln('load: ',nodetype2str[t]);
  396. { generate node of the correct class }
  397. ppuloadnode:=nodeclass[t].ppuload(t,ppufile);
  398. end
  399. else
  400. ppuloadnode:=nil;
  401. end;
  402. procedure ppuwritenode(ppufile:tcompilerppufile;n:tnode);
  403. begin
  404. { marker, read by ppuloadnode }
  405. ppufile.putbyte(ppunodemarker);
  406. { type, read by ppuloadnode }
  407. if assigned(n) then
  408. begin
  409. ppufile.putbyte(byte(n.nodetype));
  410. //writeln('write: ',nodetype2str[n.nodetype]);
  411. n.ppuwrite(ppufile);
  412. end
  413. else
  414. ppufile.putbyte(byte(emptynode));
  415. end;
  416. procedure printnodeindent;
  417. begin
  418. printnodeindention:=printnodeindention+printnodespacing;
  419. end;
  420. procedure printnodeunindent;
  421. begin
  422. delete(printnodeindention,1,length(printnodespacing));
  423. end;
  424. procedure printnode(var t:text;n:tnode);
  425. begin
  426. if assigned(n) then
  427. n.printnodetree(t)
  428. else
  429. writeln(t,printnodeindention,'nil');
  430. end;
  431. {****************************************************************************
  432. TNODE
  433. ****************************************************************************}
  434. constructor tnode.create(t:tnodetype);
  435. begin
  436. inherited create;
  437. nodetype:=t;
  438. blocktype:=block_type;
  439. { updated by firstpass }
  440. expectloc:=LOC_INVALID;
  441. { updated by secondpass }
  442. location.loc:=LOC_INVALID;
  443. { save local info }
  444. fileinfo:=aktfilepos;
  445. localswitches:=aktlocalswitches;
  446. resulttype.reset;
  447. registers32:=0;
  448. registersfpu:=0;
  449. {$ifdef SUPPORT_MMX}
  450. registersmmx:=0;
  451. {$endif SUPPORT_MMX}
  452. {$ifdef EXTDEBUG}
  453. maxfirstpasscount:=0;
  454. firstpasscount:=0;
  455. {$endif EXTDEBUG}
  456. flags:=[];
  457. end;
  458. constructor tnode.createforcopy;
  459. begin
  460. end;
  461. constructor tnode.ppuload(t:tnodetype;ppufile:tcompilerppufile);
  462. begin
  463. nodetype:=t;
  464. { tnode fields }
  465. blocktype:=tblock_type(ppufile.getbyte);
  466. ppufile.getposinfo(fileinfo);
  467. ppufile.getsmallset(localswitches);
  468. ppufile.gettype(resulttype);
  469. ppufile.getsmallset(flags);
  470. { updated by firstpass }
  471. expectloc:=LOC_INVALID;
  472. { updated by secondpass }
  473. location.loc:=LOC_INVALID;
  474. registers32:=0;
  475. registersfpu:=0;
  476. {$ifdef SUPPORT_MMX}
  477. registersmmx:=0;
  478. {$endif SUPPORT_MMX}
  479. {$ifdef EXTDEBUG}
  480. maxfirstpasscount:=0;
  481. firstpasscount:=0;
  482. {$endif EXTDEBUG}
  483. end;
  484. procedure tnode.ppuwrite(ppufile:tcompilerppufile);
  485. begin
  486. ppufile.putbyte(byte(block_type));
  487. ppufile.putposinfo(fileinfo);
  488. ppufile.putsmallset(localswitches);
  489. ppufile.puttype(resulttype);
  490. ppufile.putsmallset(flags);
  491. end;
  492. procedure tnode.buildderef;
  493. begin
  494. resulttype.buildderef;
  495. end;
  496. procedure tnode.derefimpl;
  497. begin
  498. resulttype.resolve;
  499. end;
  500. procedure tnode.toggleflag(f : tnodeflag);
  501. begin
  502. if f in flags then
  503. exclude(flags,f)
  504. else
  505. include(flags,f);
  506. end;
  507. destructor tnode.destroy;
  508. begin
  509. {$ifdef EXTDEBUG}
  510. if firstpasscount>maxfirstpasscount then
  511. maxfirstpasscount:=firstpasscount;
  512. {$endif EXTDEBUG}
  513. end;
  514. procedure tnode.concattolist(l : tlinkedlist);
  515. begin
  516. end;
  517. function tnode.ischild(p : tnode) : boolean;
  518. begin
  519. ischild:=false;
  520. end;
  521. procedure tnode.mark_write;
  522. begin
  523. {$ifdef EXTDEBUG}
  524. Comment(V_Warning,'mark_write not implemented for '+nodetype2str[nodetype]);
  525. {$endif EXTDEBUG}
  526. end;
  527. procedure tnode.printnodeinfo(var t:text);
  528. begin
  529. write(t,nodetype2str[nodetype]);
  530. if assigned(resulttype.def) then
  531. write(t,', resulttype = "',resulttype.def.gettypename,'"')
  532. else
  533. write(t,', resulttype = <nil>');
  534. writeln(t,', pos = (',fileinfo.line,',',fileinfo.column,')',
  535. ', loc = ',tcgloc2str[location.loc],
  536. ', expectloc = ',tcgloc2str[expectloc],
  537. ', intregs = ',registers32,
  538. ', fpuregs = ',registersfpu);
  539. end;
  540. procedure tnode.printnodedata(var t:text);
  541. begin
  542. end;
  543. procedure tnode.printnodetree(var t:text);
  544. begin
  545. write(t,printnodeindention,'(');
  546. printnodeinfo(t);
  547. printnodeindent;
  548. printnodedata(t);
  549. printnodeunindent;
  550. writeln(t,printnodeindention,')');
  551. end;
  552. function tnode.isequal(p : tnode) : boolean;
  553. begin
  554. isequal:=
  555. (not assigned(self) and not assigned(p)) or
  556. (assigned(self) and assigned(p) and
  557. { optimized subclasses have the same nodetype as their }
  558. { superclass (for compatibility), so also check the classtype (JM) }
  559. (p.classtype=classtype) and
  560. (p.nodetype=nodetype) and
  561. (flags*flagsequal=p.flags*flagsequal) and
  562. docompare(p));
  563. end;
  564. {$ifdef state_tracking}
  565. function Tnode.track_state_pass(exec_known:boolean):boolean;
  566. begin
  567. track_state_pass:=false;
  568. end;
  569. {$endif state_tracking}
  570. function tnode.docompare(p : tnode) : boolean;
  571. begin
  572. docompare:=true;
  573. end;
  574. function tnode.getcopy : tnode;
  575. var
  576. p : tnode;
  577. begin
  578. { this is quite tricky because we need a node of the current }
  579. { node type and not one of tnode! }
  580. p:=tnodeclass(classtype).createforcopy;
  581. p.nodetype:=nodetype;
  582. p.location:=location;
  583. p.parent:=parent;
  584. p.flags:=flags;
  585. p.registers32:=registers32;
  586. p.registersfpu:=registersfpu;
  587. {$ifdef SUPPORT_MMX}
  588. p.registersmmx:=registersmmx;
  589. p.registerskni:=registerskni;
  590. {$endif SUPPORT_MMX}
  591. p.resulttype:=resulttype;
  592. p.fileinfo:=fileinfo;
  593. p.localswitches:=localswitches;
  594. {$ifdef extdebug}
  595. p.firstpasscount:=firstpasscount;
  596. {$endif extdebug}
  597. { p.list:=list; }
  598. getcopy:=p;
  599. end;
  600. procedure tnode.insertintolist(l : tnodelist);
  601. begin
  602. end;
  603. procedure tnode.set_file_line(from : tnode);
  604. begin
  605. if assigned(from) then
  606. fileinfo:=from.fileinfo;
  607. end;
  608. procedure tnode.set_tree_filepos(const filepos : tfileposinfo);
  609. begin
  610. fileinfo:=filepos;
  611. end;
  612. {****************************************************************************
  613. TUNARYNODE
  614. ****************************************************************************}
  615. constructor tunarynode.create(t:tnodetype;l : tnode);
  616. begin
  617. inherited create(t);
  618. left:=l;
  619. end;
  620. constructor tunarynode.ppuload(t:tnodetype;ppufile:tcompilerppufile);
  621. begin
  622. inherited ppuload(t,ppufile);
  623. left:=ppuloadnode(ppufile);
  624. end;
  625. destructor tunarynode.destroy;
  626. begin
  627. left.free;
  628. inherited destroy;
  629. end;
  630. procedure tunarynode.ppuwrite(ppufile:tcompilerppufile);
  631. begin
  632. inherited ppuwrite(ppufile);
  633. ppuwritenode(ppufile,left);
  634. end;
  635. procedure tunarynode.buildderef;
  636. begin
  637. inherited buildderef;
  638. if assigned(left) then
  639. left.buildderef;
  640. end;
  641. procedure tunarynode.derefimpl;
  642. begin
  643. inherited derefimpl;
  644. if assigned(left) then
  645. left.derefimpl;
  646. end;
  647. function tunarynode.docompare(p : tnode) : boolean;
  648. begin
  649. docompare:=(inherited docompare(p) and
  650. ((left=nil) or left.isequal(tunarynode(p).left))
  651. );
  652. end;
  653. function tunarynode.getcopy : tnode;
  654. var
  655. p : tunarynode;
  656. begin
  657. p:=tunarynode(inherited getcopy);
  658. if assigned(left) then
  659. p.left:=left.getcopy
  660. else
  661. p.left:=nil;
  662. getcopy:=p;
  663. end;
  664. procedure tunarynode.insertintolist(l : tnodelist);
  665. begin
  666. end;
  667. procedure tunarynode.printnodedata(var t:text);
  668. begin
  669. inherited printnodedata(t);
  670. printnode(t,left);
  671. end;
  672. procedure tunarynode.left_max;
  673. begin
  674. registers32:=left.registers32;
  675. registersfpu:=left.registersfpu;
  676. {$ifdef SUPPORT_MMX}
  677. registersmmx:=left.registersmmx;
  678. {$endif SUPPORT_MMX}
  679. end;
  680. procedure tunarynode.concattolist(l : tlinkedlist);
  681. begin
  682. left.parent:=self;
  683. left.concattolist(l);
  684. inherited concattolist(l);
  685. end;
  686. function tunarynode.ischild(p : tnode) : boolean;
  687. begin
  688. ischild:=p=left;
  689. end;
  690. {****************************************************************************
  691. TBINARYNODE
  692. ****************************************************************************}
  693. constructor tbinarynode.create(t:tnodetype;l,r : tnode);
  694. begin
  695. inherited create(t,l);
  696. right:=r
  697. end;
  698. constructor tbinarynode.ppuload(t:tnodetype;ppufile:tcompilerppufile);
  699. begin
  700. inherited ppuload(t,ppufile);
  701. right:=ppuloadnode(ppufile);
  702. end;
  703. destructor tbinarynode.destroy;
  704. begin
  705. right.free;
  706. inherited destroy;
  707. end;
  708. procedure tbinarynode.ppuwrite(ppufile:tcompilerppufile);
  709. begin
  710. inherited ppuwrite(ppufile);
  711. ppuwritenode(ppufile,right);
  712. end;
  713. procedure tbinarynode.buildderef;
  714. begin
  715. inherited buildderef;
  716. if assigned(right) then
  717. right.buildderef;
  718. end;
  719. procedure tbinarynode.derefimpl;
  720. begin
  721. inherited derefimpl;
  722. if assigned(right) then
  723. right.derefimpl;
  724. end;
  725. procedure tbinarynode.concattolist(l : tlinkedlist);
  726. begin
  727. { we could change that depending on the number of }
  728. { required registers }
  729. left.parent:=self;
  730. left.concattolist(l);
  731. left.parent:=self;
  732. left.concattolist(l);
  733. inherited concattolist(l);
  734. end;
  735. function tbinarynode.ischild(p : tnode) : boolean;
  736. begin
  737. ischild:=(p=right);
  738. end;
  739. function tbinarynode.docompare(p : tnode) : boolean;
  740. begin
  741. docompare:=(inherited docompare(p) and
  742. ((right=nil) or right.isequal(tbinarynode(p).right))
  743. );
  744. end;
  745. function tbinarynode.getcopy : tnode;
  746. var
  747. p : tbinarynode;
  748. begin
  749. p:=tbinarynode(inherited getcopy);
  750. if assigned(right) then
  751. p.right:=right.getcopy
  752. else
  753. p.right:=nil;
  754. getcopy:=p;
  755. end;
  756. procedure tbinarynode.insertintolist(l : tnodelist);
  757. begin
  758. end;
  759. procedure tbinarynode.swapleftright;
  760. var
  761. swapp : tnode;
  762. begin
  763. swapp:=right;
  764. right:=left;
  765. left:=swapp;
  766. if nf_swaped in flags then
  767. exclude(flags,nf_swaped)
  768. else
  769. include(flags,nf_swaped);
  770. end;
  771. procedure tbinarynode.left_right_max;
  772. begin
  773. if assigned(left) then
  774. begin
  775. if assigned(right) then
  776. begin
  777. registers32:=max(left.registers32,right.registers32);
  778. registersfpu:=max(left.registersfpu,right.registersfpu);
  779. {$ifdef SUPPORT_MMX}
  780. registersmmx:=max(left.registersmmx,right.registersmmx);
  781. {$endif SUPPORT_MMX}
  782. end
  783. else
  784. begin
  785. registers32:=left.registers32;
  786. registersfpu:=left.registersfpu;
  787. {$ifdef SUPPORT_MMX}
  788. registersmmx:=left.registersmmx;
  789. {$endif SUPPORT_MMX}
  790. end;
  791. end;
  792. end;
  793. procedure tbinarynode.printnodedata(var t:text);
  794. begin
  795. inherited printnodedata(t);
  796. printnode(t,right);
  797. end;
  798. procedure tbinarynode.printnodelist(var t:text);
  799. var
  800. hp : tbinarynode;
  801. begin
  802. hp:=self;
  803. while assigned(hp) do
  804. begin
  805. write(t,printnodeindention,'(');
  806. printnodeindent;
  807. hp.printnodeinfo(t);
  808. printnode(t,hp.left);
  809. printnodeunindent;
  810. writeln(t,printnodeindention,')');
  811. hp:=tbinarynode(hp.right);
  812. end;
  813. end;
  814. {****************************************************************************
  815. TBINOPYNODE
  816. ****************************************************************************}
  817. constructor tbinopnode.create(t:tnodetype;l,r : tnode);
  818. begin
  819. inherited create(t,l,r);
  820. end;
  821. function tbinopnode.docompare(p : tnode) : boolean;
  822. begin
  823. docompare:=(inherited docompare(p)) or
  824. { if that's in the flags, is p then always a tbinopnode (?) (JM) }
  825. ((nf_swapable in flags) and
  826. left.isequal(tbinopnode(p).right) and
  827. right.isequal(tbinopnode(p).left));
  828. end;
  829. end.
  830. {
  831. $Log$
  832. Revision 1.72 2003-10-22 20:40:00 peter
  833. * write derefdata in a separate ppu entry
  834. Revision 1.71 2003/10/18 15:41:26 peter
  835. * made worklists dynamic in size
  836. Revision 1.70 2003/10/17 01:22:08 florian
  837. * compilation of the powerpc compiler fixed
  838. Revision 1.69 2003/10/08 19:19:45 peter
  839. * set_varstate cleanup
  840. Revision 1.68 2003/10/01 20:34:49 peter
  841. * procinfo unit contains tprocinfo
  842. * cginfo renamed to cgbase
  843. * moved cgmessage to verbose
  844. * fixed ppc and sparc compiles
  845. Revision 1.67 2003/09/28 17:55:04 peter
  846. * parent framepointer changed to hidden parameter
  847. * tloadparentfpnode added
  848. Revision 1.66 2003/09/06 22:27:08 florian
  849. * fixed web bug 2669
  850. * cosmetic fix in printnode
  851. * tobjectdef.gettypename implemented
  852. Revision 1.65 2003/09/03 15:55:01 peter
  853. * NEWRA branch merged
  854. Revision 1.64 2003/09/03 11:18:37 florian
  855. * fixed arm concatcopy
  856. + arm support in the common compiler sources added
  857. * moved some generic cg code around
  858. + tfputype added
  859. * ...
  860. Revision 1.63 2003/08/10 17:25:23 peter
  861. * fixed some reported bugs
  862. Revision 1.62 2003/05/26 21:17:17 peter
  863. * procinlinenode removed
  864. * aktexit2label removed, fast exit removed
  865. + tcallnode.inlined_pass_2 added
  866. Revision 1.61 2003/05/13 19:14:41 peter
  867. * failn removed
  868. * inherited result code check moven to pexpr
  869. Revision 1.60 2003/05/11 21:37:03 peter
  870. * moved implicit exception frame from ncgutil to psub
  871. * constructor/destructor helpers moved from cobj/ncgutil to psub
  872. Revision 1.59 2003/05/09 17:47:02 peter
  873. * self moved to hidden parameter
  874. * removed hdisposen,hnewn,selfn
  875. Revision 1.58 2003/04/25 20:59:33 peter
  876. * removed funcretn,funcretsym, function result is now in varsym
  877. and aliases for result and function name are added using absolutesym
  878. * vs_hidden parameter for funcret passed in parameter
  879. * vs_hidden fixes
  880. * writenode changed to printnode and released from extdebug
  881. * -vp option added to generate a tree.log with the nodetree
  882. * nicer printnode for statements, callnode
  883. Revision 1.57 2002/04/25 20:15:39 florian
  884. * block nodes within expressions shouldn't release the used registers,
  885. fixed using a flag till the new rg is ready
  886. Revision 1.56 2003/04/24 22:29:58 florian
  887. * fixed a lot of PowerPC related stuff
  888. Revision 1.55 2003/04/23 10:12:14 peter
  889. * allow multi pass2 changed to global boolean instead of node flag
  890. Revision 1.54 2003/04/22 23:50:23 peter
  891. * firstpass uses expectloc
  892. * checks if there are differences between the expectloc and
  893. location.loc from secondpass in EXTDEBUG
  894. Revision 1.53 2003/04/22 09:52:00 peter
  895. * mark_write implemented for default with a warning in EXTDEBUG, this
  896. is required for error recovery where the left node can be also a non
  897. writable node
  898. Revision 1.52 2003/04/10 17:57:52 peter
  899. * vs_hidden released
  900. Revision 1.51 2003/03/28 19:16:56 peter
  901. * generic constructor working for i386
  902. * remove fixed self register
  903. * esi added as address register for i386
  904. Revision 1.50 2003/03/17 16:54:41 peter
  905. * support DefaultHandler and anonymous inheritance fixed
  906. for message methods
  907. Revision 1.49 2003/01/04 15:54:03 daniel
  908. * Fixed mark_write for @ operator
  909. (can happen when compiling @procvar:=nil (Delphi mode construction))
  910. Revision 1.48 2003/01/03 21:03:02 peter
  911. * made mark_write dummy instead of abstract
  912. Revision 1.47 2003/01/03 12:15:56 daniel
  913. * Removed ifdefs around notifications
  914. ifdefs around for loop optimizations remain
  915. Revision 1.46 2002/12/26 18:24:33 jonas
  916. * fixed check for whether or not a high parameter was already generated
  917. * no type checking/conversions for invisible parameters
  918. Revision 1.45 2002/11/28 11:17:04 florian
  919. * loop node flags from node flags splitted
  920. Revision 1.44 2002/10/05 00:48:57 peter
  921. * support inherited; support for overload as it is handled by
  922. delphi. This is only for delphi mode as it is working is
  923. undocumented and hard to predict what is done
  924. Revision 1.43 2002/09/07 15:25:03 peter
  925. * old logs removed and tabs fixed
  926. Revision 1.42 2002/09/03 16:26:26 daniel
  927. * Make Tprocdef.defs protected
  928. Revision 1.41 2002/09/01 13:28:38 daniel
  929. - write_access fields removed in favor of a flag
  930. Revision 1.40 2002/09/01 08:01:16 daniel
  931. * Removed sets from Tcallnode.det_resulttype
  932. + Added read/write notifications of variables. These will be usefull
  933. for providing information for several optimizations. For example
  934. the value of the loop variable of a for loop does matter is the
  935. variable is read after the for loop, but if it's no longer used
  936. or written, it doesn't matter and this can be used to optimize
  937. the loop code generation.
  938. Revision 1.39 2002/08/22 11:21:45 florian
  939. + register32 is now written by tnode.dowrite
  940. * fixed write of value of tconstnode
  941. Revision 1.38 2002/08/19 19:36:44 peter
  942. * More fixes for cross unit inlining, all tnodes are now implemented
  943. * Moved pocall_internconst to po_internconst because it is not a
  944. calling type at all and it conflicted when inlining of these small
  945. functions was requested
  946. Revision 1.37 2002/08/18 20:06:24 peter
  947. * inlining is now also allowed in interface
  948. * renamed write/load to ppuwrite/ppuload
  949. * tnode storing in ppu
  950. * nld,ncon,nbas are already updated for storing in ppu
  951. Revision 1.36 2002/08/17 22:09:46 florian
  952. * result type handling in tcgcal.pass_2 overhauled
  953. * better tnode.dowrite
  954. * some ppc stuff fixed
  955. Revision 1.35 2002/08/15 19:10:35 peter
  956. * first things tai,tnode storing in ppu
  957. Revision 1.34 2002/08/09 19:15:41 carl
  958. - removed newcg define
  959. Revision 1.33 2002/07/23 12:34:30 daniel
  960. * Readded old set code. To use it define 'oldset'. Activated by default
  961. for ppc.
  962. Revision 1.32 2002/07/22 11:48:04 daniel
  963. * Sets are now internally sets.
  964. Revision 1.31 2002/07/21 06:58:49 daniel
  965. * Changed booleans into flags
  966. Revision 1.30 2002/07/19 11:41:36 daniel
  967. * State tracker work
  968. * The whilen and repeatn are now completely unified into whilerepeatn. This
  969. allows the state tracker to change while nodes automatically into
  970. repeat nodes.
  971. * Resulttypepass improvements to the notn. 'not not a' is optimized away and
  972. 'not(a>b)' is optimized into 'a<=b'.
  973. * Resulttypepass improvements to the whilerepeatn. 'while not a' is optimized
  974. by removing the notn and later switchting the true and falselabels. The
  975. same is done with 'repeat until not a'.
  976. Revision 1.29 2002/07/14 18:00:44 daniel
  977. + Added the beginning of a state tracker. This will track the values of
  978. variables through procedures and optimize things away.
  979. Revision 1.28 2002/07/01 18:46:24 peter
  980. * internal linker
  981. * reorganized aasm layer
  982. Revision 1.27 2002/05/18 13:34:10 peter
  983. * readded missing revisions
  984. Revision 1.26 2002/05/16 19:46:39 carl
  985. + defines.inc -> fpcdefs.inc to avoid conflicts if compiling by hand
  986. + try to fix temp allocation (still in ifdef)
  987. + generic constructor calls
  988. + start of tassembler / tmodulebase class cleanup
  989. Revision 1.24 2002/04/21 19:02:04 peter
  990. * removed newn and disposen nodes, the code is now directly
  991. inlined from pexpr
  992. * -an option that will write the secondpass nodes to the .s file, this
  993. requires EXTDEBUG define to actually write the info
  994. * fixed various internal errors and crashes due recent code changes
  995. Revision 1.23 2002/04/06 18:13:01 jonas
  996. * several powerpc-related additions and fixes
  997. Revision 1.22 2002/03/31 20:26:35 jonas
  998. + a_loadfpu_* and a_loadmm_* methods in tcg
  999. * register allocation is now handled by a class and is mostly processor
  1000. independent (+rgobj.pas and i386/rgcpu.pas)
  1001. * temp allocation is now handled by a class (+tgobj.pas, -i386\tgcpu.pas)
  1002. * some small improvements and fixes to the optimizer
  1003. * some register allocation fixes
  1004. * some fpuvaroffset fixes in the unary minus node
  1005. * push/popusedregisters is now called rg.save/restoreusedregisters and
  1006. (for i386) uses temps instead of push/pop's when using -Op3 (that code is
  1007. also better optimizable)
  1008. * fixed and optimized register saving/restoring for new/dispose nodes
  1009. * LOC_FPU locations now also require their "register" field to be set to
  1010. R_ST, not R_ST0 (the latter is used for LOC_CFPUREGISTER locations only)
  1011. - list field removed of the tnode class because it's not used currently
  1012. and can cause hard-to-find bugs
  1013. }