node.pas 43 KB

12345678910111213141516171819202122232425262728293031323334353637383940414243444546474849505152535455565758596061626364656667686970717273747576777879808182838485868788899091929394959697989910010110210310410510610710810911011111211311411511611711811912012112212312412512612712812913013113213313413513613713813914014114214314414514614714814915015115215315415515615715815916016116216316416516616716816917017117217317417517617717817918018118218318418518618718818919019119219319419519619719819920020120220320420520620720820921021121221321421521621721821922022122222322422522622722822923023123223323423523623723823924024124224324424524624724824925025125225325425525625725825926026126226326426526626726826927027127227327427527627727827928028128228328428528628728828929029129229329429529629729829930030130230330430530630730830931031131231331431531631731831932032132232332432532632732832933033133233333433533633733833934034134234334434534634734834935035135235335435535635735835936036136236336436536636736836937037137237337437537637737837938038138238338438538638738838939039139239339439539639739839940040140240340440540640740840941041141241341441541641741841942042142242342442542642742842943043143243343443543643743843944044144244344444544644744844945045145245345445545645745845946046146246346446546646746846947047147247347447547647747847948048148248348448548648748848949049149249349449549649749849950050150250350450550650750850951051151251351451551651751851952052152252352452552652752852953053153253353453553653753853954054154254354454554654754854955055155255355455555655755855956056156256356456556656756856957057157257357457557657757857958058158258358458558658758858959059159259359459559659759859960060160260360460560660760860961061161261361461561661761861962062162262362462562662762862963063163263363463563663763863964064164264364464564664764864965065165265365465565665765865966066166266366466566666766866967067167267367467567667767867968068168268368468568668768868969069169269369469569669769869970070170270370470570670770870971071171271371471571671771871972072172272372472572672772872973073173273373473573673773873974074174274374474574674774874975075175275375475575675775875976076176276376476576676776876977077177277377477577677777877978078178278378478578678778878979079179279379479579679779879980080180280380480580680780880981081181281381481581681781881982082182282382482582682782882983083183283383483583683783883984084184284384484584684784884985085185285385485585685785885986086186286386486586686786886987087187287387487587687787887988088188288388488588688788888989089189289389489589689789889990090190290390490590690790890991091191291391491591691791891992092192292392492592692792892993093193293393493593693793893994094194294394494594694794894995095195295395495595695795895996096196296396496596696796896997097197297397497597697797897998098198298398498598698798898999099199299399499599699799899910001001100210031004100510061007100810091010101110121013101410151016101710181019102010211022102310241025102610271028102910301031103210331034103510361037103810391040104110421043104410451046104710481049105010511052105310541055105610571058105910601061106210631064106510661067106810691070107110721073107410751076107710781079108010811082108310841085108610871088108910901091109210931094109510961097109810991100110111021103110411051106110711081109111011111112111311141115111611171118111911201121112211231124112511261127112811291130113111321133113411351136113711381139114011411142114311441145114611471148114911501151115211531154115511561157115811591160116111621163116411651166116711681169117011711172117311741175117611771178117911801181118211831184118511861187118811891190119111921193119411951196119711981199120012011202120312041205120612071208120912101211121212131214121512161217121812191220122112221223122412251226122712281229123012311232123312341235123612371238123912401241124212431244124512461247124812491250125112521253125412551256125712581259126012611262126312641265126612671268126912701271127212731274127512761277127812791280128112821283128412851286128712881289129012911292129312941295129612971298129913001301130213031304130513061307130813091310131113121313131413151316131713181319132013211322132313241325132613271328132913301331133213331334133513361337133813391340134113421343134413451346134713481349135013511352135313541355135613571358135913601361136213631364136513661367136813691370137113721373137413751376137713781379138013811382138313841385138613871388138913901391139213931394139513961397139813991400140114021403140414051406140714081409141014111412141314141415141614171418141914201421142214231424142514261427142814291430143114321433143414351436143714381439144014411442144314441445144614471448144914501451145214531454145514561457145814591460146114621463146414651466146714681469147014711472
  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 }
  218. nf_usercode_entry,
  219. { tderefnode }
  220. nf_no_checkpointer,
  221. { tvecnode }
  222. nf_memindex,
  223. nf_memseg,
  224. nf_callunique,
  225. { tloadnode/ttypeconvnode }
  226. nf_absolute,
  227. { taddnode }
  228. { if the result type of a node is currency, then this flag denotes, that the value is already mulitplied by 10000 }
  229. nf_is_currency,
  230. nf_has_pointerdiv,
  231. { the node shall be short boolean evaluated, this flag has priority over localswitches }
  232. nf_short_bool,
  233. { tmoddivnode }
  234. nf_isomod,
  235. { tassignmentnode }
  236. nf_assign_done_in_right,
  237. { tarrayconstructnode }
  238. nf_forcevaria,
  239. nf_novariaallowed,
  240. { ttypeconvnode, and the first one also treal/ord/pointerconstn }
  241. { second one also for subtractions of u32-u32 implicitly upcasted to s64 }
  242. { last one also used on addnode to inhibit procvar calling }
  243. nf_explicit,
  244. nf_internal, { no warnings/hints generated }
  245. nf_load_procvar,
  246. { tinlinenode }
  247. nf_inlineconst,
  248. { tasmnode }
  249. nf_get_asm_position,
  250. { tblocknode }
  251. nf_block_with_exit,
  252. { tloadvmtaddrnode }
  253. nf_ignore_for_wpo, { we know that this loadvmtaddrnode cannot be used to construct a class instance }
  254. { node is derived from generic parameter }
  255. nf_generic_para
  256. { WARNING: there are now 32 elements in this type, and a set of this
  257. type is written to the PPU. So before adding more elements,
  258. either move some flags to specific nodes, or stream a normalset
  259. to the ppu
  260. }
  261. );
  262. tnodeflags = set of tnodeflag;
  263. const
  264. { contains the flags which must be equal for the equality }
  265. { of nodes }
  266. flagsequal : tnodeflags = [nf_error];
  267. type
  268. tnodelist = class
  269. end;
  270. pnode = ^tnode;
  271. { basic class for the intermediated representation fpc uses }
  272. tnode = class
  273. private
  274. fppuidx : longint;
  275. function getppuidx:longint;
  276. public
  277. { type of this node }
  278. nodetype : tnodetype;
  279. { type of the current code block, general/const/type }
  280. blocktype : tblock_type;
  281. { expected location of the result of this node (pass1) }
  282. expectloc : tcgloc;
  283. { the location of the result of this node (pass2) }
  284. location : tlocation;
  285. { the parent node of this is node }
  286. { this field is set by concattolist }
  287. parent : tnode;
  288. { next node in control flow on the same block level, i.e.
  289. for loop nodes, this is the next node after the end of the loop,
  290. same for if and case, if this field is nil, the next node is the procedure exit,
  291. for the last node in a loop this is set to the loop header
  292. this field is set only for control flow nodes }
  293. successor : tnode;
  294. { there are some properties about the node stored }
  295. flags : tnodeflags;
  296. resultdef : tdef;
  297. resultdefderef : tderef;
  298. fileinfo : tfileposinfo;
  299. localswitches : tlocalswitches;
  300. verbosity : longint;
  301. optinfo : poptinfo;
  302. constructor create(t:tnodetype);
  303. { this constructor is only for creating copies of class }
  304. { the fields are copied by getcopy }
  305. constructor createforcopy;
  306. constructor ppuload(t:tnodetype;ppufile:tcompilerppufile);virtual;
  307. destructor destroy;override;
  308. procedure ppuwrite(ppufile:tcompilerppufile);virtual;
  309. procedure buildderefimpl;virtual;
  310. procedure derefimpl;virtual;
  311. procedure resolveppuidx;virtual;
  312. { toggles the flag }
  313. procedure toggleflag(f : tnodeflag);
  314. { the 1.1 code generator may override pass_1 }
  315. { and it need not to implement det_* then }
  316. { 1.1: pass_1 returns a value<>0 if the node has been transformed }
  317. { 2.0: runs pass_typecheck and det_temp }
  318. function pass_1 : tnode;virtual;abstract;
  319. { dermines the resultdef of the node }
  320. function pass_typecheck : tnode;virtual;abstract;
  321. { tries to simplify the node, returns a value <>nil if a simplified
  322. node has been created }
  323. function simplify(forinline : boolean) : tnode;virtual;
  324. {$ifdef state_tracking}
  325. { Does optimizations by keeping track of the variable states
  326. in a procedure }
  327. function track_state_pass(exec_known:boolean):boolean;virtual;
  328. {$endif}
  329. { For a t1:=t2 tree, mark the part of the tree t1 that gets
  330. written to (normally the loadnode) as write access. }
  331. procedure mark_write;virtual;
  332. { dermines the number of necessary temp. locations to evaluate
  333. the node }
  334. procedure det_temp;virtual;abstract;
  335. procedure pass_generate_code;virtual;abstract;
  336. { comparing of nodes }
  337. function isequal(p : tnode) : boolean;
  338. { to implement comparisation, override this method }
  339. function docompare(p : tnode) : boolean;virtual;
  340. { wrapper for getcopy }
  341. function getcopy : tnode;
  342. { does the real copying of a node }
  343. function dogetcopy : tnode;virtual;
  344. procedure insertintolist(l : tnodelist);virtual;
  345. { writes a node for debugging purpose, shouldn't be called }
  346. { direct, because there is no test for nil, use printnode }
  347. { to write a complete tree }
  348. procedure printnodeinfo(var t:text);virtual;
  349. procedure printnodedata(var t:text);virtual;
  350. procedure printnodetree(var t:text);virtual;
  351. {$ifdef DEBUG_NODE_XML}
  352. { For writing nodes to XML files - do not call directly, but
  353. instead call XMLPrintNode to write a complete tree }
  354. procedure XMLPrintNodeInfo(var T: Text); dynamic;
  355. procedure XMLPrintNodeData(var T: Text); virtual;
  356. procedure XMLPrintNodeTree(var T: Text); virtual;
  357. {$endif DEBUG_NODE_XML}
  358. procedure concattolist(l : tlinkedlist);virtual;
  359. function ischild(p : tnode) : boolean;virtual;
  360. { ensures that the optimizer info record is allocated }
  361. function allocoptinfo : poptinfo;inline;
  362. property ppuidx:longint read getppuidx;
  363. end;
  364. tnodeclass = class of tnode;
  365. tnodeclassarray = array[tnodetype] of tnodeclass;
  366. { this node is the anchestor for all nodes with at least }
  367. { one child, you have to use it if you want to use }
  368. { true- and current_procinfo.CurrFalseLabel }
  369. //punarynode = ^tunarynode;
  370. tunarynode = class(tnode)
  371. left : tnode;
  372. constructor create(t:tnodetype;l : tnode);
  373. constructor ppuload(t:tnodetype;ppufile:tcompilerppufile);override;
  374. destructor destroy;override;
  375. procedure ppuwrite(ppufile:tcompilerppufile);override;
  376. procedure buildderefimpl;override;
  377. procedure derefimpl;override;
  378. procedure concattolist(l : tlinkedlist);override;
  379. function ischild(p : tnode) : boolean;override;
  380. function docompare(p : tnode) : boolean;override;
  381. function dogetcopy : tnode;override;
  382. procedure insertintolist(l : tnodelist);override;
  383. procedure printnodedata(var t:text);override;
  384. {$ifdef DEBUG_NODE_XML}
  385. procedure XMLPrintNodeData(var T: Text); override;
  386. {$endif DEBUG_NODE_XML}
  387. end;
  388. //pbinarynode = ^tbinarynode;
  389. tbinarynode = class(tunarynode)
  390. right : tnode;
  391. constructor create(t:tnodetype;l,r : tnode);
  392. constructor ppuload(t:tnodetype;ppufile:tcompilerppufile);override;
  393. destructor destroy;override;
  394. procedure ppuwrite(ppufile:tcompilerppufile);override;
  395. procedure buildderefimpl;override;
  396. procedure derefimpl;override;
  397. procedure concattolist(l : tlinkedlist);override;
  398. function ischild(p : tnode) : boolean;override;
  399. function docompare(p : tnode) : boolean;override;
  400. procedure swapleftright;
  401. function dogetcopy : tnode;override;
  402. procedure insertintolist(l : tnodelist);override;
  403. procedure printnodedata(var t:text);override;
  404. {$ifdef DEBUG_NODE_XML}
  405. procedure XMLPrintNodeTree(var T: Text); override;
  406. procedure XMLPrintNodeData(var T: Text); override;
  407. {$endif DEBUG_NODE_XML}
  408. procedure printnodelist(var t:text);
  409. end;
  410. //ptertiarynode = ^ttertiarynode;
  411. ttertiarynode = class(tbinarynode)
  412. third : tnode;
  413. constructor create(_t:tnodetype;l,r,t : tnode);
  414. constructor ppuload(t:tnodetype;ppufile:tcompilerppufile);override;
  415. destructor destroy;override;
  416. procedure ppuwrite(ppufile:tcompilerppufile);override;
  417. procedure buildderefimpl;override;
  418. procedure derefimpl;override;
  419. procedure concattolist(l : tlinkedlist);override;
  420. function ischild(p : tnode) : boolean;override;
  421. function docompare(p : tnode) : boolean;override;
  422. function dogetcopy : tnode;override;
  423. procedure insertintolist(l : tnodelist);override;
  424. procedure printnodedata(var t:text);override;
  425. {$ifdef DEBUG_NODE_XML}
  426. procedure XMLPrintNodeData(var T: Text); override;
  427. {$endif DEBUG_NODE_XML}
  428. end;
  429. tbinopnode = class(tbinarynode)
  430. constructor create(t:tnodetype;l,r : tnode);virtual;
  431. function docompare(p : tnode) : boolean;override;
  432. {$ifdef DEBUG_NODE_XML}
  433. procedure XMLPrintNodeData(var T: Text); override;
  434. {$endif DEBUG_NODE_XML}
  435. end;
  436. var
  437. { array with all class types for tnodes }
  438. nodeclass : tnodeclassarray;
  439. function nodeppuidxget(i:longint):tnode;
  440. function ppuloadnode(ppufile:tcompilerppufile):tnode;
  441. procedure ppuwritenode(ppufile:tcompilerppufile;n:tnode);
  442. function ppuloadnodetree(ppufile:tcompilerppufile):tnode;
  443. procedure ppuwritenodetree(ppufile:tcompilerppufile;n:tnode);
  444. procedure printnode(var t:text;n:tnode);
  445. procedure printnode(n:tnode);
  446. {$ifdef DEBUG_NODE_XML}
  447. procedure XMLPrintNode(var T: Text; N: TNode);
  448. {$endif DEBUG_NODE_XML}
  449. function is_constnode(p : tnode) : boolean;
  450. function is_constintnode(p : tnode) : boolean;
  451. function is_constcharnode(p : tnode) : boolean;
  452. function is_constrealnode(p : tnode) : boolean;
  453. function is_constboolnode(p : tnode) : boolean;
  454. function is_constenumnode(p : tnode) : boolean;
  455. function is_constwidecharnode(p : tnode) : boolean;
  456. function is_constpointernode(p : tnode) : boolean;
  457. function is_conststringnode(p : tnode) : boolean;
  458. function is_constwidestringnode(p : tnode) : boolean;
  459. function is_conststring_or_constcharnode(p : tnode) : boolean;
  460. implementation
  461. uses
  462. verbose,entfile,comphook,
  463. {$ifdef DEBUG_NODE_XML}
  464. cutils,
  465. {$endif DEBUG_NODE_XML}
  466. ppu,
  467. symconst,
  468. nutils,nflw,
  469. defutil;
  470. const
  471. ppunodemarker = 255;
  472. {****************************************************************************
  473. Helpers
  474. ****************************************************************************}
  475. var
  476. nodeppulist : TFPObjectList;
  477. nodeppuidx : longint;
  478. procedure nodeppuidxcreate;
  479. begin
  480. nodeppulist:=TFPObjectList.Create(false);
  481. nodeppuidx:=0;
  482. end;
  483. procedure nodeppuidxresolve;
  484. var
  485. i : longint;
  486. n : tnode;
  487. begin
  488. for i:=0 to nodeppulist.count-1 do
  489. begin
  490. n:=tnode(nodeppulist[i]);
  491. if assigned(n) then
  492. n.resolveppuidx;
  493. end;
  494. end;
  495. procedure nodeppuidxfree;
  496. begin
  497. nodeppulist.free;
  498. nodeppulist:=nil;
  499. nodeppuidx:=0;
  500. end;
  501. procedure nodeppuidxadd(n:tnode);
  502. var
  503. i : longint;
  504. begin
  505. i:=n.ppuidx;
  506. if i<=0 then
  507. internalerror(200311072);
  508. if i>=nodeppulist.capacity then
  509. nodeppulist.capacity:=((i div 1024)+1)*1024;
  510. if i>=nodeppulist.count then
  511. nodeppulist.count:=i+1;
  512. nodeppulist[i]:=n;
  513. end;
  514. function nodeppuidxget(i:longint):tnode;
  515. begin
  516. if i<=0 then
  517. internalerror(200311073);
  518. result:=tnode(nodeppulist[i]);
  519. end;
  520. function ppuloadnode(ppufile:tcompilerppufile):tnode;
  521. var
  522. b : byte;
  523. t : tnodetype;
  524. hppuidx : longint;
  525. begin
  526. { marker }
  527. b:=ppufile.getbyte;
  528. if b<>ppunodemarker then
  529. internalerror(200208151);
  530. { load nodetype }
  531. t:=tnodetype(ppufile.getbyte);
  532. if t>high(tnodetype) then
  533. internalerror(200208152);
  534. if t<>emptynode then
  535. begin
  536. if not assigned(nodeclass[t]) then
  537. internalerror(200208153);
  538. hppuidx:=ppufile.getlongint;
  539. //writeln('load: ',nodetype2str[t]);
  540. { generate node of the correct class }
  541. result:=nodeclass[t].ppuload(t,ppufile);
  542. result.fppuidx:=hppuidx;
  543. nodeppuidxadd(result);
  544. end
  545. else
  546. result:=nil;
  547. end;
  548. procedure ppuwritenode(ppufile:tcompilerppufile;n:tnode);
  549. begin
  550. { marker, read by ppuloadnode }
  551. ppufile.putbyte(ppunodemarker);
  552. { type, read by ppuloadnode }
  553. if assigned(n) then
  554. begin
  555. ppufile.putbyte(byte(n.nodetype));
  556. ppufile.putlongint(n.ppuidx);
  557. //writeln('write: ',nodetype2str[n.nodetype]);
  558. n.ppuwrite(ppufile);
  559. end
  560. else
  561. ppufile.putbyte(byte(emptynode));
  562. end;
  563. function ppuloadnodetree(ppufile:tcompilerppufile):tnode;
  564. begin
  565. if ppufile.readentry<>ibnodetree then
  566. Message(unit_f_ppu_read_error);
  567. nodeppuidxcreate;
  568. result:=ppuloadnode(ppufile);
  569. nodeppuidxresolve;
  570. nodeppuidxfree;
  571. end;
  572. procedure ppuwritenodetree(ppufile:tcompilerppufile;n:tnode);
  573. begin
  574. nodeppuidxcreate;
  575. ppuwritenode(ppufile,n);
  576. ppufile.writeentry(ibnodetree);
  577. nodeppuidxfree;
  578. end;
  579. procedure printnode(var t:text;n:tnode);
  580. begin
  581. if assigned(n) then
  582. n.printnodetree(t)
  583. else
  584. writeln(t,printnodeindention,'nil');
  585. end;
  586. procedure printnode(n:tnode);
  587. begin
  588. printnode(output,n);
  589. end;
  590. {$ifdef DEBUG_NODE_XML}
  591. procedure XMLPrintNode(var T: Text; N: TNode);
  592. begin
  593. if Assigned(N) then
  594. N.XMLPrintNodeTree(T);
  595. end;
  596. {$endif DEBUG_NODE_XML}
  597. function is_constnode(p : tnode) : boolean;
  598. begin
  599. is_constnode:=(p.nodetype in nodetype_const);
  600. end;
  601. function is_constintnode(p : tnode) : boolean;
  602. begin
  603. is_constintnode:=(p.nodetype=ordconstn) and is_integer(p.resultdef);
  604. end;
  605. function is_constcharnode(p : tnode) : boolean;
  606. begin
  607. is_constcharnode:=(p.nodetype=ordconstn) and is_char(p.resultdef);
  608. end;
  609. function is_constwidecharnode(p : tnode) : boolean;
  610. begin
  611. is_constwidecharnode:=(p.nodetype=ordconstn) and is_widechar(p.resultdef);
  612. end;
  613. function is_constrealnode(p : tnode) : boolean;
  614. begin
  615. is_constrealnode:=(p.nodetype=realconstn);
  616. end;
  617. function is_constboolnode(p : tnode) : boolean;
  618. begin
  619. is_constboolnode:=(p.nodetype=ordconstn) and is_boolean(p.resultdef);
  620. end;
  621. function is_constenumnode(p : tnode) : boolean;
  622. begin
  623. is_constenumnode:=(p.nodetype=ordconstn) and (p.resultdef.typ=enumdef);
  624. end;
  625. function is_constpointernode(p : tnode) : boolean;
  626. begin
  627. is_constpointernode:=(p.nodetype in [pointerconstn,niln]);
  628. end;
  629. function is_conststringnode(p : tnode) : boolean;
  630. begin
  631. is_conststringnode :=
  632. (p.nodetype = stringconstn) and
  633. (is_chararray(p.resultdef) or
  634. is_shortstring(p.resultdef) or
  635. is_ansistring(p.resultdef));
  636. end;
  637. function is_constwidestringnode(p : tnode) : boolean;
  638. begin
  639. is_constwidestringnode :=
  640. (p.nodetype = stringconstn) and
  641. (is_widechararray(p.resultdef) or
  642. is_wide_or_unicode_string(p.resultdef));
  643. end;
  644. function is_conststring_or_constcharnode(p : tnode) : boolean;
  645. begin
  646. is_conststring_or_constcharnode :=
  647. is_conststringnode(p) or is_constcharnode(p) or
  648. is_constwidestringnode(p) or is_constwidecharnode(p);
  649. end;
  650. {****************************************************************************
  651. TNODE
  652. ****************************************************************************}
  653. constructor tnode.create(t:tnodetype);
  654. begin
  655. inherited create;
  656. nodetype:=t;
  657. blocktype:=block_type;
  658. { updated by firstpass }
  659. expectloc:=LOC_INVALID;
  660. { updated by secondpass }
  661. location.loc:=LOC_INVALID;
  662. { save local info }
  663. fileinfo:=current_filepos;
  664. localswitches:=current_settings.localswitches;
  665. verbosity:=status.verbosity;
  666. resultdef:=nil;
  667. flags:=[];
  668. end;
  669. constructor tnode.createforcopy;
  670. begin
  671. end;
  672. constructor tnode.ppuload(t:tnodetype;ppufile:tcompilerppufile);
  673. begin
  674. nodetype:=t;
  675. { tnode fields }
  676. blocktype:=tblock_type(ppufile.getbyte);
  677. ppufile.getposinfo(fileinfo);
  678. ppufile.getset(tppuset5(localswitches));
  679. verbosity:=ppufile.getlongint;
  680. ppufile.getderef(resultdefderef);
  681. ppufile.getset(tppuset4(flags));
  682. { updated by firstpass }
  683. expectloc:=LOC_INVALID;
  684. { updated by secondpass }
  685. location.loc:=LOC_INVALID;
  686. end;
  687. procedure tnode.ppuwrite(ppufile:tcompilerppufile);
  688. begin
  689. ppufile.putbyte(byte(block_type));
  690. ppufile.putposinfo(fileinfo);
  691. ppufile.putset(tppuset5(localswitches));
  692. ppufile.putlongint(verbosity);
  693. ppufile.putderef(resultdefderef);
  694. ppufile.putset(tppuset4(flags));
  695. end;
  696. function tnode.getppuidx:longint;
  697. begin
  698. if fppuidx=0 then
  699. begin
  700. inc(nodeppuidx);
  701. fppuidx:=nodeppuidx;
  702. end;
  703. result:=fppuidx;
  704. end;
  705. procedure tnode.resolveppuidx;
  706. begin
  707. end;
  708. procedure tnode.buildderefimpl;
  709. begin
  710. resultdefderef.build(resultdef);
  711. end;
  712. procedure tnode.derefimpl;
  713. begin
  714. resultdef:=tdef(resultdefderef.resolve);
  715. end;
  716. procedure tnode.toggleflag(f : tnodeflag);
  717. begin
  718. if f in flags then
  719. exclude(flags,f)
  720. else
  721. include(flags,f);
  722. end;
  723. function tnode.simplify(forinline : boolean) : tnode;
  724. begin
  725. result:=nil;
  726. end;
  727. destructor tnode.destroy;
  728. begin
  729. if assigned(optinfo) then
  730. dispose(optinfo);
  731. end;
  732. procedure tnode.concattolist(l : tlinkedlist);
  733. begin
  734. end;
  735. function tnode.ischild(p : tnode) : boolean;
  736. begin
  737. ischild:=false;
  738. end;
  739. procedure tnode.mark_write;
  740. begin
  741. {$ifdef EXTDEBUG}
  742. Comment(V_Warning,'mark_write not implemented for '+nodetype2str[nodetype]);
  743. {$endif EXTDEBUG}
  744. end;
  745. procedure tnode.printnodeinfo(var t:text);
  746. var
  747. i : tnodeflag;
  748. first : boolean;
  749. begin
  750. write(t,nodetype2str[nodetype]);
  751. if assigned(resultdef) then
  752. write(t,', resultdef = ',resultdef.typesymbolprettyname,' = "',resultdef.GetTypeName,'"')
  753. else
  754. write(t,', resultdef = <nil>');
  755. write(t,', pos = (',fileinfo.line,',',fileinfo.column,')',
  756. ', loc = ',tcgloc2str[location.loc],
  757. ', expectloc = ',tcgloc2str[expectloc],
  758. ', flags = [');
  759. first:=true;
  760. for i:=low(tnodeflag) to high(tnodeflag) do
  761. if i in flags then
  762. begin
  763. if not(first) then
  764. write(t,',')
  765. else
  766. first:=false;
  767. write(t, i);
  768. end;
  769. write(t,']');
  770. if (nf_pass1_done in flags) then
  771. write(t,', cmplx = ',node_complexity(self));
  772. end;
  773. procedure tnode.printnodedata(var t:text);
  774. begin
  775. end;
  776. procedure tnode.printnodetree(var t:text);
  777. begin
  778. write(t,printnodeindention,'(');
  779. printnodeinfo(t);
  780. writeln(t);
  781. printnodeindent;
  782. printnodedata(t);
  783. printnodeunindent;
  784. writeln(t,printnodeindention,')');
  785. end;
  786. {$ifdef DEBUG_NODE_XML}
  787. { For writing nodes to XML files - do not call directly, but
  788. instead call XMLPrintNode to write a complete tree }
  789. procedure tnode.XMLPrintNodeInfo(var T: Text);
  790. var
  791. i: TNodeFlag;
  792. first: Boolean;
  793. begin
  794. if Assigned(resultdef) then
  795. Write(T,' resultdef="', SanitiseXMLString(resultdef.typesymbolprettyname), '"');
  796. Write(T,' pos="',fileinfo.line,',',fileinfo.column);
  797. First := True;
  798. for i := Low(TNodeFlag) to High(TNodeFlag) do
  799. if i in flags then
  800. begin
  801. if First then
  802. begin
  803. Write(T, '" flags="', i);
  804. First := False;
  805. end
  806. else
  807. Write(T, ',', i)
  808. end;
  809. if (nf_pass1_done in flags) then
  810. write(t,'" complexity="',node_complexity(self),'"');
  811. end;
  812. procedure tnode.XMLPrintNodeData(var T: Text);
  813. begin
  814. { Nothing by default }
  815. end;
  816. procedure tnode.XMLPrintNodeTree(var T: Text);
  817. begin
  818. Write(T, PrintNodeIndention, '<', nodetype2str[nodetype]);
  819. XMLPrintNodeInfo(T);
  820. WriteLn(T, '>');
  821. PrintNodeIndent;
  822. XMLPrintNodeData(T);
  823. PrintNodeUnindent;
  824. WriteLn(T, PrintNodeIndention, '</', nodetype2str[nodetype], '>');
  825. end;
  826. {$endif DEBUG_NODE_XML}
  827. function tnode.isequal(p : tnode) : boolean;
  828. begin
  829. isequal:=
  830. (not assigned(self) and not assigned(p)) or
  831. (assigned(self) and assigned(p) and
  832. { optimized subclasses have the same nodetype as their }
  833. { superclass (for compatibility), so also check the classtype (JM) }
  834. (p.classtype=classtype) and
  835. (p.nodetype=nodetype) and
  836. (flags*flagsequal=p.flags*flagsequal) and
  837. docompare(p));
  838. end;
  839. {$ifdef state_tracking}
  840. function Tnode.track_state_pass(exec_known:boolean):boolean;
  841. begin
  842. track_state_pass:=false;
  843. end;
  844. {$endif state_tracking}
  845. function tnode.docompare(p : tnode) : boolean;
  846. begin
  847. docompare:=true;
  848. end;
  849. function cleanupcopiedto(var n : tnode;arg : pointer) : foreachnoderesult;
  850. begin
  851. result:=fen_true;
  852. if n.nodetype=labeln then
  853. tlabelnode(n).copiedto:=nil;
  854. end;
  855. function setuplabelnode(var n : tnode;arg : pointer) : foreachnoderesult;
  856. begin
  857. result:=fen_true;
  858. if (n.nodetype=goton) and assigned(tgotonode(n).labelnode) and
  859. assigned(tgotonode(n).labelnode.copiedto) then
  860. tgotonode(n).labelnode:=tgotonode(n).labelnode.copiedto;
  861. end;
  862. function tnode.getcopy : tnode;
  863. begin
  864. result:=dogetcopy;
  865. foreachnodestatic(pm_postprocess,result,@setuplabelnode,nil);
  866. foreachnodestatic(pm_postprocess,self,@cleanupcopiedto,nil);
  867. end;
  868. function tnode.dogetcopy : tnode;
  869. var
  870. p : tnode;
  871. begin
  872. { this is quite tricky because we need a node of the current }
  873. { node type and not one of tnode! }
  874. p:=tnodeclass(classtype).createforcopy;
  875. p.nodetype:=nodetype;
  876. p.expectloc:=expectloc;
  877. p.location:=location;
  878. p.parent:=parent;
  879. p.flags:=flags;
  880. p.resultdef:=resultdef;
  881. p.fileinfo:=fileinfo;
  882. p.localswitches:=localswitches;
  883. p.verbosity:=verbosity;
  884. { p.list:=list; }
  885. result:=p;
  886. end;
  887. procedure tnode.insertintolist(l : tnodelist);
  888. begin
  889. end;
  890. { ensures that the optimizer info record is allocated }
  891. function tnode.allocoptinfo : poptinfo;inline;
  892. begin
  893. if not(assigned(optinfo)) then
  894. begin
  895. new(optinfo);
  896. fillchar(optinfo^,sizeof(optinfo^),0);
  897. end;
  898. result:=optinfo;
  899. end;
  900. {****************************************************************************
  901. TUNARYNODE
  902. ****************************************************************************}
  903. constructor tunarynode.create(t:tnodetype;l : tnode);
  904. begin
  905. inherited create(t);
  906. { transfer generic paramater flag }
  907. if assigned(l) and (nf_generic_para in l.flags) then
  908. include(flags,nf_generic_para);
  909. left:=l;
  910. end;
  911. constructor tunarynode.ppuload(t:tnodetype;ppufile:tcompilerppufile);
  912. begin
  913. inherited ppuload(t,ppufile);
  914. left:=ppuloadnode(ppufile);
  915. end;
  916. destructor tunarynode.destroy;
  917. begin
  918. left.free;
  919. inherited destroy;
  920. end;
  921. procedure tunarynode.ppuwrite(ppufile:tcompilerppufile);
  922. begin
  923. inherited ppuwrite(ppufile);
  924. ppuwritenode(ppufile,left);
  925. end;
  926. procedure tunarynode.buildderefimpl;
  927. begin
  928. inherited buildderefimpl;
  929. if assigned(left) then
  930. left.buildderefimpl;
  931. end;
  932. procedure tunarynode.derefimpl;
  933. begin
  934. inherited derefimpl;
  935. if assigned(left) then
  936. left.derefimpl;
  937. end;
  938. function tunarynode.docompare(p : tnode) : boolean;
  939. begin
  940. docompare:=(inherited docompare(p) and
  941. ((left=nil) or left.isequal(tunarynode(p).left))
  942. );
  943. end;
  944. function tunarynode.dogetcopy : tnode;
  945. var
  946. p : tunarynode;
  947. begin
  948. p:=tunarynode(inherited dogetcopy);
  949. if assigned(left) then
  950. p.left:=left.dogetcopy
  951. else
  952. p.left:=nil;
  953. result:=p;
  954. end;
  955. procedure tunarynode.insertintolist(l : tnodelist);
  956. begin
  957. end;
  958. procedure tunarynode.printnodedata(var t:text);
  959. begin
  960. inherited printnodedata(t);
  961. printnode(t,left);
  962. end;
  963. {$ifdef DEBUG_NODE_XML}
  964. procedure TUnaryNode.XMLPrintNodeData(var T: Text);
  965. begin
  966. inherited XMLPrintNodeData(T);
  967. XMLPrintNode(T, Left);
  968. end;
  969. {$endif DEBUG_NODE_XML}
  970. procedure tunarynode.concattolist(l : tlinkedlist);
  971. begin
  972. left.parent:=self;
  973. left.concattolist(l);
  974. inherited concattolist(l);
  975. end;
  976. function tunarynode.ischild(p : tnode) : boolean;
  977. begin
  978. ischild:=p=left;
  979. end;
  980. {****************************************************************************
  981. TBINARYNODE
  982. ****************************************************************************}
  983. constructor tbinarynode.create(t:tnodetype;l,r : tnode);
  984. begin
  985. inherited create(t,l);
  986. { transfer generic paramater flag }
  987. if assigned(r) and (nf_generic_para in r.flags) then
  988. include(flags,nf_generic_para);
  989. right:=r;
  990. end;
  991. constructor tbinarynode.ppuload(t:tnodetype;ppufile:tcompilerppufile);
  992. begin
  993. inherited ppuload(t,ppufile);
  994. right:=ppuloadnode(ppufile);
  995. end;
  996. destructor tbinarynode.destroy;
  997. begin
  998. right.free;
  999. inherited destroy;
  1000. end;
  1001. procedure tbinarynode.ppuwrite(ppufile:tcompilerppufile);
  1002. begin
  1003. inherited ppuwrite(ppufile);
  1004. ppuwritenode(ppufile,right);
  1005. end;
  1006. procedure tbinarynode.buildderefimpl;
  1007. begin
  1008. inherited buildderefimpl;
  1009. if assigned(right) then
  1010. right.buildderefimpl;
  1011. end;
  1012. procedure tbinarynode.derefimpl;
  1013. begin
  1014. inherited derefimpl;
  1015. if assigned(right) then
  1016. right.derefimpl;
  1017. end;
  1018. procedure tbinarynode.concattolist(l : tlinkedlist);
  1019. begin
  1020. { we could change that depending on the number of }
  1021. { required registers }
  1022. left.parent:=self;
  1023. left.concattolist(l);
  1024. left.parent:=self;
  1025. left.concattolist(l);
  1026. inherited concattolist(l);
  1027. end;
  1028. function tbinarynode.ischild(p : tnode) : boolean;
  1029. begin
  1030. ischild:=(p=right);
  1031. end;
  1032. function tbinarynode.docompare(p : tnode) : boolean;
  1033. begin
  1034. docompare:=(inherited docompare(p) and
  1035. ((right=nil) or right.isequal(tbinarynode(p).right))
  1036. );
  1037. end;
  1038. function tbinarynode.dogetcopy : tnode;
  1039. var
  1040. p : tbinarynode;
  1041. begin
  1042. p:=tbinarynode(inherited dogetcopy);
  1043. if assigned(right) then
  1044. p.right:=right.dogetcopy
  1045. else
  1046. p.right:=nil;
  1047. result:=p;
  1048. end;
  1049. procedure tbinarynode.insertintolist(l : tnodelist);
  1050. begin
  1051. end;
  1052. procedure tbinarynode.swapleftright;
  1053. var
  1054. swapp : tnode;
  1055. begin
  1056. swapp:=right;
  1057. right:=left;
  1058. left:=swapp;
  1059. if nf_swapped in flags then
  1060. exclude(flags,nf_swapped)
  1061. else
  1062. include(flags,nf_swapped);
  1063. end;
  1064. procedure tbinarynode.printnodedata(var t:text);
  1065. begin
  1066. inherited printnodedata(t);
  1067. printnode(t,right);
  1068. end;
  1069. {$ifdef DEBUG_NODE_XML}
  1070. procedure TBinaryNode.XMLPrintNodeTree(var T: Text);
  1071. begin
  1072. Write(T, PrintNodeIndention, '<', nodetype2str[nodetype]);
  1073. XMLPrintNodeInfo(T);
  1074. WriteLn(T, '>');
  1075. PrintNodeIndent;
  1076. XMLPrintNodeData(T);
  1077. end;
  1078. procedure TBinaryNode.XMLPrintNodeData(var T: Text);
  1079. begin
  1080. inherited XMLPrintNodeData(T);
  1081. PrintNodeUnindent;
  1082. WriteLn(T, PrintNodeIndention, '</', nodetype2str[nodetype], '>');
  1083. { Right nodes are on the same indentation level }
  1084. XMLPrintNode(T, Right);
  1085. end;
  1086. {$endif DEBUG_NODE_XML}
  1087. procedure tbinarynode.printnodelist(var t:text);
  1088. var
  1089. hp : tbinarynode;
  1090. begin
  1091. hp:=self;
  1092. while assigned(hp) do
  1093. begin
  1094. write(t,printnodeindention,'(');
  1095. printnodeindent;
  1096. hp.printnodeinfo(t);
  1097. writeln(t);
  1098. printnode(t,hp.left);
  1099. writeln(t);
  1100. printnodeunindent;
  1101. writeln(t,printnodeindention,')');
  1102. hp:=tbinarynode(hp.right);
  1103. end;
  1104. end;
  1105. {****************************************************************************
  1106. TTERTIARYNODE
  1107. ****************************************************************************}
  1108. constructor ttertiarynode.create(_t:tnodetype;l,r,t : tnode);
  1109. begin
  1110. inherited create(_t,l,r);
  1111. { transfer generic parameter flag }
  1112. if assigned(t) and (nf_generic_para in t.flags) then
  1113. include(flags,nf_generic_para);
  1114. third:=t;
  1115. end;
  1116. constructor ttertiarynode.ppuload(t:tnodetype;ppufile:tcompilerppufile);
  1117. begin
  1118. inherited ppuload(t,ppufile);
  1119. third:=ppuloadnode(ppufile);
  1120. end;
  1121. destructor ttertiarynode.destroy;
  1122. begin
  1123. third.free;
  1124. inherited destroy;
  1125. end;
  1126. procedure ttertiarynode.ppuwrite(ppufile:tcompilerppufile);
  1127. begin
  1128. inherited ppuwrite(ppufile);
  1129. ppuwritenode(ppufile,third);
  1130. end;
  1131. procedure ttertiarynode.buildderefimpl;
  1132. begin
  1133. inherited buildderefimpl;
  1134. if assigned(third) then
  1135. third.buildderefimpl;
  1136. end;
  1137. procedure ttertiarynode.derefimpl;
  1138. begin
  1139. inherited derefimpl;
  1140. if assigned(third) then
  1141. third.derefimpl;
  1142. end;
  1143. function ttertiarynode.docompare(p : tnode) : boolean;
  1144. begin
  1145. docompare:=(inherited docompare(p) and
  1146. ((third=nil) or third.isequal(ttertiarynode(p).third))
  1147. );
  1148. end;
  1149. function ttertiarynode.dogetcopy : tnode;
  1150. var
  1151. p : ttertiarynode;
  1152. begin
  1153. p:=ttertiarynode(inherited dogetcopy);
  1154. if assigned(third) then
  1155. p.third:=third.dogetcopy
  1156. else
  1157. p.third:=nil;
  1158. result:=p;
  1159. end;
  1160. procedure ttertiarynode.insertintolist(l : tnodelist);
  1161. begin
  1162. end;
  1163. procedure ttertiarynode.printnodedata(var t:text);
  1164. begin
  1165. inherited printnodedata(t);
  1166. printnode(t,third);
  1167. end;
  1168. {$ifdef DEBUG_NODE_XML}
  1169. procedure TTertiaryNode.XMLPrintNodeData(var T: Text);
  1170. begin
  1171. if Assigned(Third) then
  1172. begin
  1173. WriteLn(T, PrintNodeIndention, '<third-branch>');
  1174. PrintNodeIndent;
  1175. XMLPrintNode(T, Third);
  1176. PrintNodeUnindent;
  1177. WriteLn(T, PrintNodeIndention, '</third-branch>');
  1178. end;
  1179. inherited XMLPrintNodeData(T);
  1180. end;
  1181. {$endif DEBUG_NODE_XML}
  1182. procedure ttertiarynode.concattolist(l : tlinkedlist);
  1183. begin
  1184. third.parent:=self;
  1185. third.concattolist(l);
  1186. inherited concattolist(l);
  1187. end;
  1188. function ttertiarynode.ischild(p : tnode) : boolean;
  1189. begin
  1190. ischild:=p=third;
  1191. end;
  1192. {****************************************************************************
  1193. TBINOPNODE
  1194. ****************************************************************************}
  1195. constructor tbinopnode.create(t:tnodetype;l,r : tnode);
  1196. begin
  1197. inherited create(t,l,r);
  1198. end;
  1199. function tbinopnode.docompare(p : tnode) : boolean;
  1200. begin
  1201. docompare:=(inherited docompare(p)) or
  1202. { if that's in the flags, is p then always a tbinopnode (?) (JM) }
  1203. ((nf_swapable in flags) and
  1204. left.isequal(tbinopnode(p).right) and
  1205. right.isequal(tbinopnode(p).left));
  1206. end;
  1207. {$ifdef DEBUG_NODE_XML}
  1208. procedure TBinOpNode.XMLPrintNodeData(var T: Text);
  1209. begin
  1210. { For binary operations, put the left and right branches on the same level for clarity }
  1211. XMLPrintNode(T, Left);
  1212. XMLPrintNode(T, Right);
  1213. PrintNodeUnindent;
  1214. WriteLn(T, PrintNodeIndention, '</', nodetype2str[nodetype], '>');
  1215. end;
  1216. {$endif DEBUG_NODE_XML}
  1217. begin
  1218. {$push}{$warnings off}
  1219. { tvaroption must fit into a 4 byte set for speed reasons }
  1220. if ord(high(tvaroption))>31 then
  1221. internalerror(201110301);
  1222. { tnodeflags must fit into a 4 byte set for speed reasons }
  1223. if ord(high(tnodeflags))>31 then
  1224. internalerror(2014020701);
  1225. {$pop}
  1226. end.