node.pas 43 KB

123456789101112131415161718192021222324252627282930313233343536373839404142434445464748495051525354555657585960616263646566676869707172737475767778798081828384858687888990919293949596979899100101102103104105106107108109110111112113114115116117118119120121122123124125126127128129130131132133134135136137138139140141142143144145146147148149150151152153154155156157158159160161162163164165166167168169170171172173174175176177178179180181182183184185186187188189190191192193194195196197198199200201202203204205206207208209210211212213214215216217218219220221222223224225226227228229230231232233234235236237238239240241242243244245246247248249250251252253254255256257258259260261262263264265266267268269270271272273274275276277278279280281282283284285286287288289290291292293294295296297298299300301302303304305306307308309310311312313314315316317318319320321322323324325326327328329330331332333334335336337338339340341342343344345346347348349350351352353354355356357358359360361362363364365366367368369370371372373374375376377378379380381382383384385386387388389390391392393394395396397398399400401402403404405406407408409410411412413414415416417418419420421422423424425426427428429430431432433434435436437438439440441442443444445446447448449450451452453454455456457458459460461462463464465466467468469470471472473474475476477478479480481482483484485486487488489490491492493494495496497498499500501502503504505506507508509510511512513514515516517518519520521522523524525526527528529530531532533534535536537538539540541542543544545546547548549550551552553554555556557558559560561562563564565566567568569570571572573574575576577578579580581582583584585586587588589590591592593594595596597598599600601602603604605606607608609610611612613614615616617618619620621622623624625626627628629630631632633634635636637638639640641642643644645646647648649650651652653654655656657658659660661662663664665666667668669670671672673674675676677678679680681682683684685686687688689690691692693694695696697698699700701702703704705706707708709710711712713714715716717718719720721722723724725726727728729730731732733734735736737738739740741742743744745746747748749750751752753754755756757758759760761762763764765766767768769770771772773774775776777778779780781782783784785786787788789790791792793794795796797798799800801802803804805806807808809810811812813814815816817818819820821822823824825826827828829830831832833834835836837838839840841842843844845846847848849850851852853854855856857858859860861862863864865866867868869870871872873874875876877878879880881882883884885886887888889890891892893894895896897898899900901902903904905906907908909910911912913914915916917918919920921922923924925926927928929930931932933934935936937938939940941942943944945946947948949950951952953954955956957958959960961962963964965966967968969970971972973974975976977978979980981982983984985986987988989990991992993994995996997998999100010011002100310041005100610071008100910101011101210131014101510161017101810191020102110221023102410251026102710281029103010311032103310341035103610371038103910401041104210431044104510461047104810491050105110521053105410551056105710581059106010611062106310641065106610671068106910701071107210731074107510761077107810791080108110821083108410851086108710881089109010911092109310941095109610971098109911001101110211031104110511061107110811091110111111121113111411151116111711181119112011211122112311241125112611271128112911301131113211331134113511361137113811391140114111421143114411451146114711481149115011511152115311541155115611571158115911601161116211631164116511661167116811691170117111721173117411751176117711781179118011811182118311841185118611871188118911901191119211931194119511961197119811991200120112021203120412051206120712081209121012111212121312141215121612171218121912201221122212231224122512261227122812291230123112321233123412351236123712381239124012411242124312441245124612471248124912501251125212531254125512561257125812591260126112621263126412651266126712681269127012711272127312741275127612771278127912801281128212831284128512861287128812891290129112921293129412951296129712981299130013011302130313041305130613071308130913101311131213131314131513161317131813191320132113221323132413251326132713281329133013311332133313341335133613371338133913401341134213431344134513461347134813491350135113521353135413551356135713581359136013611362136313641365136613671368136913701371137213731374137513761377137813791380138113821383138413851386138713881389139013911392139313941395139613971398139914001401140214031404140514061407140814091410141114121413141414151416141714181419142014211422142314241425142614271428142914301431143214331434143514361437143814391440144114421443144414451446144714481449145014511452145314541455
  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,cgbase,cgutils,
  23. symtype,
  24. optbase;
  25. type
  26. tnodetype = (
  27. emptynode, {No node (returns nil when loading from ppu)}
  28. addn, {Represents the + operator}
  29. muln, {Represents the * operator}
  30. subn, {Represents the - operator}
  31. divn, {Represents the div operator}
  32. symdifn, {Represents the >< operator}
  33. modn, {Represents the mod operator}
  34. assignn, {Represents an assignment}
  35. loadn, {Represents the use of a variabele}
  36. rangen, {Represents a range (i.e. 0..9)}
  37. ltn, {Represents the < operator}
  38. lten, {Represents the <= operator}
  39. gtn, {Represents the > operator}
  40. gten, {Represents the >= operator}
  41. equaln, {Represents the = operator}
  42. unequaln, {Represents the <> operator}
  43. inn, {Represents the in operator}
  44. orn, {Represents the or operator}
  45. xorn, {Represents the xor operator}
  46. shrn, {Represents the shr operator}
  47. shln, {Represents the shl operator}
  48. slashn, {Represents the / operator}
  49. andn, {Represents the and operator}
  50. subscriptn, {Field in a record/object}
  51. derefn, {Dereferences a pointer}
  52. addrn, {Represents the @ operator}
  53. ordconstn, {Represents an ordinal value}
  54. typeconvn, {Represents type-conversion/typecast}
  55. calln, {Represents a call node}
  56. callparan, {Represents a parameter}
  57. realconstn, {Represents a real value}
  58. unaryminusn, {Represents a sign change (i.e. -2)}
  59. unaryplusn, {Represents a check for +Value}
  60. asmn, {Represents an assembler node }
  61. vecn, {Represents array indexing}
  62. pointerconstn, {Represents a pointer constant}
  63. stringconstn, {Represents a string constant}
  64. notn, {Represents the not operator}
  65. inlinen, {Internal procedures (i.e. writeln)}
  66. niln, {Represents the nil pointer}
  67. errorn, {This part of the tree could not be
  68. parsed because of a compiler error}
  69. typen, {A type name. Used for i.e. typeof(obj)}
  70. setelementn, {A set element(s) (i.e. [a,b] and also [a..b])}
  71. setconstn, {A set constant (i.e. [1,2])}
  72. blockn, {A block of statements}
  73. statementn, {One statement in a block of nodes}
  74. ifn, {An if statement}
  75. breakn, {A break statement}
  76. continuen, {A continue statement}
  77. whilerepeatn, {A while or repeat statement}
  78. forn, {A for loop}
  79. exitn, {An exit statement}
  80. casen, {A case statement}
  81. labeln, {A label}
  82. goton, {A goto statement}
  83. tryexceptn, {A try except block}
  84. raisen, {A raise statement}
  85. tryfinallyn, {A try finally statement}
  86. onn, {For an on statement in exception code}
  87. isn, {Represents the is operator}
  88. asn, {Represents the as typecast}
  89. starstarn, {Represents the ** operator exponentiation }
  90. arrayconstructorn, {Construction node for [...] parsing}
  91. arrayconstructorrangen, {Range element to allow sets in array construction tree}
  92. tempcreaten, { for temps in the result/firstpass }
  93. temprefn, { references to temps }
  94. tempdeleten, { for temps in the result/firstpass }
  95. addoptn, { added for optimizations where we cannot suppress }
  96. nothingn, { NOP, Do nothing}
  97. loadvmtaddrn, { Load the address of the VMT of a class/object}
  98. guidconstn, { A GUID COM Interface constant }
  99. rttin, { Rtti information so they can be accessed in result/firstpass}
  100. loadparentfpn, { Load the framepointer of the parent for nested procedures }
  101. objcselectorn, { node for an Objective-C message selector }
  102. objcprotocoln, { node for an Objective-C @protocol() expression (returns metaclass associated with protocol) }
  103. specializen, { parser-only node to handle Delphi-mode inline specializations }
  104. finalizetempsn { Internal node used to clean up code generator temps (warning: must NOT create additional tepms that may need to be finalised!) }
  105. );
  106. tnodetypeset = set of tnodetype;
  107. pnodetypeset = ^tnodetypeset;
  108. const
  109. nodetype2str : array[tnodetype] of string[24] = (
  110. '<emptynode>',
  111. 'addn',
  112. 'muln',
  113. 'subn',
  114. 'divn',
  115. 'symdifn',
  116. 'modn',
  117. 'assignn',
  118. 'loadn',
  119. 'rangen',
  120. 'ltn',
  121. 'lten',
  122. 'gtn',
  123. 'gten',
  124. 'equaln',
  125. 'unequaln',
  126. 'inn',
  127. 'orn',
  128. 'xorn',
  129. 'shrn',
  130. 'shln',
  131. 'slashn',
  132. 'andn',
  133. 'subscriptn',
  134. 'derefn',
  135. 'addrn',
  136. 'ordconstn',
  137. 'typeconvn',
  138. 'calln',
  139. 'callparan',
  140. 'realconstn',
  141. 'unaryminusn',
  142. 'unaryplusn',
  143. 'asmn',
  144. 'vecn',
  145. 'pointerconstn',
  146. 'stringconstn',
  147. 'notn',
  148. 'inlinen',
  149. 'niln',
  150. 'errorn',
  151. 'typen',
  152. 'setelementn',
  153. 'setconstn',
  154. 'blockn',
  155. 'statementn',
  156. 'ifn',
  157. 'breakn',
  158. 'continuen',
  159. 'whilerepeatn',
  160. 'forn',
  161. 'exitn',
  162. 'casen',
  163. 'labeln',
  164. 'goton',
  165. 'tryexceptn',
  166. 'raisen',
  167. 'tryfinallyn',
  168. 'onn',
  169. 'isn',
  170. 'asn',
  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. 'objcselectorn',
  184. 'objcprotocoln',
  185. 'specializen',
  186. 'finalizetempsn');
  187. { a set containing all const nodes }
  188. nodetype_const = [niln,
  189. ordconstn,
  190. pointerconstn,
  191. stringconstn,
  192. guidconstn,
  193. realconstn,
  194. setconstn];
  195. type
  196. { all boolean field of ttree are now collected in flags }
  197. tnodeflag = (
  198. { tbinop operands can be swaped }
  199. nf_swapable,
  200. { tbinop operands are swaped }
  201. nf_swapped,
  202. nf_error,
  203. { general }
  204. nf_pass1_done,
  205. { Node is written to }
  206. nf_write,
  207. { Node is modified }
  208. nf_modify,
  209. { address of node is taken }
  210. nf_address_taken,
  211. nf_is_funcret,
  212. nf_isproperty,
  213. nf_processing,
  214. { Node cannot be assigned to }
  215. nf_no_lvalue,
  216. { this node is the user code entry, if a node with this flag is removed
  217. during simplify, the flag must be moved to another node. Though
  218. normally applicable to block nodes, they can also appear on asm nodes
  219. in the case of pure assembly routines }
  220. nf_usercode_entry,
  221. { tderefnode }
  222. nf_no_checkpointer,
  223. { tloadnode/ttypeconvnode }
  224. nf_absolute,
  225. { taddnode, but appears in typeconv nodes as well among other places }
  226. { if the result type of a node is currency, then this flag denotes, that the value is already mulitplied by 10000 }
  227. nf_is_currency,
  228. { tarrayconstructnode }
  229. nf_forcevaria,
  230. nf_novariaallowed,
  231. { ttypeconvnode, and the first one also treal/ord/pointerconstn }
  232. { second one also for subtractions of u32-u32 implicitly upcasted to s64 }
  233. { last one also used on addnode to inhibit procvar calling }
  234. nf_explicit,
  235. nf_internal, { no warnings/hints generated }
  236. nf_load_procvar,
  237. { tinlinenode }
  238. nf_inlineconst,
  239. { tblocknode / this is not node-specific because it can also appear on
  240. implicit try/finally nodes }
  241. nf_block_with_exit,
  242. { tloadvmtaddrnode / tisnode }
  243. nf_ignore_for_wpo, { we know that this loadvmtaddrnode cannot be used to construct a class instance }
  244. { node is derived from generic parameter }
  245. nf_generic_para,
  246. { internal flag to indicate that this node has been removed from the tree or must otherwise not be
  247. execute. Running it through firstpass etc. will raise an internal error }
  248. nf_do_not_execute
  249. );
  250. tnodeflags = set of tnodeflag;
  251. const
  252. { contains the flags which must be equal for the equality }
  253. { of nodes }
  254. flagsequal : tnodeflags = [nf_error];
  255. type
  256. tnodelist = class
  257. end;
  258. pnode = ^tnode;
  259. { basic class for the intermediated representation fpc uses }
  260. tnode = class
  261. private
  262. fppuidx : longint;
  263. function getppuidx:longint;
  264. public
  265. { type of this node }
  266. nodetype : tnodetype;
  267. { type of the current code block, general/const/type }
  268. blocktype : tblock_type;
  269. { expected location of the result of this node (pass1) }
  270. expectloc : tcgloc;
  271. { the location of the result of this node (pass2) }
  272. location : tlocation;
  273. { next node in control flow on the same block level, i.e.
  274. for loop nodes, this is the next node after the end of the loop,
  275. same for if and case, if this field is nil, the next node is the procedure exit,
  276. for the last node in a loop this is set to the loop header
  277. this field is set only for control flow nodes }
  278. successor : tnode;
  279. { there are some properties about the node stored }
  280. flags : tnodeflags;
  281. resultdef : tdef;
  282. resultdefderef : tderef;
  283. fileinfo : tfileposinfo;
  284. localswitches : tlocalswitches;
  285. verbosity : longint;
  286. optinfo : poptinfo;
  287. constructor create(t:tnodetype);
  288. { this constructor is only for creating copies of class }
  289. { the fields are copied by getcopy }
  290. constructor createforcopy;
  291. constructor ppuload(t:tnodetype;ppufile:tcompilerppufile);virtual;
  292. destructor destroy;override;
  293. procedure ppuwrite(ppufile:tcompilerppufile);virtual;
  294. procedure buildderefimpl;virtual;
  295. procedure derefimpl;virtual;
  296. procedure resolveppuidx;virtual;
  297. { toggles the flag }
  298. procedure toggleflag(f : tnodeflag);
  299. { the 1.1 code generator may override pass_1 }
  300. { and it need not to implement det_* then }
  301. { 1.1: pass_1 returns a value<>0 if the node has been transformed }
  302. { 2.0: runs pass_typecheck and det_temp }
  303. function pass_1 : tnode;virtual;abstract;
  304. { dermines the resultdef of the node }
  305. function pass_typecheck : tnode;virtual;abstract;
  306. { tries to simplify the node, returns a value <>nil if a simplified
  307. node has been created }
  308. function simplify(forinline : boolean) : tnode;virtual;
  309. {$ifdef state_tracking}
  310. { Does optimizations by keeping track of the variable states
  311. in a procedure }
  312. function track_state_pass(exec_known:boolean):boolean;virtual;
  313. {$endif}
  314. { For a t1:=t2 tree, mark the part of the tree t1 that gets
  315. written to (normally the loadnode) as write access. }
  316. procedure mark_write;virtual;
  317. { dermines the number of necessary temp. locations to evaluate
  318. the node }
  319. procedure det_temp;virtual;abstract;
  320. procedure pass_generate_code;virtual;abstract;
  321. { comparing of nodes }
  322. function isequal(p : tnode) : boolean;
  323. { to implement comparisation, override this method }
  324. function docompare(p : tnode) : boolean;virtual;
  325. { wrapper for getcopy }
  326. function getcopy : tnode;
  327. { does the real copying of a node }
  328. function dogetcopy : tnode;virtual;
  329. procedure insertintolist(l : tnodelist);virtual;
  330. { writes a node for debugging purpose, shouldn't be called }
  331. { direct, because there is no test for nil, use printnode }
  332. { to write a complete tree }
  333. procedure printnodeinfo(var t:text);virtual;
  334. procedure printnodedata(var t:text);virtual;
  335. procedure printnodetree(var t:text);virtual;
  336. {$ifdef DEBUG_NODE_XML}
  337. { For writing nodes to XML files - do not call directly, but
  338. instead call XMLPrintNode to write a complete tree }
  339. procedure XMLPrintNodeInfo(var T: Text); dynamic;
  340. procedure XMLPrintNodeData(var T: Text); virtual;
  341. procedure XMLPrintNodeTree(var T: Text); virtual;
  342. {$endif DEBUG_NODE_XML}
  343. function ischild(p : tnode) : boolean;virtual;
  344. { ensures that the optimizer info record is allocated }
  345. function allocoptinfo : poptinfo;inline;
  346. property ppuidx:longint read getppuidx;
  347. end;
  348. tnodeclass = class of tnode;
  349. tnodeclassarray = array[tnodetype] of tnodeclass;
  350. { this node is the anchestor for all nodes with at least }
  351. { one child, you have to use it if you want to use }
  352. { true- and current_procinfo.CurrFalseLabel }
  353. //punarynode = ^tunarynode;
  354. tunarynode = class(tnode)
  355. left : tnode;
  356. constructor create(t:tnodetype;l : tnode);
  357. constructor ppuload(t:tnodetype;ppufile:tcompilerppufile);override;
  358. destructor destroy;override;
  359. procedure ppuwrite(ppufile:tcompilerppufile);override;
  360. procedure buildderefimpl;override;
  361. procedure derefimpl;override;
  362. function ischild(p : tnode) : boolean;override;
  363. function docompare(p : tnode) : boolean;override;
  364. function dogetcopy : tnode;override;
  365. procedure insertintolist(l : tnodelist);override;
  366. procedure printnodedata(var t:text);override;
  367. {$ifdef DEBUG_NODE_XML}
  368. procedure XMLPrintNodeData(var T: Text); override;
  369. {$endif DEBUG_NODE_XML}
  370. { Marks the current node for deletion and sets 'left' to nil.
  371. Returns what 'left' was previously set to }
  372. function PruneKeepLeft: TNode; {$ifdef USEINLINE}inline;{$endif USEINLINE}
  373. end;
  374. //pbinarynode = ^tbinarynode;
  375. tbinarynode = class(tunarynode)
  376. right : tnode;
  377. constructor create(t:tnodetype;l,r : tnode);
  378. constructor ppuload(t:tnodetype;ppufile:tcompilerppufile);override;
  379. destructor destroy;override;
  380. procedure ppuwrite(ppufile:tcompilerppufile);override;
  381. procedure buildderefimpl;override;
  382. procedure derefimpl;override;
  383. function ischild(p : tnode) : boolean;override;
  384. function docompare(p : tnode) : boolean;override;
  385. procedure swapleftright;
  386. function dogetcopy : tnode;override;
  387. procedure insertintolist(l : tnodelist);override;
  388. procedure printnodedata(var t:text);override;
  389. {$ifdef DEBUG_NODE_XML}
  390. procedure XMLPrintNodeTree(var T: Text); override;
  391. procedure XMLPrintNodeData(var T: Text); override;
  392. {$endif DEBUG_NODE_XML}
  393. procedure printnodelist(var t:text);
  394. { Marks the current node for deletion and sets 'right' to nil.
  395. Returns what 'right' was previously set to }
  396. function PruneKeepRight: TNode; {$IFDEF USEINLINE}inline;{$endif USEINLINE}
  397. end;
  398. //ptertiarynode = ^ttertiarynode;
  399. ttertiarynode = class(tbinarynode)
  400. third : tnode;
  401. constructor create(_t:tnodetype;l,r,t : tnode);
  402. constructor ppuload(t:tnodetype;ppufile:tcompilerppufile);override;
  403. destructor destroy;override;
  404. procedure ppuwrite(ppufile:tcompilerppufile);override;
  405. procedure buildderefimpl;override;
  406. procedure derefimpl;override;
  407. function ischild(p : tnode) : boolean;override;
  408. function docompare(p : tnode) : boolean;override;
  409. function dogetcopy : tnode;override;
  410. procedure insertintolist(l : tnodelist);override;
  411. procedure printnodedata(var t:text);override;
  412. {$ifdef DEBUG_NODE_XML}
  413. procedure XMLPrintNodeData(var T: Text); override;
  414. {$endif DEBUG_NODE_XML}
  415. { Marks the current node for deletion and sets 'third' to nil.
  416. Returns what 'third' was previously set to }
  417. function PruneKeepThird: TNode; {$IFDEF USEINLINE}inline;{$endif USEINLINE}
  418. end;
  419. tbinopnode = class(tbinarynode)
  420. constructor create(t:tnodetype;l,r : tnode);virtual;
  421. function docompare(p : tnode) : boolean;override;
  422. {$ifdef DEBUG_NODE_XML}
  423. procedure XMLPrintNodeData(var T: Text); override;
  424. {$endif DEBUG_NODE_XML}
  425. end;
  426. var
  427. { array with all class types for tnodes }
  428. nodeclass : tnodeclassarray;
  429. function nodeppuidxget(i:longint):tnode;
  430. function ppuloadnode(ppufile:tcompilerppufile):tnode;
  431. procedure ppuwritenode(ppufile:tcompilerppufile;n:tnode);
  432. function ppuloadnodetree(ppufile:tcompilerppufile):tnode;
  433. procedure ppuwritenodetree(ppufile:tcompilerppufile;n:tnode);
  434. procedure printnode(var t:text;n:tnode);
  435. procedure printnode(n:tnode);
  436. {$ifdef DEBUG_NODE_XML}
  437. procedure XMLPrintNode(var T: Text; N: TNode);
  438. {$endif DEBUG_NODE_XML}
  439. function is_constnode(p : tnode) : boolean;
  440. function is_constintnode(p : tnode) : boolean;
  441. function is_constcharnode(p : tnode) : boolean;
  442. function is_constrealnode(p : tnode) : boolean;
  443. function is_constboolnode(p : tnode) : boolean;
  444. function is_constenumnode(p : tnode) : boolean;
  445. function is_constwidecharnode(p : tnode) : boolean;
  446. function is_constpointernode(p : tnode) : boolean;
  447. function is_conststringnode(p : tnode) : boolean;
  448. function is_constwidestringnode(p : tnode) : boolean;
  449. function is_conststring_or_constcharnode(p : tnode) : boolean;
  450. implementation
  451. uses
  452. verbose,entfile,comphook,
  453. {$ifdef DEBUG_NODE_XML}
  454. cutils,
  455. {$endif DEBUG_NODE_XML}
  456. ppu,
  457. symconst,
  458. nutils,nflw,
  459. defutil;
  460. const
  461. ppunodemarker = 255;
  462. {****************************************************************************
  463. Helpers
  464. ****************************************************************************}
  465. var
  466. nodeppulist : TFPObjectList;
  467. nodeppuidx : longint;
  468. procedure nodeppuidxcreate;
  469. begin
  470. nodeppulist:=TFPObjectList.Create(false);
  471. nodeppuidx:=0;
  472. end;
  473. procedure nodeppuidxresolve;
  474. var
  475. i : longint;
  476. n : tnode;
  477. begin
  478. for i:=0 to nodeppulist.count-1 do
  479. begin
  480. n:=tnode(nodeppulist[i]);
  481. if assigned(n) then
  482. n.resolveppuidx;
  483. end;
  484. end;
  485. procedure nodeppuidxfree;
  486. begin
  487. nodeppulist.free;
  488. nodeppulist:=nil;
  489. nodeppuidx:=0;
  490. end;
  491. procedure nodeppuidxadd(n:tnode);
  492. var
  493. i : longint;
  494. begin
  495. i:=n.ppuidx;
  496. if i<=0 then
  497. internalerror(200311072);
  498. if i>=nodeppulist.capacity then
  499. nodeppulist.capacity:=((i div 1024)+1)*1024;
  500. if i>=nodeppulist.count then
  501. nodeppulist.count:=i+1;
  502. nodeppulist[i]:=n;
  503. end;
  504. function nodeppuidxget(i:longint):tnode;
  505. begin
  506. if i<=0 then
  507. internalerror(200311073);
  508. result:=tnode(nodeppulist[i]);
  509. end;
  510. function ppuloadnode(ppufile:tcompilerppufile):tnode;
  511. var
  512. b : byte;
  513. t : tnodetype;
  514. hppuidx : longint;
  515. begin
  516. { marker }
  517. b:=ppufile.getbyte;
  518. if b<>ppunodemarker then
  519. internalerror(200208151);
  520. { load nodetype }
  521. t:=tnodetype(ppufile.getbyte);
  522. if t>high(tnodetype) then
  523. internalerror(200208152);
  524. if t<>emptynode then
  525. begin
  526. if not assigned(nodeclass[t]) then
  527. internalerror(200208153);
  528. hppuidx:=ppufile.getlongint;
  529. //writeln('load: ',nodetype2str[t]);
  530. { generate node of the correct class }
  531. result:=nodeclass[t].ppuload(t,ppufile);
  532. result.fppuidx:=hppuidx;
  533. nodeppuidxadd(result);
  534. end
  535. else
  536. result:=nil;
  537. end;
  538. procedure ppuwritenode(ppufile:tcompilerppufile;n:tnode);
  539. begin
  540. { marker, read by ppuloadnode }
  541. ppufile.putbyte(ppunodemarker);
  542. { type, read by ppuloadnode }
  543. if assigned(n) then
  544. begin
  545. ppufile.putbyte(byte(n.nodetype));
  546. ppufile.putlongint(n.ppuidx);
  547. //writeln('write: ',nodetype2str[n.nodetype]);
  548. n.ppuwrite(ppufile);
  549. end
  550. else
  551. ppufile.putbyte(byte(emptynode));
  552. end;
  553. function ppuloadnodetree(ppufile:tcompilerppufile):tnode;
  554. begin
  555. if ppufile.readentry<>ibnodetree then
  556. Message(unit_f_ppu_read_error);
  557. nodeppuidxcreate;
  558. result:=ppuloadnode(ppufile);
  559. nodeppuidxresolve;
  560. nodeppuidxfree;
  561. end;
  562. procedure ppuwritenodetree(ppufile:tcompilerppufile;n:tnode);
  563. begin
  564. nodeppuidxcreate;
  565. ppuwritenode(ppufile,n);
  566. ppufile.writeentry(ibnodetree);
  567. nodeppuidxfree;
  568. end;
  569. procedure printnode(var t:text;n:tnode);
  570. begin
  571. if assigned(n) then
  572. n.printnodetree(t)
  573. else
  574. writeln(t,printnodeindention,'nil');
  575. end;
  576. procedure printnode(n:tnode);
  577. begin
  578. printnode(output,n);
  579. end;
  580. {$ifdef DEBUG_NODE_XML}
  581. procedure XMLPrintNode(var T: Text; N: TNode);
  582. begin
  583. if Assigned(N) then
  584. N.XMLPrintNodeTree(T);
  585. end;
  586. {$endif DEBUG_NODE_XML}
  587. function is_constnode(p : tnode) : boolean;
  588. begin
  589. is_constnode:=(p.nodetype in nodetype_const);
  590. end;
  591. function is_constintnode(p : tnode) : boolean;
  592. begin
  593. is_constintnode:=(p.nodetype=ordconstn) and is_integer(p.resultdef);
  594. end;
  595. function is_constcharnode(p : tnode) : boolean;
  596. begin
  597. is_constcharnode:=(p.nodetype=ordconstn) and is_char(p.resultdef);
  598. end;
  599. function is_constwidecharnode(p : tnode) : boolean;
  600. begin
  601. is_constwidecharnode:=(p.nodetype=ordconstn) and is_widechar(p.resultdef);
  602. end;
  603. function is_constrealnode(p : tnode) : boolean;
  604. begin
  605. is_constrealnode:=(p.nodetype=realconstn);
  606. end;
  607. function is_constboolnode(p : tnode) : boolean;
  608. begin
  609. is_constboolnode:=(p.nodetype=ordconstn) and is_boolean(p.resultdef);
  610. end;
  611. function is_constenumnode(p : tnode) : boolean;
  612. begin
  613. is_constenumnode:=(p.nodetype=ordconstn) and (p.resultdef.typ=enumdef);
  614. end;
  615. function is_constpointernode(p : tnode) : boolean;
  616. begin
  617. is_constpointernode:=(p.nodetype in [pointerconstn,niln]);
  618. end;
  619. function is_conststringnode(p : tnode) : boolean;
  620. begin
  621. is_conststringnode :=
  622. (p.nodetype = stringconstn) and
  623. (is_chararray(p.resultdef) or
  624. is_shortstring(p.resultdef) or
  625. is_ansistring(p.resultdef));
  626. end;
  627. function is_constwidestringnode(p : tnode) : boolean;
  628. begin
  629. is_constwidestringnode :=
  630. (p.nodetype = stringconstn) and
  631. (is_widechararray(p.resultdef) or
  632. is_wide_or_unicode_string(p.resultdef));
  633. end;
  634. function is_conststring_or_constcharnode(p : tnode) : boolean;
  635. begin
  636. is_conststring_or_constcharnode :=
  637. is_conststringnode(p) or is_constcharnode(p) or
  638. is_constwidestringnode(p) or is_constwidecharnode(p);
  639. end;
  640. {****************************************************************************
  641. TNODE
  642. ****************************************************************************}
  643. constructor tnode.create(t:tnodetype);
  644. begin
  645. inherited create;
  646. nodetype:=t;
  647. blocktype:=block_type;
  648. { updated by firstpass }
  649. expectloc:=LOC_INVALID;
  650. { updated by secondpass }
  651. location.loc:=LOC_INVALID;
  652. { save local info }
  653. fileinfo:=current_filepos;
  654. localswitches:=current_settings.localswitches;
  655. verbosity:=status.verbosity;
  656. resultdef:=nil;
  657. flags:=[];
  658. end;
  659. constructor tnode.createforcopy;
  660. begin
  661. end;
  662. constructor tnode.ppuload(t:tnodetype;ppufile:tcompilerppufile);
  663. begin
  664. nodetype:=t;
  665. { tnode fields }
  666. blocktype:=tblock_type(ppufile.getbyte);
  667. ppufile.getposinfo(fileinfo);
  668. ppufile.getset(tppuset5(localswitches));
  669. verbosity:=ppufile.getlongint;
  670. ppufile.getderef(resultdefderef);
  671. ppufile.getset(tppuset4(flags));
  672. { updated by firstpass }
  673. expectloc:=LOC_INVALID;
  674. { updated by secondpass }
  675. location.loc:=LOC_INVALID;
  676. end;
  677. procedure tnode.ppuwrite(ppufile:tcompilerppufile);
  678. begin
  679. ppufile.putbyte(byte(block_type));
  680. ppufile.putposinfo(fileinfo);
  681. ppufile.putset(tppuset5(localswitches));
  682. ppufile.putlongint(verbosity);
  683. ppufile.putderef(resultdefderef);
  684. ppufile.putset(tppuset4(flags));
  685. end;
  686. function tnode.getppuidx:longint;
  687. begin
  688. if fppuidx=0 then
  689. begin
  690. inc(nodeppuidx);
  691. fppuidx:=nodeppuidx;
  692. end;
  693. result:=fppuidx;
  694. end;
  695. procedure tnode.resolveppuidx;
  696. begin
  697. end;
  698. procedure tnode.buildderefimpl;
  699. begin
  700. resultdefderef.build(resultdef);
  701. end;
  702. procedure tnode.derefimpl;
  703. begin
  704. resultdef:=tdef(resultdefderef.resolve);
  705. end;
  706. procedure tnode.toggleflag(f : tnodeflag);
  707. begin
  708. if f in flags then
  709. exclude(flags,f)
  710. else
  711. include(flags,f);
  712. end;
  713. function tnode.simplify(forinline : boolean) : tnode;
  714. begin
  715. result:=nil;
  716. end;
  717. destructor tnode.destroy;
  718. begin
  719. if assigned(optinfo) then
  720. dispose(optinfo);
  721. end;
  722. function tnode.ischild(p : tnode) : boolean;
  723. begin
  724. ischild:=false;
  725. end;
  726. procedure tnode.mark_write;
  727. begin
  728. {$ifdef EXTDEBUG}
  729. Comment(V_Warning,'mark_write not implemented for '+nodetype2str[nodetype]);
  730. {$endif EXTDEBUG}
  731. end;
  732. procedure tnode.printnodeinfo(var t:text);
  733. var
  734. i : tnodeflag;
  735. first : boolean;
  736. begin
  737. write(t,nodetype2str[nodetype]);
  738. if assigned(resultdef) then
  739. write(t,', resultdef = ',resultdef.typesymbolprettyname,' = "',resultdef.GetTypeName,'"')
  740. else
  741. write(t,', resultdef = <nil>');
  742. write(t,', pos = (',fileinfo.line,',',fileinfo.column,')',
  743. ', loc = ',tcgloc2str[location.loc],
  744. ', expectloc = ',tcgloc2str[expectloc],
  745. ', flags = [');
  746. first:=true;
  747. for i:=low(tnodeflag) to high(tnodeflag) do
  748. if i in flags then
  749. begin
  750. if not(first) then
  751. write(t,',')
  752. else
  753. first:=false;
  754. write(t, i);
  755. end;
  756. write(t,']');
  757. if (nf_pass1_done in flags) then
  758. write(t,', cmplx = ',node_complexity(self));
  759. if assigned(optinfo) then
  760. write(t,', optinfo = ',HexStr(optinfo));
  761. end;
  762. procedure tnode.printnodedata(var t:text);
  763. begin
  764. end;
  765. procedure tnode.printnodetree(var t:text);
  766. begin
  767. write(t,printnodeindention,'(');
  768. printnodeinfo(t);
  769. writeln(t);
  770. printnodeindent;
  771. printnodedata(t);
  772. printnodeunindent;
  773. writeln(t,printnodeindention,')');
  774. end;
  775. {$ifdef DEBUG_NODE_XML}
  776. { For writing nodes to XML files - do not call directly, but
  777. instead call XMLPrintNode to write a complete tree }
  778. procedure tnode.XMLPrintNodeInfo(var T: Text);
  779. var
  780. i: TNodeFlag;
  781. first: Boolean;
  782. begin
  783. if Assigned(resultdef) then
  784. Write(T,' resultdef="', SanitiseXMLString(resultdef.typesymbolprettyname), '"');
  785. Write(T,' pos="',fileinfo.line,',',fileinfo.column);
  786. First := True;
  787. for i := Low(TNodeFlag) to High(TNodeFlag) do
  788. if i in flags then
  789. begin
  790. if First then
  791. begin
  792. Write(T, '" flags="', i);
  793. First := False;
  794. end
  795. else
  796. Write(T, ',', i)
  797. end;
  798. write(t,'"');
  799. if (nf_pass1_done in flags) then
  800. write(t,' complexity="',node_complexity(self),'"');
  801. end;
  802. procedure tnode.XMLPrintNodeData(var T: Text);
  803. begin
  804. { Nothing by default }
  805. end;
  806. procedure tnode.XMLPrintNodeTree(var T: Text);
  807. begin
  808. Write(T, PrintNodeIndention, '<', nodetype2str[nodetype]);
  809. XMLPrintNodeInfo(T);
  810. WriteLn(T, '>');
  811. PrintNodeIndent;
  812. XMLPrintNodeData(T);
  813. PrintNodeUnindent;
  814. WriteLn(T, PrintNodeIndention, '</', nodetype2str[nodetype], '>');
  815. end;
  816. {$endif DEBUG_NODE_XML}
  817. function tnode.isequal(p : tnode) : boolean;
  818. begin
  819. isequal:=
  820. (not assigned(self) and not assigned(p)) or
  821. (assigned(self) and assigned(p) and
  822. { optimized subclasses have the same nodetype as their }
  823. { superclass (for compatibility), so also check the classtype (JM) }
  824. (p.classtype=classtype) and
  825. (p.nodetype=nodetype) and
  826. (flags*flagsequal=p.flags*flagsequal) and
  827. docompare(p));
  828. end;
  829. {$ifdef state_tracking}
  830. function Tnode.track_state_pass(exec_known:boolean):boolean;
  831. begin
  832. track_state_pass:=false;
  833. end;
  834. {$endif state_tracking}
  835. function tnode.docompare(p : tnode) : boolean;
  836. begin
  837. docompare:=true;
  838. end;
  839. function cleanupcopiedto(var n : tnode;arg : pointer) : foreachnoderesult;
  840. begin
  841. result:=fen_true;
  842. if n.nodetype=labeln then
  843. tlabelnode(n).copiedto:=nil;
  844. end;
  845. function setuplabelnode(var n : tnode;arg : pointer) : foreachnoderesult;
  846. begin
  847. result:=fen_true;
  848. if (n.nodetype=goton) and assigned(tgotonode(n).labelnode) and
  849. assigned(tgotonode(n).labelnode.copiedto) then
  850. tgotonode(n).labelnode:=tgotonode(n).labelnode.copiedto;
  851. end;
  852. function tnode.getcopy : tnode;
  853. begin
  854. result:=dogetcopy;
  855. foreachnodestatic(pm_postprocess,result,@setuplabelnode,nil);
  856. foreachnodestatic(pm_postprocess,self,@cleanupcopiedto,nil);
  857. end;
  858. function tnode.dogetcopy : tnode;
  859. var
  860. p : tnode;
  861. begin
  862. { this is quite tricky because we need a node of the current }
  863. { node type and not one of tnode! }
  864. p:=tnodeclass(classtype).createforcopy;
  865. p.nodetype:=nodetype;
  866. p.expectloc:=expectloc;
  867. p.location:=location;
  868. p.flags:=flags;
  869. p.resultdef:=resultdef;
  870. p.fileinfo:=fileinfo;
  871. p.localswitches:=localswitches;
  872. p.verbosity:=verbosity;
  873. { p.list:=list; }
  874. result:=p;
  875. end;
  876. procedure tnode.insertintolist(l : tnodelist);
  877. begin
  878. end;
  879. { ensures that the optimizer info record is allocated }
  880. function tnode.allocoptinfo : poptinfo;inline;
  881. begin
  882. if not(assigned(optinfo)) then
  883. begin
  884. new(optinfo);
  885. fillchar(optinfo^,sizeof(optinfo^),0);
  886. end;
  887. result:=optinfo;
  888. end;
  889. {****************************************************************************
  890. TUNARYNODE
  891. ****************************************************************************}
  892. constructor tunarynode.create(t:tnodetype;l : tnode);
  893. begin
  894. inherited create(t);
  895. { transfer generic paramater flag }
  896. if assigned(l) and (nf_generic_para in l.flags) then
  897. include(flags,nf_generic_para);
  898. left:=l;
  899. end;
  900. constructor tunarynode.ppuload(t:tnodetype;ppufile:tcompilerppufile);
  901. begin
  902. inherited ppuload(t,ppufile);
  903. left:=ppuloadnode(ppufile);
  904. end;
  905. destructor tunarynode.destroy;
  906. begin
  907. left.free;
  908. inherited destroy;
  909. end;
  910. procedure tunarynode.ppuwrite(ppufile:tcompilerppufile);
  911. begin
  912. inherited ppuwrite(ppufile);
  913. ppuwritenode(ppufile,left);
  914. end;
  915. procedure tunarynode.buildderefimpl;
  916. begin
  917. inherited buildderefimpl;
  918. if assigned(left) then
  919. left.buildderefimpl;
  920. end;
  921. procedure tunarynode.derefimpl;
  922. begin
  923. inherited derefimpl;
  924. if assigned(left) then
  925. left.derefimpl;
  926. end;
  927. function tunarynode.docompare(p : tnode) : boolean;
  928. begin
  929. docompare:=(inherited docompare(p) and
  930. ((left=nil) or left.isequal(tunarynode(p).left))
  931. );
  932. end;
  933. function tunarynode.dogetcopy : tnode;
  934. var
  935. p : tunarynode;
  936. begin
  937. p:=tunarynode(inherited dogetcopy);
  938. if assigned(left) then
  939. p.left:=left.dogetcopy
  940. else
  941. p.left:=nil;
  942. result:=p;
  943. end;
  944. procedure tunarynode.insertintolist(l : tnodelist);
  945. begin
  946. end;
  947. procedure tunarynode.printnodedata(var t:text);
  948. begin
  949. inherited printnodedata(t);
  950. printnode(t,left);
  951. end;
  952. {$ifdef DEBUG_NODE_XML}
  953. procedure TUnaryNode.XMLPrintNodeData(var T: Text);
  954. begin
  955. inherited XMLPrintNodeData(T);
  956. XMLPrintNode(T, Left);
  957. end;
  958. {$endif DEBUG_NODE_XML}
  959. function tunarynode.ischild(p : tnode) : boolean;
  960. begin
  961. ischild:=p=left;
  962. end;
  963. { Marks the current node for deletion and sets 'left' to nil.
  964. Returns what 'left' was previously set to }
  965. function tunarynode.PruneKeepLeft: TNode; {$IFDEF USEINLINE}inline;{$endif USEINLINE}
  966. begin
  967. Result := left;
  968. left := nil;
  969. Include(flags, nf_do_not_execute);
  970. end;
  971. {****************************************************************************
  972. TBINARYNODE
  973. ****************************************************************************}
  974. constructor tbinarynode.create(t:tnodetype;l,r : tnode);
  975. begin
  976. inherited create(t,l);
  977. { transfer generic paramater flag }
  978. if assigned(r) and (nf_generic_para in r.flags) then
  979. include(flags,nf_generic_para);
  980. right:=r;
  981. end;
  982. constructor tbinarynode.ppuload(t:tnodetype;ppufile:tcompilerppufile);
  983. begin
  984. inherited ppuload(t,ppufile);
  985. right:=ppuloadnode(ppufile);
  986. end;
  987. destructor tbinarynode.destroy;
  988. begin
  989. right.free;
  990. inherited destroy;
  991. end;
  992. procedure tbinarynode.ppuwrite(ppufile:tcompilerppufile);
  993. begin
  994. inherited ppuwrite(ppufile);
  995. ppuwritenode(ppufile,right);
  996. end;
  997. procedure tbinarynode.buildderefimpl;
  998. begin
  999. inherited buildderefimpl;
  1000. if assigned(right) then
  1001. right.buildderefimpl;
  1002. end;
  1003. procedure tbinarynode.derefimpl;
  1004. begin
  1005. inherited derefimpl;
  1006. if assigned(right) then
  1007. right.derefimpl;
  1008. end;
  1009. function tbinarynode.ischild(p : tnode) : boolean;
  1010. begin
  1011. ischild:=(p=right);
  1012. end;
  1013. function tbinarynode.docompare(p : tnode) : boolean;
  1014. begin
  1015. docompare:=(inherited docompare(p) and
  1016. ((right=nil) or right.isequal(tbinarynode(p).right))
  1017. );
  1018. end;
  1019. function tbinarynode.dogetcopy : tnode;
  1020. var
  1021. p : tbinarynode;
  1022. begin
  1023. p:=tbinarynode(inherited dogetcopy);
  1024. if assigned(right) then
  1025. p.right:=right.dogetcopy
  1026. else
  1027. p.right:=nil;
  1028. result:=p;
  1029. end;
  1030. procedure tbinarynode.insertintolist(l : tnodelist);
  1031. begin
  1032. end;
  1033. procedure tbinarynode.swapleftright;
  1034. var
  1035. swapp : tnode;
  1036. begin
  1037. swapp:=right;
  1038. right:=left;
  1039. left:=swapp;
  1040. if nf_swapped in flags then
  1041. exclude(flags,nf_swapped)
  1042. else
  1043. include(flags,nf_swapped);
  1044. end;
  1045. procedure tbinarynode.printnodedata(var t:text);
  1046. begin
  1047. inherited printnodedata(t);
  1048. printnode(t,right);
  1049. end;
  1050. {$ifdef DEBUG_NODE_XML}
  1051. procedure TBinaryNode.XMLPrintNodeTree(var T: Text);
  1052. begin
  1053. Write(T, PrintNodeIndention, '<', nodetype2str[nodetype]);
  1054. XMLPrintNodeInfo(T);
  1055. WriteLn(T, '>');
  1056. PrintNodeIndent;
  1057. XMLPrintNodeData(T);
  1058. end;
  1059. procedure TBinaryNode.XMLPrintNodeData(var T: Text);
  1060. begin
  1061. inherited XMLPrintNodeData(T);
  1062. PrintNodeUnindent;
  1063. WriteLn(T, PrintNodeIndention, '</', nodetype2str[nodetype], '>');
  1064. { Right nodes are on the same indentation level }
  1065. XMLPrintNode(T, Right);
  1066. end;
  1067. {$endif DEBUG_NODE_XML}
  1068. procedure tbinarynode.printnodelist(var t:text);
  1069. var
  1070. hp : tbinarynode;
  1071. begin
  1072. hp:=self;
  1073. while assigned(hp) do
  1074. begin
  1075. write(t,printnodeindention,'(');
  1076. printnodeindent;
  1077. hp.printnodeinfo(t);
  1078. writeln(t);
  1079. printnode(t,hp.left);
  1080. writeln(t);
  1081. printnodeunindent;
  1082. writeln(t,printnodeindention,')');
  1083. hp:=tbinarynode(hp.right);
  1084. end;
  1085. end;
  1086. { Marks the current node for deletion and sets 'right' to nil.
  1087. Returns what 'right' was previously set to }
  1088. function tbinarynode.PruneKeepRight: TNode; {$IFDEF USEINLINE}inline;{$endif USEINLINE}
  1089. begin
  1090. Result := right;
  1091. right := nil;
  1092. Include(flags, nf_do_not_execute);
  1093. end;
  1094. {****************************************************************************
  1095. TTERTIARYNODE
  1096. ****************************************************************************}
  1097. constructor ttertiarynode.create(_t:tnodetype;l,r,t : tnode);
  1098. begin
  1099. inherited create(_t,l,r);
  1100. { transfer generic parameter flag }
  1101. if assigned(t) and (nf_generic_para in t.flags) then
  1102. include(flags,nf_generic_para);
  1103. third:=t;
  1104. end;
  1105. constructor ttertiarynode.ppuload(t:tnodetype;ppufile:tcompilerppufile);
  1106. begin
  1107. inherited ppuload(t,ppufile);
  1108. third:=ppuloadnode(ppufile);
  1109. end;
  1110. destructor ttertiarynode.destroy;
  1111. begin
  1112. third.free;
  1113. inherited destroy;
  1114. end;
  1115. procedure ttertiarynode.ppuwrite(ppufile:tcompilerppufile);
  1116. begin
  1117. inherited ppuwrite(ppufile);
  1118. ppuwritenode(ppufile,third);
  1119. end;
  1120. procedure ttertiarynode.buildderefimpl;
  1121. begin
  1122. inherited buildderefimpl;
  1123. if assigned(third) then
  1124. third.buildderefimpl;
  1125. end;
  1126. procedure ttertiarynode.derefimpl;
  1127. begin
  1128. inherited derefimpl;
  1129. if assigned(third) then
  1130. third.derefimpl;
  1131. end;
  1132. function ttertiarynode.docompare(p : tnode) : boolean;
  1133. begin
  1134. docompare:=(inherited docompare(p) and
  1135. ((third=nil) or third.isequal(ttertiarynode(p).third))
  1136. );
  1137. end;
  1138. function ttertiarynode.dogetcopy : tnode;
  1139. var
  1140. p : ttertiarynode;
  1141. begin
  1142. p:=ttertiarynode(inherited dogetcopy);
  1143. if assigned(third) then
  1144. p.third:=third.dogetcopy
  1145. else
  1146. p.third:=nil;
  1147. result:=p;
  1148. end;
  1149. procedure ttertiarynode.insertintolist(l : tnodelist);
  1150. begin
  1151. end;
  1152. procedure ttertiarynode.printnodedata(var t:text);
  1153. begin
  1154. inherited printnodedata(t);
  1155. printnode(t,third);
  1156. end;
  1157. {$ifdef DEBUG_NODE_XML}
  1158. procedure TTertiaryNode.XMLPrintNodeData(var T: Text);
  1159. begin
  1160. if Assigned(Third) then
  1161. begin
  1162. WriteLn(T, PrintNodeIndention, '<third-branch>');
  1163. PrintNodeIndent;
  1164. XMLPrintNode(T, Third);
  1165. PrintNodeUnindent;
  1166. WriteLn(T, PrintNodeIndention, '</third-branch>');
  1167. end;
  1168. inherited XMLPrintNodeData(T);
  1169. end;
  1170. {$endif DEBUG_NODE_XML}
  1171. function ttertiarynode.ischild(p : tnode) : boolean;
  1172. begin
  1173. ischild:=p=third;
  1174. end;
  1175. { Marks the current node for deletion and sets 'third' to nil.
  1176. Returns what 'third' was previously set to }
  1177. function ttertiarynode.PruneKeepThird: TNode; {$IFDEF USEINLINE}inline;{$endif USEINLINE}
  1178. begin
  1179. Result := third;
  1180. third := nil;
  1181. Include(flags, nf_do_not_execute);
  1182. end;
  1183. {****************************************************************************
  1184. TBINOPNODE
  1185. ****************************************************************************}
  1186. constructor tbinopnode.create(t:tnodetype;l,r : tnode);
  1187. begin
  1188. inherited create(t,l,r);
  1189. end;
  1190. function tbinopnode.docompare(p : tnode) : boolean;
  1191. begin
  1192. docompare:=(inherited docompare(p)) or
  1193. { if that's in the flags, is p then always a tbinopnode (?) (JM) }
  1194. ((nf_swapable in flags) and
  1195. left.isequal(tbinopnode(p).right) and
  1196. right.isequal(tbinopnode(p).left));
  1197. end;
  1198. {$ifdef DEBUG_NODE_XML}
  1199. procedure TBinOpNode.XMLPrintNodeData(var T: Text);
  1200. begin
  1201. { For binary operations, put the left and right branches on the same level for clarity }
  1202. XMLPrintNode(T, Left);
  1203. XMLPrintNode(T, Right);
  1204. PrintNodeUnindent;
  1205. WriteLn(T, PrintNodeIndention, '</', nodetype2str[nodetype], '>');
  1206. end;
  1207. {$endif DEBUG_NODE_XML}
  1208. begin
  1209. {$push}{$warnings off}
  1210. { tvaroption must fit into a 4 byte set for speed reasons }
  1211. if ord(high(tvaroption))>31 then
  1212. internalerror(201110301);
  1213. (* { tnodeflags must fit into a 4 byte set for speed reasons }
  1214. if ord(high(tnodeflags))>31 then
  1215. internalerror(2014020701); *)
  1216. {$pop}
  1217. end.