1 { 2 Copyright (c) 2000-2002 by Florian Klaempfl 3 4 Basic node handling 5 6 This program is free software; you can redistribute it and/or modify 7 it under the terms of the GNU General Public License as published by 8 the Free Software Foundation; either version 2 of the License, or 9 (at your option) any later version. 10 11 This program is distributed in the hope that it will be useful, 12 but WITHOUT ANY WARRANTY; without even the implied warranty of 13 MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the 14 GNU General Public License for more details. 15 16 You should have received a copy of the GNU General Public License 17 along with this program; if not, write to the Free Software 18 Foundation, Inc., 675 Mass Ave, Cambridge, MA 02139, USA. 19 20 **************************************************************************** 21 } 22 unit node; 23 24 {$i fpcdefs.inc} 25 26 interface 27 28 uses 29 cclasses, 30 globtype,globals,cgbase,cgutils, 31 symtype, 32 optbase; 33 34 type 35 tnodetype = ( 36 emptynode, {No node (returns nil when loading from ppu)} 37 addn, {Represents the + operator} 38 muln, {Represents the * operator} 39 subn, {Represents the - operator} 40 divn, {Represents the div operator} 41 symdifn, {Represents the >< operator} 42 modn, {Represents the mod operator} 43 assignn, {Represents an assignment} 44 loadn, {Represents the use of a variabele} 45 rangen, {Represents a range (i.e. 0..9)} 46 ltn, {Represents the < operator} 47 lten, {Represents the <= operator} 48 gtn, {Represents the > operator} 49 gten, {Represents the >= operator} 50 equaln, {Represents the = operator} 51 unequaln, {Represents the <> operator} 52 inn, {Represents the in operator} 53 orn, {Represents the or operator} 54 xorn, {Represents the xor operator} 55 shrn, {Represents the shr operator} 56 shln, {Represents the shl operator} 57 slashn, {Represents the / operator} 58 andn, {Represents the and operator} 59 subscriptn, {Field in a record/object} 60 derefn, {Dereferences a pointer} 61 addrn, {Represents the @ operator} 62 ordconstn, {Represents an ordinal value} 63 typeconvn, {Represents type-conversion/typecast} 64 calln, {Represents a call node} 65 callparan, {Represents a parameter} 66 realconstn, {Represents a real value} 67 unaryminusn, {Represents a sign change (i.e. -2)} 68 unaryplusn, {Represents a check for +Value} 69 asmn, {Represents an assembler node } 70 vecn, {Represents array indexing} 71 pointerconstn, {Represents a pointer constant} 72 stringconstn, {Represents a string constant} 73 notn, {Represents the not operator} 74 inlinen, {Internal procedures (i.e. writeln)} 75 niln, {Represents the nil pointer} 76 errorn, {This part of the tree could not be 77 parsed because of a compiler error} 78 typen, {A type name. Used for i.e. typeof(obj)} 79 setelementn, {A set element(s) (i.e. [a,b] and also [a..b])} 80 setconstn, {A set constant (i.e. [1,2])} 81 blockn, {A block of statements} 82 statementn, {One statement in a block of nodes} 83 ifn, {An if statement} 84 breakn, {A break statement} 85 continuen, {A continue statement} 86 whilerepeatn, {A while or repeat statement} 87 forn, {A for loop} 88 exitn, {An exit statement} 89 casen, {A case statement} 90 labeln, {A label} 91 goton, {A goto statement} 92 tryexceptn, {A try except block} 93 raisen, {A raise statement} 94 tryfinallyn, {A try finally statement} 95 onn, {For an on statement in exception code} 96 isn, {Represents the is operator} 97 asn, {Represents the as typecast} 98 starstarn, {Represents the ** operator exponentiation } 99 arrayconstructorn, {Construction node for [...] parsing} 100 arrayconstructorrangen, {Range element to allow sets in array construction tree} 101 tempcreaten, { for temps in the result/firstpass } 102 temprefn, { references to temps } 103 tempdeleten, { for temps in the result/firstpass } 104 addoptn, { added for optimizations where we cannot suppress } 105 nothingn, { NOP, Do nothing} 106 loadvmtaddrn, { Load the address of the VMT of a class/object} 107 guidconstn, { A GUID COM Interface constant } 108 rttin, { Rtti information so they can be accessed in result/firstpass} 109 loadparentfpn, { Load the framepointer of the parent for nested procedures } 110 objcselectorn, { node for an Objective-C message selector } 111 objcprotocoln, { node for an Objective-C @protocol() expression (returns metaclass associated with protocol) } 112 specializen { parser-only node to handle Delphi-mode inline specializations } 113 ); 114 115 tnodetypeset = set of tnodetype; 116 pnodetypeset = ^tnodetypeset; 117 118 const 119 nodetype2str : array[tnodetype] of string[24] = ( 120 '<emptynode>', 121 'addn', 122 'muln', 123 'subn', 124 'divn', 125 'symdifn', 126 'modn', 127 'assignn', 128 'loadn', 129 'rangen', 130 'ltn', 131 'lten', 132 'gtn', 133 'gten', 134 'equaln', 135 'unequaln', 136 'inn', 137 'orn', 138 'xorn', 139 'shrn', 140 'shln', 141 'slashn', 142 'andn', 143 'subscriptn', 144 'derefn', 145 'addrn', 146 'ordconstn', 147 'typeconvn', 148 'calln', 149 'callparan', 150 'realconstn', 151 'unaryminusn', 152 'unaryplusn', 153 'asmn', 154 'vecn', 155 'pointerconstn', 156 'stringconstn', 157 'notn', 158 'inlinen', 159 'niln', 160 'errorn', 161 'typen', 162 'setelementn', 163 'setconstn', 164 'blockn', 165 'statementn', 166 'ifn', 167 'breakn', 168 'continuen', 169 'whilerepeatn', 170 'forn', 171 'exitn', 172 'casen', 173 'labeln', 174 'goton', 175 'tryexceptn', 176 'raisen', 177 'tryfinallyn', 178 'onn', 179 'isn', 180 'asn', 181 'starstarn', 182 'arrayconstructn', 183 'arrayconstructrangen', 184 'tempcreaten', 185 'temprefn', 186 'tempdeleten', 187 'addoptn', 188 'nothingn', 189 'loadvmtaddrn', 190 'guidconstn', 191 'rttin', 192 'loadparentfpn', 193 'objcselectorn', 194 'objcprotocoln', 195 'specializen'); 196 197 { a set containing all const nodes } 198 nodetype_const = [niln, 199 ordconstn, 200 pointerconstn, 201 stringconstn, 202 guidconstn, 203 realconstn, 204 setconstn]; 205 206 type 207 { all boolean field of ttree are now collected in flags } 208 tnodeflag = ( 209 { tbinop operands can be swaped } 210 nf_swapable, 211 { tbinop operands are swaped } 212 nf_swapped, 213 nf_error, 214 215 { general } 216 nf_pass1_done, 217 { Node is written to } 218 nf_write, 219 { Node is modified } 220 nf_modify, 221 { address of node is taken } 222 nf_address_taken, 223 nf_is_funcret, 224 nf_isproperty, 225 nf_processing, 226 { Node cannot be assigned to } 227 nf_no_lvalue, 228 { this node is the user code entry, if a node with this flag is removed 229 during simplify, the flag must be moved to another node } 230 nf_usercode_entry, 231 232 { tderefnode } 233 nf_no_checkpointer, 234 235 { tvecnode } 236 nf_memindex, 237 nf_memseg, 238 nf_callunique, 239 240 { tloadnode/ttypeconvnode } 241 nf_absolute, 242 243 { taddnode } 244 { if the result type of a node is currency, then this flag denotes, that the value is already mulitplied by 10000 } 245 nf_is_currency, 246 nf_has_pointerdiv, 247 { the node shall be short boolean evaluated, this flag has priority over localswitches } 248 nf_short_bool, 249 250 { tmoddivnode } 251 nf_isomod, 252 253 { tassignmentnode } 254 nf_assign_done_in_right, 255 256 { tarrayconstructnode } 257 nf_forcevaria, 258 nf_novariaallowed, 259 260 { ttypeconvnode, and the first one also treal/ord/pointerconstn } 261 { second one also for subtractions of u32-u32 implicitly upcasted to s64 } 262 { last one also used on addnode to inhibit procvar calling } 263 nf_explicit, 264 nf_internal, { no warnings/hints generated } 265 nf_load_procvar, 266 267 { tinlinenode } 268 nf_inlineconst, 269 270 { tasmnode } 271 nf_get_asm_position, 272 273 { tblocknode } 274 nf_block_with_exit, 275 276 { tloadvmtaddrnode } 277 nf_ignore_for_wpo { we know that this loadvmtaddrnode cannot be used to construct a class instance } 278 279 { WARNING: there are now 31 elements in this type, and a set of this 280 type is written to the PPU. So before adding more than 32 elements, 281 either move some flags to specific nodes, or stream a normalset 282 to the ppu 283 } 284 285 ); 286 287 tnodeflags = set of tnodeflag; 288 289 const 290 { contains the flags which must be equal for the equality } 291 { of nodes } 292 flagsequal : tnodeflags = [nf_error]; 293 294 type 295 tnodelist = class 296 end; 297 298 pnode = ^tnode; 299 { basic class for the intermediated representation fpc uses } 300 tnode = class 301 private 302 fppuidx : longint; getppuidxnull303 function getppuidx:longint; 304 public 305 { type of this node } 306 nodetype : tnodetype; 307 { type of the current code block, general/const/type } 308 blocktype : tblock_type; 309 { expected location of the result of this node (pass1) } 310 expectloc : tcgloc; 311 { the location of the result of this node (pass2) } 312 location : tlocation; 313 { the parent node of this is node } 314 { this field is set by concattolist } 315 parent : tnode; 316 { next node in control flow on the same block level, i.e. 317 for loop nodes, this is the next node after the end of the loop, 318 same for if and case, if this field is nil, the next node is the procedure exit, 319 for the last node in a loop this is set to the loop header 320 this field is set only for control flow nodes } 321 successor : tnode; 322 { there are some properties about the node stored } 323 flags : tnodeflags; 324 resultdef : tdef; 325 resultdefderef : tderef; 326 fileinfo : tfileposinfo; 327 localswitches : tlocalswitches; 328 verbosity : longint; 329 optinfo : poptinfo; 330 constructor create(t:tnodetype); 331 { this constructor is only for creating copies of class } 332 { the fields are copied by getcopy } 333 constructor createforcopy; 334 constructor ppuload(t:tnodetype;ppufile:tcompilerppufile);virtual; 335 destructor destroy;override; 336 procedure ppuwrite(ppufile:tcompilerppufile);virtual; 337 procedure buildderefimpl;virtual; 338 procedure derefimpl;virtual; 339 procedure resolveppuidx;virtual; 340 341 { toggles the flag } 342 procedure toggleflag(f : tnodeflag); 343 344 { the 1.1 code generator may override pass_1 } 345 { and it need not to implement det_* then } 346 { 1.1: pass_1 returns a value<>0 if the node has been transformed } 347 { 2.0: runs pass_typecheck and det_temp } pass_1null348 function pass_1 : tnode;virtual;abstract; 349 { dermines the resultdef of the node } pass_typechecknull350 function pass_typecheck : tnode;virtual;abstract; 351 352 { tries to simplify the node, returns a value <>nil if a simplified 353 node has been created } simplifynull354 function simplify(forinline : boolean) : tnode;virtual; 355 {$ifdef state_tracking} 356 { Does optimizations by keeping track of the variable states 357 in a procedure } track_state_passnull358 function track_state_pass(exec_known:boolean):boolean;virtual; 359 {$endif} 360 { For a t1:=t2 tree, mark the part of the tree t1 that gets 361 written to (normally the loadnode) as write access. } 362 procedure mark_write;virtual; 363 { dermines the number of necessary temp. locations to evaluate 364 the node } 365 procedure det_temp;virtual;abstract; 366 367 procedure pass_generate_code;virtual;abstract; 368 369 { comparing of nodes } isequalnull370 function isequal(p : tnode) : boolean; 371 { to implement comparisation, override this method } docomparenull372 function docompare(p : tnode) : boolean;virtual; 373 { wrapper for getcopy } getcopynull374 function getcopy : tnode; 375 376 { does the real copying of a node } dogetcopynull377 function dogetcopy : tnode;virtual; 378 379 procedure insertintolist(l : tnodelist);virtual; 380 { writes a node for debugging purpose, shouldn't be called } 381 { direct, because there is no test for nil, use printnode } 382 { to write a complete tree } 383 procedure printnodeinfo(var t:text);virtual; 384 procedure printnodedata(var t:text);virtual; 385 procedure printnodetree(var t:text);virtual; 386 procedure concattolist(l : tlinkedlist);virtual; ischildnull387 function ischild(p : tnode) : boolean;virtual; 388 389 { ensures that the optimizer info record is allocated } allocoptinfonull390 function allocoptinfo : poptinfo;inline; 391 property ppuidx:longint read getppuidx; 392 end; 393 394 tnodeclass = class of tnode; 395 396 tnodeclassarray = array[tnodetype] of tnodeclass; 397 398 { this node is the anchestor for all nodes with at least } 399 { one child, you have to use it if you want to use } 400 { true- and current_procinfo.CurrFalseLabel } 401 //punarynode = ^tunarynode; 402 tunarynode = class(tnode) 403 left : tnode; 404 constructor create(t:tnodetype;l : tnode); 405 constructor ppuload(t:tnodetype;ppufile:tcompilerppufile);override; 406 destructor destroy;override; 407 procedure ppuwrite(ppufile:tcompilerppufile);override; 408 procedure buildderefimpl;override; 409 procedure derefimpl;override; 410 procedure concattolist(l : tlinkedlist);override; ischildnull411 function ischild(p : tnode) : boolean;override; docomparenull412 function docompare(p : tnode) : boolean;override; dogetcopynull413 function dogetcopy : tnode;override; 414 procedure insertintolist(l : tnodelist);override; 415 procedure printnodedata(var t:text);override; 416 end; 417 418 //pbinarynode = ^tbinarynode; 419 tbinarynode = class(tunarynode) 420 right : tnode; 421 constructor create(t:tnodetype;l,r : tnode); 422 constructor ppuload(t:tnodetype;ppufile:tcompilerppufile);override; 423 destructor destroy;override; 424 procedure ppuwrite(ppufile:tcompilerppufile);override; 425 procedure buildderefimpl;override; 426 procedure derefimpl;override; 427 procedure concattolist(l : tlinkedlist);override; ischildnull428 function ischild(p : tnode) : boolean;override; docomparenull429 function docompare(p : tnode) : boolean;override; 430 procedure swapleftright; dogetcopynull431 function dogetcopy : tnode;override; 432 procedure insertintolist(l : tnodelist);override; 433 procedure printnodedata(var t:text);override; 434 procedure printnodelist(var t:text); 435 end; 436 437 //ptertiarynode = ^ttertiarynode; 438 ttertiarynode = class(tbinarynode) 439 third : tnode; 440 constructor create(_t:tnodetype;l,r,t : tnode); 441 constructor ppuload(t:tnodetype;ppufile:tcompilerppufile);override; 442 destructor destroy;override; 443 procedure ppuwrite(ppufile:tcompilerppufile);override; 444 procedure buildderefimpl;override; 445 procedure derefimpl;override; 446 procedure concattolist(l : tlinkedlist);override; ischildnull447 function ischild(p : tnode) : boolean;override; docomparenull448 function docompare(p : tnode) : boolean;override; dogetcopynull449 function dogetcopy : tnode;override; 450 procedure insertintolist(l : tnodelist);override; 451 procedure printnodedata(var t:text);override; 452 end; 453 454 tbinopnode = class(tbinarynode) 455 constructor create(t:tnodetype;l,r : tnode);virtual; docomparenull456 function docompare(p : tnode) : boolean;override; 457 end; 458 459 var 460 { array with all class types for tnodes } 461 nodeclass : tnodeclassarray; 462 nodeppuidxgetnull463 function nodeppuidxget(i:longint):tnode; ppuloadnodenull464 function ppuloadnode(ppufile:tcompilerppufile):tnode; 465 procedure ppuwritenode(ppufile:tcompilerppufile;n:tnode); ppuloadnodetreenull466 function ppuloadnodetree(ppufile:tcompilerppufile):tnode; 467 procedure ppuwritenodetree(ppufile:tcompilerppufile;n:tnode); 468 469 const 470 printnodespacing = ' '; 471 var 472 { indention used when writing the tree to the screen } 473 printnodeindention : string; 474 475 procedure printnodeindent; 476 procedure printnodeunindent; 477 procedure printnode(var t:text;n:tnode); 478 procedure printnode(n:tnode); 479 is_constnodenull480 function is_constnode(p : tnode) : boolean; is_constintnodenull481 function is_constintnode(p : tnode) : boolean; is_constcharnodenull482 function is_constcharnode(p : tnode) : boolean; is_constrealnodenull483 function is_constrealnode(p : tnode) : boolean; is_constboolnodenull484 function is_constboolnode(p : tnode) : boolean; is_constenumnodenull485 function is_constenumnode(p : tnode) : boolean; is_constwidecharnodenull486 function is_constwidecharnode(p : tnode) : boolean; is_constpointernodenull487 function is_constpointernode(p : tnode) : boolean; is_conststringnodenull488 function is_conststringnode(p : tnode) : boolean; is_constwidestringnodenull489 function is_constwidestringnode(p : tnode) : boolean; is_conststring_or_constcharnodenull490 function is_conststring_or_constcharnode(p : tnode) : boolean; 491 492 493 implementation 494 495 uses 496 verbose,entfile,comphook, 497 symconst, 498 nutils,nflw, 499 defutil; 500 501 const 502 ppunodemarker = 255; 503 504 505 {**************************************************************************** 506 Helpers 507 ****************************************************************************} 508 509 var 510 nodeppulist : TFPObjectList; 511 nodeppuidx : longint; 512 513 514 procedure nodeppuidxcreate; 515 begin 516 nodeppulist:=TFPObjectList.Create(false); 517 nodeppuidx:=0; 518 end; 519 520 521 procedure nodeppuidxresolve; 522 var 523 i : longint; 524 n : tnode; 525 begin 526 for i:=0 to nodeppulist.count-1 do 527 begin 528 n:=tnode(nodeppulist[i]); 529 if assigned(n) then 530 n.resolveppuidx; 531 end; 532 end; 533 534 535 procedure nodeppuidxfree; 536 begin 537 nodeppulist.free; 538 nodeppulist:=nil; 539 nodeppuidx:=0; 540 end; 541 542 543 procedure nodeppuidxadd(n:tnode); 544 var 545 i : longint; 546 begin 547 i:=n.ppuidx; 548 if i<=0 then 549 internalerror(200311072); 550 if i>=nodeppulist.capacity then 551 nodeppulist.capacity:=((i div 1024)+1)*1024; 552 if i>=nodeppulist.count then 553 nodeppulist.count:=i+1; 554 nodeppulist[i]:=n; 555 end; 556 557 nodeppuidxgetnull558 function nodeppuidxget(i:longint):tnode; 559 begin 560 if i<=0 then 561 internalerror(200311073); 562 result:=tnode(nodeppulist[i]); 563 end; 564 565 ppuloadnodenull566 function ppuloadnode(ppufile:tcompilerppufile):tnode; 567 var 568 b : byte; 569 t : tnodetype; 570 hppuidx : longint; 571 begin 572 { marker } 573 b:=ppufile.getbyte; 574 if b<>ppunodemarker then 575 internalerror(200208151); 576 { load nodetype } 577 t:=tnodetype(ppufile.getbyte); 578 if t>high(tnodetype) then 579 internalerror(200208152); 580 if t<>emptynode then 581 begin 582 if not assigned(nodeclass[t]) then 583 internalerror(200208153); 584 hppuidx:=ppufile.getlongint; 585 //writeln('load: ',nodetype2str[t]); 586 { generate node of the correct class } 587 result:=nodeclass[t].ppuload(t,ppufile); 588 result.fppuidx:=hppuidx; 589 nodeppuidxadd(result); 590 end 591 else 592 result:=nil; 593 end; 594 595 596 procedure ppuwritenode(ppufile:tcompilerppufile;n:tnode); 597 begin 598 { marker, read by ppuloadnode } 599 ppufile.putbyte(ppunodemarker); 600 { type, read by ppuloadnode } 601 if assigned(n) then 602 begin 603 ppufile.putbyte(byte(n.nodetype)); 604 ppufile.putlongint(n.ppuidx); 605 //writeln('write: ',nodetype2str[n.nodetype]); 606 n.ppuwrite(ppufile); 607 end 608 else 609 ppufile.putbyte(byte(emptynode)); 610 end; 611 612 ppuloadnodetreenull613 function ppuloadnodetree(ppufile:tcompilerppufile):tnode; 614 begin 615 if ppufile.readentry<>ibnodetree then 616 Message(unit_f_ppu_read_error); 617 nodeppuidxcreate; 618 result:=ppuloadnode(ppufile); 619 nodeppuidxresolve; 620 nodeppuidxfree; 621 end; 622 623 624 procedure ppuwritenodetree(ppufile:tcompilerppufile;n:tnode); 625 begin 626 nodeppuidxcreate; 627 ppuwritenode(ppufile,n); 628 ppufile.writeentry(ibnodetree); 629 nodeppuidxfree; 630 end; 631 632 633 procedure printnodeindent; 634 begin 635 printnodeindention:=printnodeindention+printnodespacing; 636 end; 637 638 639 procedure printnodeunindent; 640 begin 641 delete(printnodeindention,1,length(printnodespacing)); 642 end; 643 644 645 procedure printnode(var t:text;n:tnode); 646 begin 647 if assigned(n) then 648 n.printnodetree(t) 649 else 650 writeln(t,printnodeindention,'nil'); 651 end; 652 653 654 procedure printnode(n:tnode); 655 begin 656 printnode(output,n); 657 end; 658 659 is_constnodenull660 function is_constnode(p : tnode) : boolean; 661 begin 662 is_constnode:=(p.nodetype in nodetype_const); 663 end; 664 665 is_constintnodenull666 function is_constintnode(p : tnode) : boolean; 667 begin 668 is_constintnode:=(p.nodetype=ordconstn) and is_integer(p.resultdef); 669 end; 670 671 is_constcharnodenull672 function is_constcharnode(p : tnode) : boolean; 673 begin 674 is_constcharnode:=(p.nodetype=ordconstn) and is_char(p.resultdef); 675 end; 676 677 is_constwidecharnodenull678 function is_constwidecharnode(p : tnode) : boolean; 679 begin 680 is_constwidecharnode:=(p.nodetype=ordconstn) and is_widechar(p.resultdef); 681 end; 682 683 is_constrealnodenull684 function is_constrealnode(p : tnode) : boolean; 685 begin 686 is_constrealnode:=(p.nodetype=realconstn); 687 end; 688 689 is_constboolnodenull690 function is_constboolnode(p : tnode) : boolean; 691 begin 692 is_constboolnode:=(p.nodetype=ordconstn) and is_boolean(p.resultdef); 693 end; 694 695 is_constenumnodenull696 function is_constenumnode(p : tnode) : boolean; 697 begin 698 is_constenumnode:=(p.nodetype=ordconstn) and (p.resultdef.typ=enumdef); 699 end; 700 701 is_constpointernodenull702 function is_constpointernode(p : tnode) : boolean; 703 begin 704 is_constpointernode:=(p.nodetype=pointerconstn); 705 end; 706 is_conststringnodenull707 function is_conststringnode(p : tnode) : boolean; 708 begin 709 is_conststringnode := 710 (p.nodetype = stringconstn) and 711 (is_chararray(p.resultdef) or 712 is_shortstring(p.resultdef) or 713 is_ansistring(p.resultdef)); 714 end; 715 is_constwidestringnodenull716 function is_constwidestringnode(p : tnode) : boolean; 717 begin 718 is_constwidestringnode := 719 (p.nodetype = stringconstn) and 720 (is_widechararray(p.resultdef) or 721 is_wide_or_unicode_string(p.resultdef)); 722 end; 723 is_conststring_or_constcharnodenull724 function is_conststring_or_constcharnode(p : tnode) : boolean; 725 begin 726 is_conststring_or_constcharnode := 727 is_conststringnode(p) or is_constcharnode(p) or 728 is_constwidestringnode(p) or is_constwidecharnode(p); 729 end; 730 731 732 {**************************************************************************** 733 TNODE 734 ****************************************************************************} 735 736 constructor tnode.create(t:tnodetype); 737 738 begin 739 inherited create; 740 nodetype:=t; 741 blocktype:=block_type; 742 { updated by firstpass } 743 expectloc:=LOC_INVALID; 744 { updated by secondpass } 745 location.loc:=LOC_INVALID; 746 { save local info } 747 fileinfo:=current_filepos; 748 localswitches:=current_settings.localswitches; 749 verbosity:=status.verbosity; 750 resultdef:=nil; 751 flags:=[]; 752 end; 753 754 constructor tnode.createforcopy; 755 756 begin 757 end; 758 759 constructor tnode.ppuload(t:tnodetype;ppufile:tcompilerppufile); 760 761 begin 762 nodetype:=t; 763 { tnode fields } 764 blocktype:=tblock_type(ppufile.getbyte); 765 ppufile.getposinfo(fileinfo); 766 ppufile.getsmallset(localswitches); 767 verbosity:=ppufile.getlongint; 768 ppufile.getderef(resultdefderef); 769 ppufile.getsmallset(flags); 770 { updated by firstpass } 771 expectloc:=LOC_INVALID; 772 { updated by secondpass } 773 location.loc:=LOC_INVALID; 774 end; 775 776 777 procedure tnode.ppuwrite(ppufile:tcompilerppufile); 778 begin 779 ppufile.putbyte(byte(block_type)); 780 ppufile.putposinfo(fileinfo); 781 ppufile.putsmallset(localswitches); 782 ppufile.putlongint(verbosity); 783 ppufile.putderef(resultdefderef); 784 ppufile.putsmallset(flags); 785 end; 786 787 tnode.getppuidxnull788 function tnode.getppuidx:longint; 789 begin 790 if fppuidx=0 then 791 begin 792 inc(nodeppuidx); 793 fppuidx:=nodeppuidx; 794 end; 795 result:=fppuidx; 796 end; 797 798 799 procedure tnode.resolveppuidx; 800 begin 801 end; 802 803 804 procedure tnode.buildderefimpl; 805 begin 806 resultdefderef.build(resultdef); 807 end; 808 809 810 procedure tnode.derefimpl; 811 begin 812 resultdef:=tdef(resultdefderef.resolve); 813 end; 814 815 816 procedure tnode.toggleflag(f : tnodeflag); 817 begin 818 if f in flags then 819 exclude(flags,f) 820 else 821 include(flags,f); 822 end; 823 824 tnode.simplifynull825 function tnode.simplify(forinline : boolean) : tnode; 826 begin 827 result:=nil; 828 end; 829 830 831 destructor tnode.destroy; 832 begin 833 if assigned(optinfo) then 834 dispose(optinfo); 835 end; 836 837 838 procedure tnode.concattolist(l : tlinkedlist); 839 begin 840 end; 841 842 tnode.ischildnull843 function tnode.ischild(p : tnode) : boolean; 844 begin 845 ischild:=false; 846 end; 847 848 849 procedure tnode.mark_write; 850 begin 851 {$ifdef EXTDEBUG} 852 Comment(V_Warning,'mark_write not implemented for '+nodetype2str[nodetype]); 853 {$endif EXTDEBUG} 854 end; 855 856 857 procedure tnode.printnodeinfo(var t:text); 858 var 859 i : tnodeflag; 860 first : boolean; 861 begin 862 write(t,nodetype2str[nodetype]); 863 if assigned(resultdef) then 864 write(t,', resultdef = ',resultdef.typesymbolprettyname,' = "',resultdef.GetTypeName,'"') 865 else 866 write(t,', resultdef = <nil>'); 867 write(t,', pos = (',fileinfo.line,',',fileinfo.column,')', 868 ', loc = ',tcgloc2str[location.loc], 869 ', expectloc = ',tcgloc2str[expectloc], 870 ', flags = ['); 871 first:=true; 872 for i:=low(tnodeflag) to high(tnodeflag) do 873 if i in flags then 874 begin 875 if not(first) then 876 write(t,',') 877 else 878 first:=false; 879 write(t, i); 880 end; 881 write(t,'], cmplx = ',node_complexity(self)); 882 end; 883 884 885 procedure tnode.printnodedata(var t:text); 886 begin 887 end; 888 889 890 procedure tnode.printnodetree(var t:text); 891 begin 892 write(t,printnodeindention,'('); 893 printnodeinfo(t); 894 writeln(t); 895 printnodeindent; 896 printnodedata(t); 897 printnodeunindent; 898 writeln(t,printnodeindention,')'); 899 end; 900 901 tnode.isequalnull902 function tnode.isequal(p : tnode) : boolean; 903 begin 904 isequal:= 905 (not assigned(self) and not assigned(p)) or 906 (assigned(self) and assigned(p) and 907 { optimized subclasses have the same nodetype as their } 908 { superclass (for compatibility), so also check the classtype (JM) } 909 (p.classtype=classtype) and 910 (p.nodetype=nodetype) and 911 (flags*flagsequal=p.flags*flagsequal) and 912 docompare(p)); 913 end; 914 915 {$ifdef state_tracking} Tnode.track_state_passnull916 function Tnode.track_state_pass(exec_known:boolean):boolean; 917 begin 918 track_state_pass:=false; 919 end; 920 {$endif state_tracking} 921 922 tnode.docomparenull923 function tnode.docompare(p : tnode) : boolean; 924 begin 925 docompare:=true; 926 end; 927 928 cleanupcopiedtonull929 function cleanupcopiedto(var n : tnode;arg : pointer) : foreachnoderesult; 930 begin 931 result:=fen_true; 932 if n.nodetype=labeln then 933 tlabelnode(n).copiedto:=nil; 934 end; 935 936 tnode.getcopynull937 function tnode.getcopy : tnode; 938 begin 939 result:=dogetcopy; 940 foreachnodestatic(pm_postprocess,self,@cleanupcopiedto,nil); 941 end; 942 943 tnode.dogetcopynull944 function tnode.dogetcopy : tnode; 945 var 946 p : tnode; 947 begin 948 { this is quite tricky because we need a node of the current } 949 { node type and not one of tnode! } 950 p:=tnodeclass(classtype).createforcopy; 951 p.nodetype:=nodetype; 952 p.expectloc:=expectloc; 953 p.location:=location; 954 p.parent:=parent; 955 p.flags:=flags; 956 p.resultdef:=resultdef; 957 p.fileinfo:=fileinfo; 958 p.localswitches:=localswitches; 959 p.verbosity:=verbosity; 960 { p.list:=list; } 961 result:=p; 962 end; 963 964 965 procedure tnode.insertintolist(l : tnodelist); 966 begin 967 end; 968 969 970 { ensures that the optimizer info record is allocated } tnode.allocoptinfonull971 function tnode.allocoptinfo : poptinfo;inline; 972 begin 973 if not(assigned(optinfo)) then 974 begin 975 new(optinfo); 976 fillchar(optinfo^,sizeof(optinfo^),0); 977 end; 978 result:=optinfo; 979 end; 980 981 {**************************************************************************** 982 TUNARYNODE 983 ****************************************************************************} 984 985 constructor tunarynode.create(t:tnodetype;l : tnode); 986 begin 987 inherited create(t); 988 left:=l; 989 end; 990 991 992 constructor tunarynode.ppuload(t:tnodetype;ppufile:tcompilerppufile); 993 begin 994 inherited ppuload(t,ppufile); 995 left:=ppuloadnode(ppufile); 996 end; 997 998 999 destructor tunarynode.destroy; 1000 begin 1001 left.free; 1002 inherited destroy; 1003 end; 1004 1005 1006 procedure tunarynode.ppuwrite(ppufile:tcompilerppufile); 1007 begin 1008 inherited ppuwrite(ppufile); 1009 ppuwritenode(ppufile,left); 1010 end; 1011 1012 1013 procedure tunarynode.buildderefimpl; 1014 begin 1015 inherited buildderefimpl; 1016 if assigned(left) then 1017 left.buildderefimpl; 1018 end; 1019 1020 1021 procedure tunarynode.derefimpl; 1022 begin 1023 inherited derefimpl; 1024 if assigned(left) then 1025 left.derefimpl; 1026 end; 1027 1028 tunarynode.docomparenull1029 function tunarynode.docompare(p : tnode) : boolean; 1030 begin 1031 docompare:=(inherited docompare(p) and 1032 ((left=nil) or left.isequal(tunarynode(p).left)) 1033 ); 1034 end; 1035 1036 tunarynode.dogetcopynull1037 function tunarynode.dogetcopy : tnode; 1038 var 1039 p : tunarynode; 1040 begin 1041 p:=tunarynode(inherited dogetcopy); 1042 if assigned(left) then 1043 p.left:=left.dogetcopy 1044 else 1045 p.left:=nil; 1046 result:=p; 1047 end; 1048 1049 1050 procedure tunarynode.insertintolist(l : tnodelist); 1051 begin 1052 end; 1053 1054 1055 procedure tunarynode.printnodedata(var t:text); 1056 begin 1057 inherited printnodedata(t); 1058 printnode(t,left); 1059 end; 1060 1061 1062 procedure tunarynode.concattolist(l : tlinkedlist); 1063 begin 1064 left.parent:=self; 1065 left.concattolist(l); 1066 inherited concattolist(l); 1067 end; 1068 1069 tunarynode.ischildnull1070 function tunarynode.ischild(p : tnode) : boolean; 1071 begin 1072 ischild:=p=left; 1073 end; 1074 1075 1076 {**************************************************************************** 1077 TBINARYNODE 1078 ****************************************************************************} 1079 1080 constructor tbinarynode.create(t:tnodetype;l,r : tnode); 1081 begin 1082 inherited create(t,l); 1083 right:=r 1084 end; 1085 1086 1087 constructor tbinarynode.ppuload(t:tnodetype;ppufile:tcompilerppufile); 1088 begin 1089 inherited ppuload(t,ppufile); 1090 right:=ppuloadnode(ppufile); 1091 end; 1092 1093 1094 destructor tbinarynode.destroy; 1095 begin 1096 right.free; 1097 inherited destroy; 1098 end; 1099 1100 1101 procedure tbinarynode.ppuwrite(ppufile:tcompilerppufile); 1102 begin 1103 inherited ppuwrite(ppufile); 1104 ppuwritenode(ppufile,right); 1105 end; 1106 1107 1108 procedure tbinarynode.buildderefimpl; 1109 begin 1110 inherited buildderefimpl; 1111 if assigned(right) then 1112 right.buildderefimpl; 1113 end; 1114 1115 1116 procedure tbinarynode.derefimpl; 1117 begin 1118 inherited derefimpl; 1119 if assigned(right) then 1120 right.derefimpl; 1121 end; 1122 1123 1124 procedure tbinarynode.concattolist(l : tlinkedlist); 1125 begin 1126 { we could change that depending on the number of } 1127 { required registers } 1128 left.parent:=self; 1129 left.concattolist(l); 1130 left.parent:=self; 1131 left.concattolist(l); 1132 inherited concattolist(l); 1133 end; 1134 1135 tbinarynode.ischildnull1136 function tbinarynode.ischild(p : tnode) : boolean; 1137 begin 1138 ischild:=(p=right); 1139 end; 1140 1141 tbinarynode.docomparenull1142 function tbinarynode.docompare(p : tnode) : boolean; 1143 begin 1144 docompare:=(inherited docompare(p) and 1145 ((right=nil) or right.isequal(tbinarynode(p).right)) 1146 ); 1147 end; 1148 1149 tbinarynode.dogetcopynull1150 function tbinarynode.dogetcopy : tnode; 1151 var 1152 p : tbinarynode; 1153 begin 1154 p:=tbinarynode(inherited dogetcopy); 1155 if assigned(right) then 1156 p.right:=right.dogetcopy 1157 else 1158 p.right:=nil; 1159 result:=p; 1160 end; 1161 1162 1163 procedure tbinarynode.insertintolist(l : tnodelist); 1164 begin 1165 end; 1166 1167 1168 procedure tbinarynode.swapleftright; 1169 var 1170 swapp : tnode; 1171 begin 1172 swapp:=right; 1173 right:=left; 1174 left:=swapp; 1175 if nf_swapped in flags then 1176 exclude(flags,nf_swapped) 1177 else 1178 include(flags,nf_swapped); 1179 end; 1180 1181 1182 procedure tbinarynode.printnodedata(var t:text); 1183 begin 1184 inherited printnodedata(t); 1185 printnode(t,right); 1186 end; 1187 1188 1189 procedure tbinarynode.printnodelist(var t:text); 1190 var 1191 hp : tbinarynode; 1192 begin 1193 hp:=self; 1194 while assigned(hp) do 1195 begin 1196 write(t,printnodeindention,'('); 1197 printnodeindent; 1198 hp.printnodeinfo(t); 1199 writeln(t); 1200 printnode(t,hp.left); 1201 writeln(t); 1202 printnodeunindent; 1203 writeln(t,printnodeindention,')'); 1204 hp:=tbinarynode(hp.right); 1205 end; 1206 end; 1207 1208 1209 {**************************************************************************** 1210 TTERTIARYNODE 1211 ****************************************************************************} 1212 1213 constructor ttertiarynode.create(_t:tnodetype;l,r,t : tnode); 1214 begin 1215 inherited create(_t,l,r); 1216 third:=t; 1217 end; 1218 1219 1220 constructor ttertiarynode.ppuload(t:tnodetype;ppufile:tcompilerppufile); 1221 begin 1222 inherited ppuload(t,ppufile); 1223 third:=ppuloadnode(ppufile); 1224 end; 1225 1226 1227 destructor ttertiarynode.destroy; 1228 begin 1229 third.free; 1230 inherited destroy; 1231 end; 1232 1233 1234 procedure ttertiarynode.ppuwrite(ppufile:tcompilerppufile); 1235 begin 1236 inherited ppuwrite(ppufile); 1237 ppuwritenode(ppufile,third); 1238 end; 1239 1240 1241 procedure ttertiarynode.buildderefimpl; 1242 begin 1243 inherited buildderefimpl; 1244 if assigned(third) then 1245 third.buildderefimpl; 1246 end; 1247 1248 1249 procedure ttertiarynode.derefimpl; 1250 begin 1251 inherited derefimpl; 1252 if assigned(third) then 1253 third.derefimpl; 1254 end; 1255 1256 ttertiarynode.docomparenull1257 function ttertiarynode.docompare(p : tnode) : boolean; 1258 begin 1259 docompare:=(inherited docompare(p) and 1260 ((third=nil) or third.isequal(ttertiarynode(p).third)) 1261 ); 1262 end; 1263 1264 ttertiarynode.dogetcopynull1265 function ttertiarynode.dogetcopy : tnode; 1266 var 1267 p : ttertiarynode; 1268 begin 1269 p:=ttertiarynode(inherited dogetcopy); 1270 if assigned(third) then 1271 p.third:=third.dogetcopy 1272 else 1273 p.third:=nil; 1274 result:=p; 1275 end; 1276 1277 1278 procedure ttertiarynode.insertintolist(l : tnodelist); 1279 begin 1280 end; 1281 1282 1283 procedure ttertiarynode.printnodedata(var t:text); 1284 begin 1285 inherited printnodedata(t); 1286 printnode(t,third); 1287 end; 1288 1289 1290 procedure ttertiarynode.concattolist(l : tlinkedlist); 1291 begin 1292 third.parent:=self; 1293 third.concattolist(l); 1294 inherited concattolist(l); 1295 end; 1296 1297 ttertiarynode.ischildnull1298 function ttertiarynode.ischild(p : tnode) : boolean; 1299 begin 1300 ischild:=p=third; 1301 end; 1302 1303 1304 {**************************************************************************** 1305 TBINOPNODE 1306 ****************************************************************************} 1307 1308 constructor tbinopnode.create(t:tnodetype;l,r : tnode); 1309 begin 1310 inherited create(t,l,r); 1311 end; 1312 1313 tbinopnode.docomparenull1314 function tbinopnode.docompare(p : tnode) : boolean; 1315 begin 1316 docompare:=(inherited docompare(p)) or 1317 { if that's in the flags, is p then always a tbinopnode (?) (JM) } 1318 ((nf_swapable in flags) and 1319 left.isequal(tbinopnode(p).right) and 1320 right.isequal(tbinopnode(p).left)); 1321 end; 1322 1323 begin 1324 {$push}{$warnings off} 1325 { tvaroption must fit into a 4 byte set for speed reasons } 1326 if ord(high(tvaroption))>31 then 1327 internalerror(201110301); 1328 { tnodeflags must fit into a 4 byte set for speed reasons } 1329 if ord(high(tnodeflags))>31 then 1330 internalerror(2014020701); 1331 {$pop} 1332 end. 1333 1334