node.pas 36 KB

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