2
0

node.pas 36 KB

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