node.pas 37 KB

1234567891011121314151617181920212223242526272829303132333435363738394041424344454647484950515253545556575859606162636465666768697071727374757677787980818283848586878889909192939495969798991001011021031041051061071081091101111121131141151161171181191201211221231241251261271281291301311321331341351361371381391401411421431441451461471481491501511521531541551561571581591601611621631641651661671681691701711721731741751761771781791801811821831841851861871881891901911921931941951961971981992002012022032042052062072082092102112122132142152162172182192202212222232242252262272282292302312322332342352362372382392402412422432442452462472482492502512522532542552562572582592602612622632642652662672682692702712722732742752762772782792802812822832842852862872882892902912922932942952962972982993003013023033043053063073083093103113123133143153163173183193203213223233243253263273283293303313323333343353363373383393403413423433443453463473483493503513523533543553563573583593603613623633643653663673683693703713723733743753763773783793803813823833843853863873883893903913923933943953963973983994004014024034044054064074084094104114124134144154164174184194204214224234244254264274284294304314324334344354364374384394404414424434444454464474484494504514524534544554564574584594604614624634644654664674684694704714724734744754764774784794804814824834844854864874884894904914924934944954964974984995005015025035045055065075085095105115125135145155165175185195205215225235245255265275285295305315325335345355365375385395405415425435445455465475485495505515525535545555565575585595605615625635645655665675685695705715725735745755765775785795805815825835845855865875885895905915925935945955965975985996006016026036046056066076086096106116126136146156166176186196206216226236246256266276286296306316326336346356366376386396406416426436446456466476486496506516526536546556566576586596606616626636646656666676686696706716726736746756766776786796806816826836846856866876886896906916926936946956966976986997007017027037047057067077087097107117127137147157167177187197207217227237247257267277287297307317327337347357367377387397407417427437447457467477487497507517527537547557567577587597607617627637647657667677687697707717727737747757767777787797807817827837847857867877887897907917927937947957967977987998008018028038048058068078088098108118128138148158168178188198208218228238248258268278288298308318328338348358368378388398408418428438448458468478488498508518528538548558568578588598608618628638648658668678688698708718728738748758768778788798808818828838848858868878888898908918928938948958968978988999009019029039049059069079089099109119129139149159169179189199209219229239249259269279289299309319329339349359369379389399409419429439449459469479489499509519529539549559569579589599609619629639649659669679689699709719729739749759769779789799809819829839849859869879889899909919929939949959969979989991000100110021003100410051006100710081009101010111012101310141015101610171018101910201021102210231024102510261027102810291030103110321033103410351036103710381039104010411042104310441045104610471048104910501051105210531054105510561057105810591060106110621063106410651066106710681069107010711072107310741075107610771078107910801081108210831084108510861087108810891090109110921093109410951096109710981099110011011102110311041105110611071108110911101111111211131114111511161117111811191120112111221123112411251126112711281129113011311132113311341135113611371138113911401141114211431144114511461147114811491150115111521153115411551156115711581159116011611162116311641165116611671168116911701171117211731174117511761177117811791180118111821183118411851186118711881189119011911192119311941195119611971198119912001201120212031204120512061207120812091210121112121213121412151216121712181219122012211222122312241225122612271228122912301231123212331234123512361237123812391240124112421243124412451246124712481249125012511252125312541255125612571258125912601261126212631264126512661267126812691270127112721273127412751276127712781279128012811282128312841285128612871288128912901291129212931294129512961297129812991300130113021303130413051306130713081309
  1. {
  2. Copyright (c) 2000-2002 by Florian Klaempfl
  3. Basic node handling
  4. This program is free software; you can redistribute it and/or modify
  5. it under the terms of the GNU General Public License as published by
  6. the Free Software Foundation; either version 2 of the License, or
  7. (at your option) any later version.
  8. This program is distributed in the hope that it will be useful,
  9. but WITHOUT ANY WARRANTY; without even the implied warranty of
  10. MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
  11. GNU General Public License for more details.
  12. You should have received a copy of the GNU General Public License
  13. along with this program; if not, write to the Free Software
  14. Foundation, Inc., 675 Mass Ave, Cambridge, MA 02139, USA.
  15. ****************************************************************************
  16. }
  17. unit node;
  18. {$i fpcdefs.inc}
  19. interface
  20. uses
  21. cclasses,
  22. globtype,globals,
  23. cpubase,cgbase,cgutils,
  24. aasmbase,
  25. symtype,
  26. optbase;
  27. type
  28. tnodetype = (
  29. emptynode, {No node (returns nil when loading from ppu)}
  30. addn, {Represents the + operator}
  31. muln, {Represents the * operator}
  32. subn, {Represents the - operator}
  33. divn, {Represents the div operator}
  34. symdifn, {Represents the >< operator}
  35. modn, {Represents the mod operator}
  36. assignn, {Represents an assignment}
  37. loadn, {Represents the use of a variabele}
  38. rangen, {Represents a range (i.e. 0..9)}
  39. ltn, {Represents the < operator}
  40. lten, {Represents the <= operator}
  41. gtn, {Represents the > operator}
  42. gten, {Represents the >= operator}
  43. equaln, {Represents the = operator}
  44. unequaln, {Represents the <> operator}
  45. inn, {Represents the in operator}
  46. orn, {Represents the or operator}
  47. xorn, {Represents the xor operator}
  48. shrn, {Represents the shr operator}
  49. shln, {Represents the shl operator}
  50. slashn, {Represents the / operator}
  51. andn, {Represents the and operator}
  52. subscriptn, {Field in a record/object}
  53. derefn, {Dereferences a pointer}
  54. addrn, {Represents the @ operator}
  55. ordconstn, {Represents an ordinal value}
  56. typeconvn, {Represents type-conversion/typecast}
  57. calln, {Represents a call node}
  58. callparan, {Represents a parameter}
  59. realconstn, {Represents a real value}
  60. unaryminusn, {Represents a sign change (i.e. -2)}
  61. asmn, {Represents an assembler node }
  62. vecn, {Represents array indexing}
  63. pointerconstn, {Represents a pointer constant}
  64. stringconstn, {Represents a string constant}
  65. notn, {Represents the not operator}
  66. inlinen, {Internal procedures (i.e. writeln)}
  67. niln, {Represents the nil pointer}
  68. errorn, {This part of the tree could not be
  69. parsed because of a compiler error}
  70. typen, {A type name. Used for i.e. typeof(obj)}
  71. setelementn, {A set element(s) (i.e. [a,b] and also [a..b])}
  72. setconstn, {A set constant (i.e. [1,2])}
  73. blockn, {A block of statements}
  74. statementn, {One statement in a block of nodes}
  75. ifn, {An if statement}
  76. breakn, {A break statement}
  77. continuen, {A continue statement}
  78. whilerepeatn, {A while or repeat statement}
  79. forn, {A for loop}
  80. exitn, {An exit statement}
  81. withn, {A with statement}
  82. casen, {A case statement}
  83. labeln, {A label}
  84. goton, {A goto statement}
  85. tryexceptn, {A try except block}
  86. raisen, {A raise statement}
  87. tryfinallyn, {A try finally statement}
  88. onn, {For an on statement in exception code}
  89. isn, {Represents the is operator}
  90. asn, {Represents the as typecast}
  91. starstarn, {Represents the ** operator exponentiation }
  92. arrayconstructorn, {Construction node for [...] parsing}
  93. arrayconstructorrangen, {Range element to allow sets in array construction tree}
  94. tempcreaten, { for temps in the result/firstpass }
  95. temprefn, { references to temps }
  96. tempdeleten, { for temps in the result/firstpass }
  97. addoptn, { added for optimizations where we cannot suppress }
  98. nothingn, { NOP, Do nothing}
  99. loadvmtaddrn, { Load the address of the VMT of a class/object}
  100. guidconstn, { A GUID COM Interface constant }
  101. rttin, { Rtti information so they can be accessed in result/firstpass}
  102. loadparentfpn, { Load the framepointer of the parent for nested procedures }
  103. dataconstn { node storing some binary data }
  104. );
  105. tnodetypeset = set of tnodetype;
  106. pnodetypeset = ^tnodetypeset;
  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. 'starstarn',
  171. 'arrayconstructn',
  172. 'arrayconstructrangen',
  173. 'tempcreaten',
  174. 'temprefn',
  175. 'tempdeleten',
  176. 'addoptn',
  177. 'nothingn',
  178. 'loadvmtaddrn',
  179. 'guidconstn',
  180. 'rttin',
  181. 'loadparentfpn',
  182. 'dataconstn');
  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_swapped, { tbinop operands are swaped }
  188. nf_error,
  189. { general }
  190. nf_pass1_done,
  191. nf_write, { Node is written to }
  192. nf_isproperty,
  193. { taddrnode }
  194. nf_typedaddr,
  195. { tderefnode }
  196. nf_no_checkpointer,
  197. { tvecnode }
  198. nf_memindex,
  199. nf_memseg,
  200. nf_callunique,
  201. { tloadnode }
  202. nf_absolute,
  203. nf_is_self,
  204. nf_load_self_pointer,
  205. nf_inherited,
  206. { the loadnode is generated internally and a varspez=vs_const should be ignore,
  207. this requires that the parameter is actually passed by value
  208. Be really carefull when using this flag! }
  209. nf_isinternal_ignoreconst,
  210. { taddnode }
  211. nf_is_currency,
  212. nf_has_pointerdiv,
  213. nf_short_bool,
  214. { tassignmentnode }
  215. nf_assign_done_in_right,
  216. { tarrayconstructnode }
  217. nf_forcevaria,
  218. nf_novariaallowed,
  219. { ttypeconvnode, and the first one also treal/ord/pointerconstn }
  220. nf_explicit,
  221. nf_internal, { no warnings/hints generated }
  222. nf_load_procvar,
  223. { tinlinenode }
  224. nf_inlineconst,
  225. { tasmnode }
  226. nf_get_asm_position,
  227. { tblocknode }
  228. nf_block_with_exit
  229. );
  230. tnodeflags = set of tnodeflag;
  231. const
  232. { contains the flags which must be equal for the equality }
  233. { of nodes }
  234. flagsequal : tnodeflags = [nf_error];
  235. type
  236. tnodelist = class
  237. end;
  238. pnode = ^tnode;
  239. { basic class for the intermediated representation fpc uses }
  240. tnode = class
  241. public
  242. { type of this node }
  243. nodetype : tnodetype;
  244. { type of the current code block, general/const/type }
  245. blocktype : tblock_type;
  246. { expected location of the result of this node (pass1) }
  247. expectloc : tcgloc;
  248. { the location of the result of this node (pass2) }
  249. location : tlocation;
  250. { the parent node of this is node }
  251. { this field is set by concattolist }
  252. parent : tnode;
  253. { there are some properties about the node stored }
  254. flags : tnodeflags;
  255. ppuidx : longint;
  256. { the number of registers needed to evalute the node }
  257. registersint,registersfpu,registersmm : longint; { must be longint !!!! }
  258. {$ifdef SUPPORT_MMX}
  259. registersmmx : longint;
  260. {$endif SUPPORT_MMX}
  261. resultdef : tdef;
  262. resultdefderef : tderef;
  263. fileinfo : tfileposinfo;
  264. localswitches : tlocalswitches;
  265. optinfo : poptinfo;
  266. {$ifdef extdebug}
  267. maxfirstpasscount,
  268. firstpasscount : longint;
  269. {$endif extdebug}
  270. constructor create(t:tnodetype);
  271. { this constructor is only for creating copies of class }
  272. { the fields are copied by getcopy }
  273. constructor createforcopy;
  274. constructor ppuload(t:tnodetype;ppufile:tcompilerppufile);virtual;
  275. destructor destroy;override;
  276. procedure ppuwrite(ppufile:tcompilerppufile);virtual;
  277. procedure buildderefimpl;virtual;
  278. procedure derefimpl;virtual;
  279. procedure derefnode;virtual;
  280. { toggles the flag }
  281. procedure toggleflag(f : tnodeflag);
  282. { the 1.1 code generator may override pass_1 }
  283. { and it need not to implement det_* then }
  284. { 1.1: pass_1 returns a value<>0 if the node has been transformed }
  285. { 2.0: runs pass_typecheck and det_temp }
  286. function pass_1 : tnode;virtual;abstract;
  287. { dermines the resultdef of the node }
  288. function pass_typecheck : tnode;virtual;abstract;
  289. { tries to simplify the node, returns a value <>nil if a simplified
  290. node has been created }
  291. function simplify : tnode;virtual;
  292. {$ifdef state_tracking}
  293. { Does optimizations by keeping track of the variable states
  294. in a procedure }
  295. function track_state_pass(exec_known:boolean):boolean;virtual;
  296. {$endif}
  297. { For a t1:=t2 tree, mark the part of the tree t1 that gets
  298. written to (normally the loadnode) as write access. }
  299. procedure mark_write;virtual;
  300. { dermines the number of necessary temp. locations to evaluate
  301. the node }
  302. procedure det_temp;virtual;abstract;
  303. procedure pass_generate_code;virtual;abstract;
  304. { comparing of nodes }
  305. function isequal(p : tnode) : boolean;
  306. { to implement comparisation, override this method }
  307. function docompare(p : tnode) : boolean;virtual;
  308. { wrapper for getcopy }
  309. function getcopy : tnode;
  310. { does the real copying of a node }
  311. function dogetcopy : tnode;virtual;
  312. procedure insertintolist(l : tnodelist);virtual;
  313. { writes a node for debugging purpose, shouldn't be called }
  314. { direct, because there is no test for nil, use printnode }
  315. { to write a complete tree }
  316. procedure printnodeinfo(var t:text);virtual;
  317. procedure printnodedata(var t:text);virtual;
  318. procedure printnodetree(var t:text);virtual;
  319. procedure concattolist(l : tlinkedlist);virtual;
  320. function ischild(p : tnode) : boolean;virtual;
  321. end;
  322. tnodeclass = class of tnode;
  323. tnodeclassarray = array[tnodetype] of tnodeclass;
  324. { this node is the anchestor for all nodes with at least }
  325. { one child, you have to use it if you want to use }
  326. { true- and current_procinfo.CurrFalseLabel }
  327. punarynode = ^tunarynode;
  328. tunarynode = class(tnode)
  329. left : tnode;
  330. constructor create(t:tnodetype;l : tnode);
  331. constructor ppuload(t:tnodetype;ppufile:tcompilerppufile);override;
  332. destructor destroy;override;
  333. procedure ppuwrite(ppufile:tcompilerppufile);override;
  334. procedure buildderefimpl;override;
  335. procedure derefimpl;override;
  336. procedure derefnode;override;
  337. procedure concattolist(l : tlinkedlist);override;
  338. function ischild(p : tnode) : boolean;override;
  339. function docompare(p : tnode) : boolean;override;
  340. function dogetcopy : tnode;override;
  341. procedure insertintolist(l : tnodelist);override;
  342. procedure left_max;
  343. procedure printnodedata(var t:text);override;
  344. end;
  345. pbinarynode = ^tbinarynode;
  346. tbinarynode = class(tunarynode)
  347. right : tnode;
  348. constructor create(t:tnodetype;l,r : tnode);
  349. constructor ppuload(t:tnodetype;ppufile:tcompilerppufile);override;
  350. destructor destroy;override;
  351. procedure ppuwrite(ppufile:tcompilerppufile);override;
  352. procedure buildderefimpl;override;
  353. procedure derefimpl;override;
  354. procedure derefnode;override;
  355. procedure concattolist(l : tlinkedlist);override;
  356. function ischild(p : tnode) : boolean;override;
  357. function docompare(p : tnode) : boolean;override;
  358. procedure swapleftright;
  359. function dogetcopy : tnode;override;
  360. procedure insertintolist(l : tnodelist);override;
  361. procedure left_right_max;
  362. procedure printnodedata(var t:text);override;
  363. procedure printnodelist(var t:text);
  364. end;
  365. ptertiarynode = ^ttertiarynode;
  366. ttertiarynode = class(tbinarynode)
  367. third : tnode;
  368. constructor create(_t:tnodetype;l,r,t : tnode);
  369. constructor ppuload(t:tnodetype;ppufile:tcompilerppufile);override;
  370. destructor destroy;override;
  371. procedure ppuwrite(ppufile:tcompilerppufile);override;
  372. procedure buildderefimpl;override;
  373. procedure derefimpl;override;
  374. procedure derefnode;override;
  375. procedure concattolist(l : tlinkedlist);override;
  376. function ischild(p : tnode) : boolean;override;
  377. function docompare(p : tnode) : boolean;override;
  378. function dogetcopy : tnode;override;
  379. procedure insertintolist(l : tnodelist);override;
  380. procedure printnodedata(var t:text);override;
  381. end;
  382. tbinopnode = class(tbinarynode)
  383. constructor create(t:tnodetype;l,r : tnode);virtual;
  384. function docompare(p : tnode) : boolean;override;
  385. end;
  386. var
  387. { array with all class types for tnodes }
  388. nodeclass : tnodeclassarray;
  389. function nodeppuidxget(i:longint):tnode;
  390. function ppuloadnode(ppufile:tcompilerppufile):tnode;
  391. procedure ppuwritenode(ppufile:tcompilerppufile;n:tnode);
  392. function ppuloadnodetree(ppufile:tcompilerppufile):tnode;
  393. procedure ppuwritenodetree(ppufile:tcompilerppufile;n:tnode);
  394. procedure ppuwritenoderef(ppufile:tcompilerppufile;n:tnode);
  395. function ppuloadnoderef(ppufile:tcompilerppufile) : tnode;
  396. const
  397. printnodespacing = ' ';
  398. var
  399. { indention used when writing the tree to the screen }
  400. printnodeindention : string;
  401. procedure printnodeindent;
  402. procedure printnodeunindent;
  403. procedure printnode(var t:text;n:tnode);
  404. procedure printnode(n:tnode);
  405. function is_constnode(p : tnode) : boolean;
  406. function is_constintnode(p : tnode) : boolean;
  407. function is_constcharnode(p : tnode) : boolean;
  408. function is_constrealnode(p : tnode) : boolean;
  409. function is_constboolnode(p : tnode) : boolean;
  410. function is_constenumnode(p : tnode) : boolean;
  411. function is_constwidecharnode(p : tnode) : boolean;
  412. implementation
  413. uses
  414. cutils,verbose,ppu,
  415. symconst,
  416. nutils,nflw,
  417. defutil;
  418. const
  419. ppunodemarker = 255;
  420. {****************************************************************************
  421. Helpers
  422. ****************************************************************************}
  423. var
  424. nodeppudata : tdynamicarray;
  425. nodeppuidx : longint;
  426. procedure nodeppuidxcreate;
  427. begin
  428. nodeppudata:=tdynamicarray.create(1024);
  429. nodeppuidx:=0;
  430. end;
  431. procedure nodeppuidxfree;
  432. begin
  433. nodeppudata.free;
  434. nodeppudata:=nil;
  435. end;
  436. procedure nodeppuidxadd(n:tnode);
  437. begin
  438. if n.ppuidx<0 then
  439. internalerror(200311072);
  440. nodeppudata.seek(n.ppuidx*sizeof(pointer));
  441. nodeppudata.write(n,sizeof(pointer));
  442. end;
  443. function nodeppuidxget(i:longint):tnode;
  444. begin
  445. if i<0 then
  446. internalerror(200311072);
  447. nodeppudata.seek(i*sizeof(pointer));
  448. if nodeppudata.read(result,sizeof(pointer))<>sizeof(pointer) then
  449. internalerror(200311073);
  450. end;
  451. function ppuloadnode(ppufile:tcompilerppufile):tnode;
  452. var
  453. b : byte;
  454. t : tnodetype;
  455. hppuidx : longint;
  456. begin
  457. { marker }
  458. b:=ppufile.getbyte;
  459. if b<>ppunodemarker then
  460. internalerror(200208151);
  461. { load nodetype }
  462. t:=tnodetype(ppufile.getbyte);
  463. if t>high(tnodetype) then
  464. internalerror(200208152);
  465. if t<>emptynode then
  466. begin
  467. if not assigned(nodeclass[t]) then
  468. internalerror(200208153);
  469. hppuidx:=ppufile.getlongint;
  470. //writeln('load: ',nodetype2str[t]);
  471. { generate node of the correct class }
  472. result:=nodeclass[t].ppuload(t,ppufile);
  473. result.ppuidx:=hppuidx;
  474. nodeppuidxadd(result);
  475. end
  476. else
  477. result:=nil;
  478. end;
  479. procedure ppuwritenode(ppufile:tcompilerppufile;n:tnode);
  480. begin
  481. { marker, read by ppuloadnode }
  482. ppufile.putbyte(ppunodemarker);
  483. { type, read by ppuloadnode }
  484. if assigned(n) then
  485. begin
  486. if n.ppuidx=-1 then
  487. internalerror(200311071);
  488. n.ppuidx:=nodeppuidx;
  489. inc(nodeppuidx);
  490. ppufile.putbyte(byte(n.nodetype));
  491. ppufile.putlongint(n.ppuidx);
  492. //writeln('write: ',nodetype2str[n.nodetype]);
  493. n.ppuwrite(ppufile);
  494. end
  495. else
  496. ppufile.putbyte(byte(emptynode));
  497. end;
  498. procedure ppuwritenoderef(ppufile:tcompilerppufile;n:tnode);
  499. begin
  500. { writing of node references isn't implemented yet (FK) }
  501. internalerror(200506181);
  502. end;
  503. function ppuloadnoderef(ppufile:tcompilerppufile) : tnode;
  504. begin
  505. { reading of node references isn't implemented yet (FK) }
  506. internalerror(200506182);
  507. { avoid warning }
  508. result := nil;
  509. end;
  510. function ppuloadnodetree(ppufile:tcompilerppufile):tnode;
  511. begin
  512. if ppufile.readentry<>ibnodetree then
  513. Message(unit_f_ppu_read_error);
  514. nodeppuidxcreate;
  515. result:=ppuloadnode(ppufile);
  516. result.derefnode;
  517. nodeppuidxfree;
  518. end;
  519. procedure ppuwritenodetree(ppufile:tcompilerppufile;n:tnode);
  520. begin
  521. nodeppuidx:=0;
  522. ppuwritenode(ppufile,n);
  523. ppufile.writeentry(ibnodetree);
  524. end;
  525. procedure printnodeindent;
  526. begin
  527. printnodeindention:=printnodeindention+printnodespacing;
  528. end;
  529. procedure printnodeunindent;
  530. begin
  531. delete(printnodeindention,1,length(printnodespacing));
  532. end;
  533. procedure printnode(var t:text;n:tnode);
  534. begin
  535. if assigned(n) then
  536. n.printnodetree(t)
  537. else
  538. writeln(t,printnodeindention,'nil');
  539. end;
  540. procedure printnode(n:tnode);
  541. begin
  542. printnode(output,n);
  543. end;
  544. function is_constnode(p : tnode) : boolean;
  545. begin
  546. is_constnode:=(p.nodetype in [niln,ordconstn,realconstn,stringconstn,setconstn,guidconstn]);
  547. end;
  548. function is_constintnode(p : tnode) : boolean;
  549. begin
  550. is_constintnode:=(p.nodetype=ordconstn) and is_integer(p.resultdef);
  551. end;
  552. function is_constcharnode(p : tnode) : boolean;
  553. begin
  554. is_constcharnode:=(p.nodetype=ordconstn) and is_char(p.resultdef);
  555. end;
  556. function is_constwidecharnode(p : tnode) : boolean;
  557. begin
  558. is_constwidecharnode:=(p.nodetype=ordconstn) and is_widechar(p.resultdef);
  559. end;
  560. function is_constrealnode(p : tnode) : boolean;
  561. begin
  562. is_constrealnode:=(p.nodetype=realconstn);
  563. end;
  564. function is_constboolnode(p : tnode) : boolean;
  565. begin
  566. is_constboolnode:=(p.nodetype=ordconstn) and is_boolean(p.resultdef);
  567. end;
  568. function is_constenumnode(p : tnode) : boolean;
  569. begin
  570. is_constenumnode:=(p.nodetype=ordconstn) and (p.resultdef.typ=enumdef);
  571. end;
  572. {****************************************************************************
  573. TNODE
  574. ****************************************************************************}
  575. constructor tnode.create(t:tnodetype);
  576. begin
  577. inherited create;
  578. nodetype:=t;
  579. blocktype:=block_type;
  580. { updated by firstpass }
  581. expectloc:=LOC_INVALID;
  582. { updated by secondpass }
  583. location.loc:=LOC_INVALID;
  584. { save local info }
  585. fileinfo:=current_filepos;
  586. localswitches:=current_settings.localswitches;
  587. resultdef:=nil;
  588. registersint:=0;
  589. registersfpu:=0;
  590. {$ifdef SUPPORT_MMX}
  591. registersmmx:=0;
  592. {$endif SUPPORT_MMX}
  593. {$ifdef EXTDEBUG}
  594. maxfirstpasscount:=0;
  595. firstpasscount:=0;
  596. {$endif EXTDEBUG}
  597. flags:=[];
  598. ppuidx:=-1;
  599. end;
  600. constructor tnode.createforcopy;
  601. begin
  602. end;
  603. constructor tnode.ppuload(t:tnodetype;ppufile:tcompilerppufile);
  604. begin
  605. nodetype:=t;
  606. { tnode fields }
  607. blocktype:=tblock_type(ppufile.getbyte);
  608. ppufile.getposinfo(fileinfo);
  609. ppufile.getsmallset(localswitches);
  610. ppufile.getderef(resultdefderef);
  611. ppufile.getsmallset(flags);
  612. { updated by firstpass }
  613. expectloc:=LOC_INVALID;
  614. { updated by secondpass }
  615. location.loc:=LOC_INVALID;
  616. registersint:=0;
  617. registersfpu:=0;
  618. {$ifdef SUPPORT_MMX}
  619. registersmmx:=0;
  620. {$endif SUPPORT_MMX}
  621. {$ifdef EXTDEBUG}
  622. maxfirstpasscount:=0;
  623. firstpasscount:=0;
  624. {$endif EXTDEBUG}
  625. ppuidx:=-1;
  626. end;
  627. procedure tnode.ppuwrite(ppufile:tcompilerppufile);
  628. begin
  629. ppufile.putbyte(byte(block_type));
  630. ppufile.putposinfo(fileinfo);
  631. ppufile.putsmallset(localswitches);
  632. ppufile.putderef(resultdefderef);
  633. ppufile.putsmallset(flags);
  634. end;
  635. procedure tnode.buildderefimpl;
  636. begin
  637. resultdefderef.build(resultdef);
  638. end;
  639. procedure tnode.derefimpl;
  640. begin
  641. resultdef:=tdef(resultdefderef.resolve);
  642. end;
  643. procedure tnode.derefnode;
  644. begin
  645. end;
  646. procedure tnode.toggleflag(f : tnodeflag);
  647. begin
  648. if f in flags then
  649. exclude(flags,f)
  650. else
  651. include(flags,f);
  652. end;
  653. function tnode.simplify : tnode;
  654. begin
  655. result:=nil;
  656. end;
  657. destructor tnode.destroy;
  658. begin
  659. {$ifdef EXTDEBUG}
  660. if firstpasscount>maxfirstpasscount then
  661. maxfirstpasscount:=firstpasscount;
  662. {$endif EXTDEBUG}
  663. end;
  664. procedure tnode.concattolist(l : tlinkedlist);
  665. begin
  666. end;
  667. function tnode.ischild(p : tnode) : boolean;
  668. begin
  669. ischild:=false;
  670. end;
  671. procedure tnode.mark_write;
  672. begin
  673. {$ifdef EXTDEBUG}
  674. Comment(V_Warning,'mark_write not implemented for '+nodetype2str[nodetype]);
  675. {$endif EXTDEBUG}
  676. end;
  677. procedure tnode.printnodeinfo(var t:text);
  678. begin
  679. write(t,nodetype2str[nodetype]);
  680. if assigned(resultdef) then
  681. write(t,', resultdef = "',resultdef.GetTypeName,'"')
  682. else
  683. write(t,', resultdef = <nil>');
  684. write(t,', pos = (',fileinfo.line,',',fileinfo.column,')',
  685. ', loc = ',tcgloc2str[location.loc],
  686. ', expectloc = ',tcgloc2str[expectloc],
  687. ', intregs = ',registersint,
  688. ', fpuregs = ',registersfpu);
  689. end;
  690. procedure tnode.printnodedata(var t:text);
  691. begin
  692. end;
  693. procedure tnode.printnodetree(var t:text);
  694. begin
  695. write(t,printnodeindention,'(');
  696. printnodeinfo(t);
  697. writeln(t);
  698. printnodeindent;
  699. printnodedata(t);
  700. printnodeunindent;
  701. writeln(t,printnodeindention,')');
  702. end;
  703. function tnode.isequal(p : tnode) : boolean;
  704. begin
  705. isequal:=
  706. (not assigned(self) and not assigned(p)) or
  707. (assigned(self) and assigned(p) and
  708. { optimized subclasses have the same nodetype as their }
  709. { superclass (for compatibility), so also check the classtype (JM) }
  710. (p.classtype=classtype) and
  711. (p.nodetype=nodetype) and
  712. (flags*flagsequal=p.flags*flagsequal) and
  713. docompare(p));
  714. end;
  715. {$ifdef state_tracking}
  716. function Tnode.track_state_pass(exec_known:boolean):boolean;
  717. begin
  718. track_state_pass:=false;
  719. end;
  720. {$endif state_tracking}
  721. function tnode.docompare(p : tnode) : boolean;
  722. begin
  723. docompare:=true;
  724. end;
  725. function cleanupcopiedto(var n : tnode;arg : pointer) : foreachnoderesult;
  726. begin
  727. result:=fen_true;
  728. if n.nodetype=labeln then
  729. tlabelnode(n).copiedto:=nil;
  730. end;
  731. function tnode.getcopy : tnode;
  732. begin
  733. result:=dogetcopy;
  734. foreachnodestatic(pm_postprocess,self,@cleanupcopiedto,nil);
  735. end;
  736. function tnode.dogetcopy : tnode;
  737. var
  738. p : tnode;
  739. begin
  740. { this is quite tricky because we need a node of the current }
  741. { node type and not one of tnode! }
  742. p:=tnodeclass(classtype).createforcopy;
  743. p.nodetype:=nodetype;
  744. p.expectloc:=expectloc;
  745. p.location:=location;
  746. p.parent:=parent;
  747. p.flags:=flags;
  748. p.registersint:=registersint;
  749. p.registersfpu:=registersfpu;
  750. {$ifdef SUPPORT_MMX}
  751. p.registersmmx:=registersmmx;
  752. p.registersmm:=registersmm;
  753. {$endif SUPPORT_MMX}
  754. p.resultdef:=resultdef;
  755. p.fileinfo:=fileinfo;
  756. p.localswitches:=localswitches;
  757. {$ifdef extdebug}
  758. p.firstpasscount:=firstpasscount;
  759. {$endif extdebug}
  760. { p.list:=list; }
  761. result:=p;
  762. end;
  763. procedure tnode.insertintolist(l : tnodelist);
  764. begin
  765. end;
  766. {****************************************************************************
  767. TUNARYNODE
  768. ****************************************************************************}
  769. constructor tunarynode.create(t:tnodetype;l : tnode);
  770. begin
  771. inherited create(t);
  772. left:=l;
  773. end;
  774. constructor tunarynode.ppuload(t:tnodetype;ppufile:tcompilerppufile);
  775. begin
  776. inherited ppuload(t,ppufile);
  777. left:=ppuloadnode(ppufile);
  778. end;
  779. destructor tunarynode.destroy;
  780. begin
  781. left.free;
  782. inherited destroy;
  783. end;
  784. procedure tunarynode.ppuwrite(ppufile:tcompilerppufile);
  785. begin
  786. inherited ppuwrite(ppufile);
  787. ppuwritenode(ppufile,left);
  788. end;
  789. procedure tunarynode.buildderefimpl;
  790. begin
  791. inherited buildderefimpl;
  792. if assigned(left) then
  793. left.buildderefimpl;
  794. end;
  795. procedure tunarynode.derefimpl;
  796. begin
  797. inherited derefimpl;
  798. if assigned(left) then
  799. left.derefimpl;
  800. end;
  801. procedure tunarynode.derefnode;
  802. begin
  803. inherited derefnode;
  804. if assigned(left) then
  805. left.derefnode;
  806. end;
  807. function tunarynode.docompare(p : tnode) : boolean;
  808. begin
  809. docompare:=(inherited docompare(p) and
  810. ((left=nil) or left.isequal(tunarynode(p).left))
  811. );
  812. end;
  813. function tunarynode.dogetcopy : tnode;
  814. var
  815. p : tunarynode;
  816. begin
  817. p:=tunarynode(inherited dogetcopy);
  818. if assigned(left) then
  819. p.left:=left.dogetcopy
  820. else
  821. p.left:=nil;
  822. result:=p;
  823. end;
  824. procedure tunarynode.insertintolist(l : tnodelist);
  825. begin
  826. end;
  827. procedure tunarynode.printnodedata(var t:text);
  828. begin
  829. inherited printnodedata(t);
  830. printnode(t,left);
  831. end;
  832. procedure tunarynode.left_max;
  833. begin
  834. registersint:=left.registersint;
  835. registersfpu:=left.registersfpu;
  836. {$ifdef SUPPORT_MMX}
  837. registersmmx:=left.registersmmx;
  838. {$endif SUPPORT_MMX}
  839. end;
  840. procedure tunarynode.concattolist(l : tlinkedlist);
  841. begin
  842. left.parent:=self;
  843. left.concattolist(l);
  844. inherited concattolist(l);
  845. end;
  846. function tunarynode.ischild(p : tnode) : boolean;
  847. begin
  848. ischild:=p=left;
  849. end;
  850. {****************************************************************************
  851. TBINARYNODE
  852. ****************************************************************************}
  853. constructor tbinarynode.create(t:tnodetype;l,r : tnode);
  854. begin
  855. inherited create(t,l);
  856. right:=r
  857. end;
  858. constructor tbinarynode.ppuload(t:tnodetype;ppufile:tcompilerppufile);
  859. begin
  860. inherited ppuload(t,ppufile);
  861. right:=ppuloadnode(ppufile);
  862. end;
  863. destructor tbinarynode.destroy;
  864. begin
  865. right.free;
  866. inherited destroy;
  867. end;
  868. procedure tbinarynode.ppuwrite(ppufile:tcompilerppufile);
  869. begin
  870. inherited ppuwrite(ppufile);
  871. ppuwritenode(ppufile,right);
  872. end;
  873. procedure tbinarynode.buildderefimpl;
  874. begin
  875. inherited buildderefimpl;
  876. if assigned(right) then
  877. right.buildderefimpl;
  878. end;
  879. procedure tbinarynode.derefimpl;
  880. begin
  881. inherited derefimpl;
  882. if assigned(right) then
  883. right.derefimpl;
  884. end;
  885. procedure tbinarynode.derefnode;
  886. begin
  887. inherited derefnode;
  888. if assigned(right) then
  889. right.derefnode;
  890. end;
  891. procedure tbinarynode.concattolist(l : tlinkedlist);
  892. begin
  893. { we could change that depending on the number of }
  894. { required registers }
  895. left.parent:=self;
  896. left.concattolist(l);
  897. left.parent:=self;
  898. left.concattolist(l);
  899. inherited concattolist(l);
  900. end;
  901. function tbinarynode.ischild(p : tnode) : boolean;
  902. begin
  903. ischild:=(p=right);
  904. end;
  905. function tbinarynode.docompare(p : tnode) : boolean;
  906. begin
  907. docompare:=(inherited docompare(p) and
  908. ((right=nil) or right.isequal(tbinarynode(p).right))
  909. );
  910. end;
  911. function tbinarynode.dogetcopy : tnode;
  912. var
  913. p : tbinarynode;
  914. begin
  915. p:=tbinarynode(inherited dogetcopy);
  916. if assigned(right) then
  917. p.right:=right.dogetcopy
  918. else
  919. p.right:=nil;
  920. result:=p;
  921. end;
  922. procedure tbinarynode.insertintolist(l : tnodelist);
  923. begin
  924. end;
  925. procedure tbinarynode.swapleftright;
  926. var
  927. swapp : tnode;
  928. begin
  929. swapp:=right;
  930. right:=left;
  931. left:=swapp;
  932. if nf_swapped in flags then
  933. exclude(flags,nf_swapped)
  934. else
  935. include(flags,nf_swapped);
  936. end;
  937. procedure tbinarynode.left_right_max;
  938. begin
  939. if assigned(left) then
  940. begin
  941. if assigned(right) then
  942. begin
  943. registersint:=max(left.registersint,right.registersint);
  944. registersfpu:=max(left.registersfpu,right.registersfpu);
  945. {$ifdef SUPPORT_MMX}
  946. registersmmx:=max(left.registersmmx,right.registersmmx);
  947. {$endif SUPPORT_MMX}
  948. end
  949. else
  950. begin
  951. registersint:=left.registersint;
  952. registersfpu:=left.registersfpu;
  953. {$ifdef SUPPORT_MMX}
  954. registersmmx:=left.registersmmx;
  955. {$endif SUPPORT_MMX}
  956. end;
  957. end;
  958. end;
  959. procedure tbinarynode.printnodedata(var t:text);
  960. begin
  961. inherited printnodedata(t);
  962. printnode(t,right);
  963. end;
  964. procedure tbinarynode.printnodelist(var t:text);
  965. var
  966. hp : tbinarynode;
  967. begin
  968. hp:=self;
  969. while assigned(hp) do
  970. begin
  971. write(t,printnodeindention,'(');
  972. printnodeindent;
  973. hp.printnodeinfo(t);
  974. writeln(t);
  975. printnode(t,hp.left);
  976. writeln(t);
  977. printnodeunindent;
  978. writeln(t,printnodeindention,')');
  979. hp:=tbinarynode(hp.right);
  980. end;
  981. end;
  982. {****************************************************************************
  983. TTERTIARYNODE
  984. ****************************************************************************}
  985. constructor ttertiarynode.create(_t:tnodetype;l,r,t : tnode);
  986. begin
  987. inherited create(_t,l,r);
  988. third:=t;
  989. end;
  990. constructor ttertiarynode.ppuload(t:tnodetype;ppufile:tcompilerppufile);
  991. begin
  992. inherited ppuload(t,ppufile);
  993. third:=ppuloadnode(ppufile);
  994. end;
  995. destructor ttertiarynode.destroy;
  996. begin
  997. third.free;
  998. inherited destroy;
  999. end;
  1000. procedure ttertiarynode.ppuwrite(ppufile:tcompilerppufile);
  1001. begin
  1002. inherited ppuwrite(ppufile);
  1003. ppuwritenode(ppufile,third);
  1004. end;
  1005. procedure ttertiarynode.buildderefimpl;
  1006. begin
  1007. inherited buildderefimpl;
  1008. if assigned(third) then
  1009. third.buildderefimpl;
  1010. end;
  1011. procedure ttertiarynode.derefimpl;
  1012. begin
  1013. inherited derefimpl;
  1014. if assigned(third) then
  1015. third.derefimpl;
  1016. end;
  1017. procedure ttertiarynode.derefnode;
  1018. begin
  1019. inherited derefnode;
  1020. if assigned(third) then
  1021. third.derefnode;
  1022. end;
  1023. function ttertiarynode.docompare(p : tnode) : boolean;
  1024. begin
  1025. docompare:=(inherited docompare(p) and
  1026. ((third=nil) or third.isequal(ttertiarynode(p).third))
  1027. );
  1028. end;
  1029. function ttertiarynode.dogetcopy : tnode;
  1030. var
  1031. p : ttertiarynode;
  1032. begin
  1033. p:=ttertiarynode(inherited dogetcopy);
  1034. if assigned(third) then
  1035. p.third:=third.dogetcopy
  1036. else
  1037. p.third:=nil;
  1038. result:=p;
  1039. end;
  1040. procedure ttertiarynode.insertintolist(l : tnodelist);
  1041. begin
  1042. end;
  1043. procedure ttertiarynode.printnodedata(var t:text);
  1044. begin
  1045. inherited printnodedata(t);
  1046. printnode(t,third);
  1047. end;
  1048. procedure ttertiarynode.concattolist(l : tlinkedlist);
  1049. begin
  1050. third.parent:=self;
  1051. third.concattolist(l);
  1052. inherited concattolist(l);
  1053. end;
  1054. function ttertiarynode.ischild(p : tnode) : boolean;
  1055. begin
  1056. ischild:=p=third;
  1057. end;
  1058. {****************************************************************************
  1059. TBINOPNODE
  1060. ****************************************************************************}
  1061. constructor tbinopnode.create(t:tnodetype;l,r : tnode);
  1062. begin
  1063. inherited create(t,l,r);
  1064. end;
  1065. function tbinopnode.docompare(p : tnode) : boolean;
  1066. begin
  1067. docompare:=(inherited docompare(p)) or
  1068. { if that's in the flags, is p then always a tbinopnode (?) (JM) }
  1069. ((nf_swapable in flags) and
  1070. left.isequal(tbinopnode(p).right) and
  1071. right.isequal(tbinopnode(p).left));
  1072. end;
  1073. end.