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