starting from r20123

git-svn-id: http://svn.freepascal.org/svn/fpc/branches/blaise@20126 3ad0048d-3df7-0310-abae-a5850022a9f2

1 files changed, 1269 insertions, 0 deletions

diff --git a/closures/compiler/nld.pas b/closures/compiler/nld.pas
new file mode 100644
index 0000000000..2f2dc872af
--- /dev/null
+++ b/closures/compiler/nld.pas
@@ -0,0 +1,1269 @@
+{
+    Copyright (c) 2000-2002 by Florian Klaempfl
+
+    Type checking and register allocation for load/assignment nodes
+
+    This program is free software; you can redistribute it and/or modify
+    it under the terms of the GNU General Public License as published by
+    the Free Software Foundation; either version 2 of the License, or
+    (at your option) any later version.
+
+    This program is distributed in the hope that it will be useful,
+    but WITHOUT ANY WARRANTY; without even the implied warranty of
+    MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
+    GNU General Public License for more details.
+
+    You should have received a copy of the GNU General Public License
+    along with this program; if not, write to the Free Software
+    Foundation, Inc., 675 Mass Ave, Cambridge, MA 02139, USA.
+
+ ****************************************************************************
+}
+unit nld;
+
+{$i fpcdefs.inc}
+
+interface
+
+    uses
+       node,
+       {$ifdef state_tracking}
+       nstate,
+       {$endif}
+       symconst,symbase,symtype,symsym,symdef;
+
+    type
+       Trttidatatype = (rdt_normal,rdt_ord2str,rdt_str2ord);
+
+       tloadnodeflags = (
+         loadnf_is_self,
+         loadnf_load_self_pointer,
+         loadnf_inherited,
+         { the loadnode is generated internally and a varspez=vs_const should be ignore,
+           this requires that the parameter is actually passed by value
+           Be really carefull when using this flag! }
+         loadnf_isinternal_ignoreconst,
+
+         loadnf_only_uninitialized_hint
+        );
+
+       tloadnode = class(tunarynode)
+       protected
+          fprocdef : tprocdef;
+          fprocdefderef : tderef;
+       public
+          loadnodeflags : set of tloadnodeflags;
+          symtableentry : tsym;
+          symtableentryderef : tderef;
+          symtable : TSymtable;
+          constructor create(v : tsym;st : TSymtable);virtual;
+          constructor create_procvar(v : tsym;d:tprocdef;st : TSymtable);virtual;
+          constructor ppuload(t:tnodetype;ppufile:tcompilerppufile);override;
+          procedure ppuwrite(ppufile:tcompilerppufile);override;
+          procedure buildderefimpl;override;
+          procedure derefimpl;override;
+          procedure set_mp(p:tnode);
+          function  is_addr_param_load:boolean;
+          function  dogetcopy : tnode;override;
+          function  pass_1 : tnode;override;
+          function  pass_typecheck:tnode;override;
+          procedure mark_write;override;
+          function  docompare(p: tnode): boolean; override;
+          procedure printnodedata(var t:text);override;
+          procedure setprocdef(p : tprocdef);
+          property procdef: tprocdef read fprocdef write setprocdef;
+       end;
+       tloadnodeclass = class of tloadnode;
+
+       { different assignment types }
+       tassigntype = (at_normal,at_plus,at_minus,at_star,at_slash);
+
+       tassignmentnode = class(tbinarynode)
+          assigntype : tassigntype;
+          constructor create(l,r : tnode);virtual;
+          constructor ppuload(t:tnodetype;ppufile:tcompilerppufile);override;
+          procedure ppuwrite(ppufile:tcompilerppufile);override;
+          function dogetcopy : tnode;override;
+          function pass_1 : tnode;override;
+          function pass_typecheck:tnode;override;
+          function simplify(forinline : boolean) : tnode;override;
+       {$ifdef state_tracking}
+          function track_state_pass(exec_known:boolean):boolean;override;
+       {$endif state_tracking}
+          function docompare(p: tnode): boolean; override;
+       end;
+       tassignmentnodeclass = class of tassignmentnode;
+
+       tarrayconstructorrangenode = class(tbinarynode)
+          constructor create(l,r : tnode);virtual;
+          function pass_1 : tnode;override;
+          function pass_typecheck:tnode;override;
+       end;
+       tarrayconstructorrangenodeclass = class of tarrayconstructorrangenode;
+
+       tarrayconstructornode = class(tbinarynode)
+          constructor create(l,r : tnode);virtual;
+          function dogetcopy : tnode;override;
+          function pass_1 : tnode;override;
+          function pass_typecheck:tnode;override;
+          function docompare(p: tnode): boolean; override;
+          procedure force_type(def:tdef);
+          procedure insert_typeconvs;
+       end;
+       tarrayconstructornodeclass = class of tarrayconstructornode;
+
+       ttypenode = class(tnode)
+          allowed : boolean;
+          helperallowed : boolean;
+          typedef : tdef;
+          typedefderef : tderef;
+          typesym : tsym;
+          typesymderef : tderef;
+          constructor create(def:tdef);virtual;
+          constructor ppuload(t:tnodetype;ppufile:tcompilerppufile);override;
+          procedure ppuwrite(ppufile:tcompilerppufile);override;
+          procedure buildderefimpl;override;
+          procedure derefimpl;override;
+          function pass_1 : tnode;override;
+          function pass_typecheck:tnode;override;
+          function  dogetcopy : tnode;override;
+          function docompare(p: tnode): boolean; override;
+       end;
+       ttypenodeclass = class of ttypenode;
+
+       trttinode = class(tnode)
+          l1,l2  : longint;
+          rttitype : trttitype;
+          rttidef : tstoreddef;
+          rttidefderef : tderef;
+          rttidatatype : Trttidatatype;
+          constructor create(def:tstoreddef;rt:trttitype;dt:Trttidatatype);virtual;
+          constructor ppuload(t:tnodetype;ppufile:tcompilerppufile);override;
+          procedure ppuwrite(ppufile:tcompilerppufile);override;
+          procedure buildderefimpl;override;
+          procedure derefimpl;override;
+          function  dogetcopy : tnode;override;
+          function pass_1 : tnode;override;
+          function pass_typecheck:tnode;override;
+          function docompare(p: tnode): boolean; override;
+       end;
+       trttinodeclass = class of trttinode;
+
+    var
+       cloadnode : tloadnodeclass = tloadnode;
+       cassignmentnode : tassignmentnodeclass = tassignmentnode;
+       carrayconstructorrangenode : tarrayconstructorrangenodeclass = tarrayconstructorrangenode;
+       carrayconstructornode : tarrayconstructornodeclass = tarrayconstructornode;
+       ctypenode : ttypenodeclass = ttypenode;
+       crttinode : trttinodeclass = trttinode;
+
+       { Current assignment node }
+       aktassignmentnode : tassignmentnode;
+
+
+implementation
+
+    uses
+      cutils,verbose,globtype,globals,systems,
+      symnot,symtable,
+      defutil,defcmp,
+      htypechk,pass_1,procinfo,paramgr,
+      cpuinfo,
+      ncon,ninl,ncnv,nmem,ncal,nutils,nbas,
+      cgobj,cgbase
+      ;
+
+{*****************************************************************************
+                             TLOADNODE
+*****************************************************************************}
+
+    constructor tloadnode.create(v : tsym;st : TSymtable);
+      begin
+         inherited create(loadn,nil);
+         if not assigned(v) then
+          internalerror(200108121);
+         symtableentry:=v;
+         symtable:=st;
+         fprocdef:=nil;
+      end;
+
+
+    constructor tloadnode.create_procvar(v : tsym;d:tprocdef;st : TSymtable);
+      begin
+         inherited create(loadn,nil);
+         if not assigned(v) then
+          internalerror(200108122);
+         symtableentry:=v;
+         symtable:=st;
+         fprocdef:=d;
+      end;
+
+
+    constructor tloadnode.ppuload(t:tnodetype;ppufile:tcompilerppufile);
+      begin
+        inherited ppuload(t,ppufile);
+        ppufile.getderef(symtableentryderef);
+        symtable:=nil;
+        ppufile.getderef(fprocdefderef);
+        ppufile.getsmallset(loadnodeflags);
+      end;
+
+
+    procedure tloadnode.ppuwrite(ppufile:tcompilerppufile);
+      begin
+        inherited ppuwrite(ppufile);
+        ppufile.putderef(symtableentryderef);
+        ppufile.putderef(fprocdefderef);
+        ppufile.putsmallset(loadnodeflags);
+      end;
+
+
+    procedure tloadnode.buildderefimpl;
+      begin
+        inherited buildderefimpl;
+        symtableentryderef.build(symtableentry);
+        fprocdefderef.build(fprocdef);
+      end;
+
+
+    procedure tloadnode.derefimpl;
+      begin
+        inherited derefimpl;
+        symtableentry:=tsym(symtableentryderef.resolve);
+        symtable:=symtableentry.owner;
+        fprocdef:=tprocdef(fprocdefderef.resolve);
+      end;
+
+
+    procedure tloadnode.set_mp(p:tnode);
+      begin
+        { typen nodes should not be set }
+        if p.nodetype=typen then
+          internalerror(200301042);
+        left:=p;
+      end;
+
+
+    function tloadnode.dogetcopy : tnode;
+      var
+         n : tloadnode;
+
+      begin
+         n:=tloadnode(inherited dogetcopy);
+         n.symtable:=symtable;
+         n.symtableentry:=symtableentry;
+         n.fprocdef:=fprocdef;
+         result:=n;
+      end;
+
+
+    function tloadnode.is_addr_param_load:boolean;
+      begin
+        result:=(symtable.symtabletype=parasymtable) and
+                (symtableentry.typ=paravarsym) and
+                not(vo_has_local_copy in tparavarsym(symtableentry).varoptions) and
+                not(loadnf_load_self_pointer in loadnodeflags) and
+                paramanager.push_addr_param(tparavarsym(symtableentry).varspez,tparavarsym(symtableentry).vardef,tprocdef(symtable.defowner).proccalloption);
+      end;
+
+
+    function tloadnode.pass_typecheck:tnode;
+      begin
+         result:=nil;
+         case symtableentry.typ of
+           absolutevarsym :
+             resultdef:=tabsolutevarsym(symtableentry).vardef;
+           constsym:
+             begin
+               if tconstsym(symtableentry).consttyp=constresourcestring then
+                 resultdef:=getansistringdef
+               else
+                 internalerror(22799);
+             end;
+           staticvarsym :
+             begin
+               tabstractvarsym(symtableentry).IncRefCountBy(1);
+               { static variables referenced in procedures or from finalization,
+                 variable needs to be in memory.
+                 It is too hard and the benefit is too small to detect whether a
+                 variable is only used in the finalization to add support for it (PFV) }
+               if assigned(current_procinfo) and
+                  (symtable.symtabletype=staticsymtable) and
+                  (
+                    (symtable.symtablelevel<>current_procinfo.procdef.localst.symtablelevel) or
+                    (current_procinfo.procdef.proctypeoption=potype_unitfinalize)
+                  ) then
+                 make_not_regable(self,[ra_addr_taken]);
+               resultdef:=tabstractvarsym(symtableentry).vardef;
+             end;
+           paravarsym,
+           localvarsym :
+             begin
+               tabstractvarsym(symtableentry).IncRefCountBy(1);
+               { Nested variable? The we need to load the framepointer of
+                 the parent procedure }
+               if assigned(current_procinfo) and
+                  (symtable.symtabletype in [localsymtable,parasymtable]) and
+                  (symtable.symtablelevel<>current_procinfo.procdef.parast.symtablelevel) then
+                 begin
+                   if assigned(left) then
+                     internalerror(200309289);
+                   left:=cloadparentfpnode.create(tprocdef(symtable.defowner));
+                   { we can't inline the referenced parent procedure }
+                   exclude(tprocdef(symtable.defowner).procoptions,po_inline);
+                   { reference in nested procedures, variable needs to be in memory }
+                   { and behaves as if its address escapes its parent block         }
+                   make_not_regable(self,[ra_addr_taken]);
+                 end;
+               { fix self type which is declared as voidpointer in the
+                 definition }
+               if vo_is_self in tabstractvarsym(symtableentry).varoptions then
+                 begin
+                   resultdef:=tprocdef(symtableentry.owner.defowner).struct;
+                   if is_objectpascal_helper(resultdef) then
+                     resultdef:=tobjectdef(resultdef).extendeddef;
+                   if (po_classmethod in tprocdef(symtableentry.owner.defowner).procoptions) or
+                      (po_staticmethod in tprocdef(symtableentry.owner.defowner).procoptions) then
+                     resultdef:=tclassrefdef.create(resultdef)
+                   else if (is_object(resultdef) or is_record(resultdef)) and
+                           (loadnf_load_self_pointer in loadnodeflags) then
+                     resultdef:=tpointerdef.create(resultdef);
+                 end
+               else if vo_is_vmt in tabstractvarsym(symtableentry).varoptions then
+                 begin
+                   resultdef:=tprocdef(symtableentry.owner.defowner).struct;
+                   resultdef:=tclassrefdef.create(resultdef);
+                 end
+               else
+                 resultdef:=tabstractvarsym(symtableentry).vardef;
+             end;
+           procsym :
+             begin
+               { Return the first procdef. In case of overloaded
+                 procdefs the matching procdef will be choosen
+                 when the expected procvardef is known, see get_information
+                 in htypechk.pas (PFV) }
+               if not assigned(fprocdef) then
+                 fprocdef:=tprocdef(tprocsym(symtableentry).ProcdefList[0])
+               else if po_kylixlocal in fprocdef.procoptions then
+                 CGMessage(type_e_cant_take_address_of_local_subroutine);
+
+               { the result is a fprocdef, addrn and proc_to_procvar
+                 typeconvn need this as resultdef so they know
+                 that the address needs to be returned }
+               resultdef:=fprocdef;
+
+               { process methodpointer/framepointer }
+               if assigned(left) then
+                 typecheckpass(left);
+             end;
+           labelsym:
+             begin
+               tlabelsym(symtableentry).used:=true;
+               resultdef:=voidtype;
+             end;
+           else
+             internalerror(200104141);
+         end;
+      end;
+
+    procedure Tloadnode.mark_write;
+
+    begin
+      include(flags,nf_write);
+    end;
+
+    function tloadnode.pass_1 : tnode;
+      begin
+         result:=nil;
+         expectloc:=LOC_REFERENCE;
+         if (cs_create_pic in current_settings.moduleswitches) and
+           not(symtableentry.typ in [paravarsym,localvarsym]) then
+           include(current_procinfo.flags,pi_needs_got);
+
+         case symtableentry.typ of
+            absolutevarsym :
+              ;
+            constsym:
+              begin
+                 if tconstsym(symtableentry).consttyp=constresourcestring then
+                   expectloc:=LOC_CREFERENCE;
+              end;
+            staticvarsym,
+            localvarsym,
+            paravarsym :
+              begin
+                if assigned(left) then
+                  firstpass(left);
+                if not is_addr_param_load and
+                   tabstractvarsym(symtableentry).is_regvar(is_addr_param_load) then
+                  expectloc:=tvarregable2tcgloc[tabstractvarsym(symtableentry).varregable]
+                else
+                  if (tabstractvarsym(symtableentry).varspez=vs_const) then
+                    expectloc:=LOC_CREFERENCE;
+                if (target_info.system=system_powerpc_darwin) and
+                   ([vo_is_dll_var,vo_is_external] * tabstractvarsym(symtableentry).varoptions <> []) then
+                  include(current_procinfo.flags,pi_needs_got);
+                { call to get address of threadvar }
+                if (vo_is_thread_var in tabstractvarsym(symtableentry).varoptions) then
+                  include(current_procinfo.flags,pi_do_call);
+                if nf_write in flags then
+                  Tabstractvarsym(symtableentry).trigger_notifications(vn_onwrite)
+                else
+                  Tabstractvarsym(symtableentry).trigger_notifications(vn_onread);
+              end;
+            procsym :
+                begin
+                   { initialise left for nested procs if necessary }
+                   if (m_nested_procvars in current_settings.modeswitches) then
+                     setprocdef(fprocdef);
+                   { method pointer or nested proc ? }
+                   if assigned(left) then
+                     begin
+                        expectloc:=LOC_CREFERENCE;
+                        firstpass(left);
+                     end;
+                end;
+           labelsym :
+             ;
+           else
+             internalerror(200104143);
+         end;
+      end;
+
+
+    function tloadnode.docompare(p: tnode): boolean;
+      begin
+        docompare :=
+          inherited docompare(p) and
+          (symtableentry = tloadnode(p).symtableentry) and
+          (fprocdef = tloadnode(p).fprocdef) and
+          (symtable = tloadnode(p).symtable);
+      end;
+
+
+    procedure tloadnode.printnodedata(var t:text);
+      begin
+        inherited printnodedata(t);
+        write(t,printnodeindention,'symbol = ',symtableentry.name);
+        if symtableentry.typ=procsym then
+          write(t,printnodeindention,'procdef = ',fprocdef.mangledname);
+        writeln(t,'');
+      end;
+
+
+    procedure tloadnode.setprocdef(p : tprocdef);
+      begin
+        fprocdef:=p;
+        resultdef:=p;
+        { nested procedure? }
+        if assigned(p) and
+           is_nested_pd(p) then
+          begin
+            if not(m_nested_procvars in current_settings.modeswitches) then
+              CGMessage(type_e_cant_take_address_of_local_subroutine)
+            else
+              begin
+                { parent frame pointer pointer as "self" }
+                left.free;
+                left:=cloadparentfpnode.create(tprocdef(p.owner.defowner));
+              end;
+          end
+        { we should never go from nested to non-nested }
+        else if assigned(left) and
+                (left.nodetype=loadparentfpn) then
+          internalerror(2010072201);
+      end;
+
+{*****************************************************************************
+                             TASSIGNMENTNODE
+*****************************************************************************}
+
+    constructor tassignmentnode.create(l,r : tnode);
+
+      begin
+         inherited create(assignn,l,r);
+         l.mark_write;
+         assigntype:=at_normal;
+         if r.nodetype = typeconvn then
+           ttypeconvnode(r).warn_pointer_to_signed:=false;
+      end;
+
+
+    constructor tassignmentnode.ppuload(t:tnodetype;ppufile:tcompilerppufile);
+      begin
+        inherited ppuload(t,ppufile);
+        assigntype:=tassigntype(ppufile.getbyte);
+      end;
+
+
+    procedure tassignmentnode.ppuwrite(ppufile:tcompilerppufile);
+      begin
+        inherited ppuwrite(ppufile);
+        ppufile.putbyte(byte(assigntype));
+      end;
+
+
+    function tassignmentnode.dogetcopy : tnode;
+
+      var
+         n : tassignmentnode;
+
+      begin
+         n:=tassignmentnode(inherited dogetcopy);
+         n.assigntype:=assigntype;
+         result:=n;
+      end;
+
+
+    function tassignmentnode.simplify(forinline : boolean) : tnode;
+      begin
+        result:=nil;
+        { assignment nodes can perform several floating point }
+        { type conversions directly, so no typeconversions    }
+        { are inserted in those cases. When inlining, a       }
+        { variable may be replaced by a constant which can be }
+        { converted at compile time, so check for this case   }
+        if is_real(left.resultdef) and
+           is_real(right.resultdef) and
+           is_constrealnode(right) and
+           not equal_defs(right.resultdef,left.resultdef) then
+          inserttypeconv(right,left.resultdef);
+      end;
+
+
+    function tassignmentnode.pass_typecheck:tnode;
+      var
+        hp : tnode;
+        useshelper : boolean;
+        oldassignmentnode : tassignmentnode;
+      begin
+        result:=nil;
+        resultdef:=voidtype;
+
+        { must be made unique }
+        set_unique(left);
+
+        typecheckpass(left);
+
+        { PI. This is needed to return correct resultdef of add nodes for ansistrings
+          rawbytestring return needs to be replaced by left.resultdef }
+        oldassignmentnode:=aktassignmentnode;
+        aktassignmentnode:=self;
+        typecheckpass(right);
+        aktassignmentnode:=oldassignmentnode;
+
+        set_varstate(right,vs_read,[vsf_must_be_valid]);
+        set_varstate(left,vs_written,[]);
+        if codegenerror then
+          exit;
+
+        { tp procvar support, when we don't expect a procvar
+          then we need to call the procvar }
+        if (left.resultdef.typ<>procvardef) then
+          maybe_call_procvar(right,true);
+
+        { assignments to formaldefs and open arrays aren't allowed }
+        if (left.resultdef.typ=formaldef) or
+           is_open_array(left.resultdef) then
+          CGMessage(type_e_assignment_not_allowed);
+
+        { test if node can be assigned, properties are allowed }
+        valid_for_assignment(left,true);
+
+        { assigning nil to a dynamic array clears the array }
+        if is_dynamic_array(left.resultdef) and
+           (right.nodetype=niln) then
+         begin
+           { remove property flag to avoid errors, see comments for }
+           { tf_winlikewidestring assignments below                 }
+           exclude(left.flags,nf_isproperty);
+           hp:=ccallparanode.create(caddrnode.create_internal
+                   (crttinode.create(tstoreddef(left.resultdef),initrtti,rdt_normal)),
+               ccallparanode.create(ctypeconvnode.create_internal(left,voidpointertype),nil));
+           result := ccallnode.createintern('fpc_dynarray_clear',hp);
+           left:=nil;
+           exit;
+         end;
+
+        { shortstring helpers can do the conversion directly,
+          so treat them separatly }
+        if (is_shortstring(left.resultdef)) then
+         begin
+           { insert typeconv, except for chars that are handled in
+             secondpass and except for ansi/wide string that can
+             be converted immediatly }
+           if not(is_char(right.resultdef) or
+                  (right.resultdef.typ=stringdef)) then
+             inserttypeconv(right,left.resultdef);
+           if right.resultdef.typ=stringdef then
+            begin
+              useshelper:=true;
+              { convert constant strings to shortstrings. But
+                skip empty constant strings, that will be handled
+                in secondpass }
+              if (right.nodetype=stringconstn) then
+                begin
+                  { verify if range fits within shortstring }
+                  { just emit a warning, delphi gives an    }
+                  { error, only if the type definition of   }
+                  { of the string is less  < 255 characters }
+                  if not is_open_string(left.resultdef) and
+                     (tstringconstnode(right).len > tstringdef(left.resultdef).len) then
+                     cgmessage(type_w_string_too_long);
+                  inserttypeconv(right,left.resultdef);
+                  if (right.nodetype=stringconstn) and
+                     (tstringconstnode(right).len=0) then
+                    useshelper:=false;
+                end
+              else if (tstringdef(right.resultdef).stringtype in [st_unicodestring,st_widestring]) then
+                Message2(type_w_implicit_string_cast_loss,right.resultdef.typename,left.resultdef.typename);
+             { rest is done in pass 1 (JM) }
+             if useshelper then
+               exit;
+            end
+         end
+        { floating point assignments can also perform the conversion directly }
+        else if is_real(left.resultdef) and is_real(right.resultdef) and
+                not is_constrealnode(right)
+{$ifdef cpufpemu}
+                { the emulator can't do this obviously }
+                and not(current_settings.fputype in [fpu_libgcc,fpu_soft])
+{$endif cpufpemu}
+
+{$ifdef x86}
+                { the assignment node code can't convert a double in an }
+                { sse register to an extended value in memory more      }
+                { efficiently than a type conversion node, so don't     }
+                { bother implementing support for that                  }
+                and (use_vectorfpu(left.resultdef) or not(use_vectorfpu(right.resultdef)))
+{$endif}
+
+{$ifdef arm}
+                { the assignment node code can't convert a single in
+                  an interger register to a double in an mmregister or
+                  vice versa }
+                and (use_vectorfpu(left.resultdef) and
+                     use_vectorfpu(right.resultdef) and
+                     (tfloatdef(left.resultdef).floattype=tfloatdef(right.resultdef).floattype))
+{$endif}
+        then
+          begin
+            check_ranges(fileinfo,right,left.resultdef);
+          end
+        else
+          begin
+            { check if the assignment may cause a range check error }
+            check_ranges(fileinfo,right,left.resultdef);
+
+            { beginners might be confused about an error message like
+              Incompatible types: got "untyped" expected "LongInt"
+              when trying to assign the result of a procedure, so give
+              a better error message, see also #19122 }
+            if (left.resultdef.typ<>procvardef) and
+              (right.nodetype=calln) and is_void(right.resultdef) then
+              CGMessage(type_e_procedures_return_no_value)
+            else
+              inserttypeconv(right,left.resultdef);
+          end;
+
+        { call helpers for interface }
+        if is_interfacecom_or_dispinterface(left.resultdef) then
+         begin
+	   { Normal interface assignments are handled by the generic refcount incr/decr }
+           if not right.resultdef.is_related(left.resultdef) then
+             begin
+               { remove property flag to avoid errors, see comments for }
+               { tf_winlikewidestring assignments below                 }
+               exclude(left.flags,nf_isproperty);
+               hp:=
+                 ccallparanode.create(
+                   cguidconstnode.create(tobjectdef(left.resultdef).iidguid^),
+                 ccallparanode.create(
+                   ctypeconvnode.create_internal(right,voidpointertype),
+                 ccallparanode.create(
+                   ctypeconvnode.create_internal(left,voidpointertype),
+                   nil)));
+               result:=ccallnode.createintern('fpc_intf_assign_by_iid',hp);
+               left:=nil;
+               right:=nil;
+               exit;
+             end;
+         end;
+
+        { check if local proc/func is assigned to procvar }
+        if right.resultdef.typ=procvardef then
+          test_local_to_procvar(tprocvardef(right.resultdef),left.resultdef);
+      end;
+
+
+    function tassignmentnode.pass_1 : tnode;
+      var
+        hp: tnode;
+        oldassignmentnode : tassignmentnode;
+        hdef: tdef;
+        hs: string;
+        needrtti: boolean;
+      begin
+         result:=nil;
+         expectloc:=LOC_VOID;
+
+         firstpass(left);
+
+         { Optimize the reuse of the destination of the assingment in left.
+           Allow the use of the left inside the tree generated on the right.
+           This is especially useful for string routines where the destination
+           is pushed as a parameter. Using the final destination of left directly
+           save a temp allocation and copy of data (PFV) }
+         oldassignmentnode:=aktassignmentnode;
+         aktassignmentnode:=self;
+         firstpass(right);
+         aktassignmentnode:=oldassignmentnode;
+         if nf_assign_done_in_right in flags then
+           begin
+             result:=right;
+             right:=nil;
+             exit;
+           end;
+
+         if codegenerror then
+           exit;
+
+         { assignment to refcounted variable -> inc/decref }
+         if is_managed_type(left.resultdef) then
+           include(current_procinfo.flags,pi_do_call);
+
+         needrtti:=false;
+
+        if (is_shortstring(left.resultdef)) then
+          begin
+           if right.resultdef.typ=stringdef then
+            begin
+              if (right.nodetype<>stringconstn) or
+                 (tstringconstnode(right).len<>0) then
+               begin
+                 { remove property flag to avoid errors, see comments for }
+                 { tf_winlikewidestring assignments below                 }
+                 exclude(left.flags, nf_isproperty);
+                 hp:=ccallparanode.create
+                       (right,
+                  ccallparanode.create(left,nil));
+                 result:=ccallnode.createintern('fpc_'+tstringdef(right.resultdef).stringtypname+'_to_shortstr',hp);
+                 firstpass(result);
+                 left:=nil;
+                 right:=nil;
+               end;
+            end;
+            exit;
+           end
+        { call helpers for composite types containing automated types }
+        else if is_managed_type(left.resultdef) and
+            (left.resultdef.typ in [arraydef,objectdef,recorddef]) and
+            not is_interfacecom_or_dispinterface(left.resultdef) and
+            not is_dynamic_array(left.resultdef) then
+         begin
+           hp:=ccallparanode.create(caddrnode.create_internal(
+                  crttinode.create(tstoreddef(left.resultdef),initrtti,rdt_normal)),
+               ccallparanode.create(ctypeconvnode.create_internal(
+                 caddrnode.create_internal(left),voidpointertype),
+               ccallparanode.create(ctypeconvnode.create_internal(
+                 caddrnode.create_internal(right),voidpointertype),
+               nil)));
+           result:=ccallnode.createintern('fpc_copy_proc',hp);
+           firstpass(result);
+           left:=nil;
+           right:=nil;
+           exit;
+         end
+        { call helpers for variant, they can contain non ref. counted types like
+          vararrays which must be really copied }
+        else if left.resultdef.typ=variantdef then
+         begin
+           { remove property flag to avoid errors, see comments for }
+           { tf_winlikewidestring assignments below                 }
+           exclude(left.flags,nf_isproperty);
+           hdef:=search_system_type('TVARDATA').typedef;
+           hp:=ccallparanode.create(ctypeconvnode.create_internal(
+                 right,hdef),
+               ccallparanode.create(ctypeconvnode.create_internal(
+                 left,hdef),
+               nil));
+           result:=ccallnode.createintern('fpc_variant_copy',hp);
+           firstpass(result);
+           left:=nil;
+           right:=nil;
+           exit;
+         end
+        { call helpers for pointer-sized managed types }
+        else if is_widestring(left.resultdef) then
+          hs:='fpc_widestr_assign'
+        else if is_ansistring(left.resultdef) then
+          hs:='fpc_ansistr_assign'
+        else if is_unicodestring(left.resultdef) then
+          hs:='fpc_unicodestr_assign'
+        else if is_interfacecom_or_dispinterface(left.resultdef) then
+          hs:='fpc_intf_assign'
+        else if is_dynamic_array(left.resultdef) then
+          begin
+            hs:='fpc_dynarray_assign';
+            needrtti:=true;
+          end
+        else
+          exit;
+
+        { The first argument of these procedures is a var parameter. Properties cannot     }
+        { be passed to var or out parameters, because in that case setters/getters are not }
+        { used. Further, if we would allow it in case there are no getters or setters, you }
+        { would need source changes in case these are introduced later on, thus defeating  }
+        { part of the transparency advantages of properties. In this particular case,      }
+        { however:                                                                         }
+        {   a) if there is a setter, this code will not be used since then the assignment  }
+        {      will be converted to a procedure call                                       }
+        {   b) the getter is irrelevant, because fpc_widestr_assign must always decrease   }
+        {      the refcount of the field to which we are writing                           }
+        {   c) source code changes are not required if a setter is added/removed, because  }
+        {      this transformation is handled at compile time                              }
+        {  -> we can remove the nf_isproperty flag (if any) from left, so that in case it  }
+        {     is a property which refers to a field without a setter call, we will not get }
+        {     an error about trying to pass a property as a var parameter                  }
+        exclude(left.flags,nf_isproperty);
+        hp:=ccallparanode.create(ctypeconvnode.create_internal(right,voidpointertype),
+            ccallparanode.create(ctypeconvnode.create_internal(left,voidpointertype),
+            nil));
+        if needrtti then
+          hp:=ccallparanode.create(
+            caddrnode.create_internal(
+              crttinode.create(tstoreddef(left.resultdef),initrtti,rdt_normal)),
+            hp);
+        result:=ccallnode.createintern(hs,hp);
+        firstpass(result);
+        left:=nil;
+        right:=nil;
+      end;
+
+
+    function tassignmentnode.docompare(p: tnode): boolean;
+      begin
+        docompare :=
+          inherited docompare(p) and
+          (assigntype = tassignmentnode(p).assigntype);
+      end;
+
+{$ifdef state_tracking}
+    function Tassignmentnode.track_state_pass(exec_known:boolean):boolean;
+
+    var se:Tstate_entry;
+
+    begin
+        track_state_pass:=false;
+        if exec_known then
+            begin
+                track_state_pass:=right.track_state_pass(exec_known);
+                {Force a new resultdef pass.}
+                right.resultdef:=nil;
+                do_typecheckpass(right);
+                typecheckpass(right);
+                aktstate.store_fact(left.getcopy,right.getcopy);
+            end
+        else
+            aktstate.delete_fact(left);
+    end;
+{$endif}
+
+
+{*****************************************************************************
+                           TARRAYCONSTRUCTORRANGENODE
+*****************************************************************************}
+
+    constructor tarrayconstructorrangenode.create(l,r : tnode);
+
+      begin
+         inherited create(arrayconstructorrangen,l,r);
+      end;
+
+    function tarrayconstructorrangenode.pass_typecheck:tnode;
+      begin
+        result:=nil;
+        typecheckpass(left);
+        typecheckpass(right);
+        set_varstate(left,vs_read,[vsf_must_be_valid]);
+        set_varstate(right,vs_read,[vsf_must_be_valid]);
+        if codegenerror then
+         exit;
+        resultdef:=left.resultdef;
+      end;
+
+
+    function tarrayconstructorrangenode.pass_1 : tnode;
+      begin
+        result:=nil;
+        CGMessage(parser_e_illegal_expression);
+      end;
+
+
+{****************************************************************************
+                            TARRAYCONSTRUCTORNODE
+*****************************************************************************}
+
+    constructor tarrayconstructornode.create(l,r : tnode);
+      begin
+         inherited create(arrayconstructorn,l,r);
+      end;
+
+
+    function tarrayconstructornode.dogetcopy : tnode;
+      var
+         n : tarrayconstructornode;
+      begin
+         n:=tarrayconstructornode(inherited dogetcopy);
+         result:=n;
+      end;
+
+
+    function tarrayconstructornode.pass_typecheck:tnode;
+      var
+        hdef  : tdef;
+        hp    : tarrayconstructornode;
+        len   : longint;
+        varia : boolean;
+        eq    : tequaltype;
+        hnodetype : tnodetype;
+      begin
+        result:=nil;
+
+      { are we allowing array constructor? Then convert it to a set.
+        Do this only if we didn't convert the arrayconstructor yet. This
+        is needed for the cases where the resultdef is forced for a second
+        run }
+        if not(allow_array_constructor) then
+         begin
+           hp:=tarrayconstructornode(getcopy);
+           arrayconstructor_to_set(tnode(hp));
+           result:=hp;
+           exit;
+         end;
+
+      { only pass left tree, right tree contains next construct if any }
+        hdef:=nil;
+        hnodetype:=errorn;
+        len:=0;
+        varia:=false;
+        if assigned(left) then
+         begin
+           hp:=self;
+           while assigned(hp) do
+            begin
+              typecheckpass(hp.left);
+              set_varstate(hp.left,vs_read,[vsf_must_be_valid]);
+              if (hdef=nil) then
+                begin
+                  hdef:=hp.left.resultdef;
+                  hnodetype:=hp.left.nodetype;
+                end
+              else
+               begin
+                 { If we got a niln we don't know the type yet and need to take the
+                   type of the next array element.
+                   This is to handle things like [nil,tclass,tclass], see also tw8371 (PFV) }
+                 if hnodetype=niln then
+                   begin
+                     eq:=compare_defs(hp.left.resultdef,hdef,hnodetype);
+                     if eq>te_incompatible then
+                       begin
+                         hdef:=hp.left.resultdef;
+                         hnodetype:=hp.left.nodetype;
+                       end;
+                   end
+                 else
+                   eq:=compare_defs(hdef,hp.left.resultdef,hp.left.nodetype);
+                 if (not varia) and (eq<te_equal) then
+                   begin
+                     { If both are integers we need to take the type that can hold both
+                       defs }
+                     if is_integer(hdef) and is_integer(hp.left.resultdef) then
+                       begin
+                         if is_in_limit(hdef,hp.left.resultdef) then
+                           hdef:=hp.left.resultdef;
+                       end
+                     else
+                       if (nf_novariaallowed in flags) then
+                         varia:=true;
+                   end;
+               end;
+              inc(len);
+              hp:=tarrayconstructornode(hp.right);
+            end;
+         end;
+         { Set the type of empty or varia arrays to void. Also
+           do this if the type is array of const/open array
+           because those can't be used with setelementdef }
+         if not assigned(hdef) or
+            varia or
+            is_array_of_const(hdef) or
+            is_open_array(hdef) then
+           hdef:=voidtype;
+         resultdef:=tarraydef.create(0,len-1,s32inttype);
+         tarraydef(resultdef).elementdef:=hdef;
+         include(tarraydef(resultdef).arrayoptions,ado_IsConstructor);
+         if varia then
+           include(tarraydef(resultdef).arrayoptions,ado_IsVariant);
+      end;
+
+
+    procedure tarrayconstructornode.force_type(def:tdef);
+      var
+        hp : tarrayconstructornode;
+      begin
+        tarraydef(resultdef).elementdef:=def;
+        include(tarraydef(resultdef).arrayoptions,ado_IsConstructor);
+        exclude(tarraydef(resultdef).arrayoptions,ado_IsVariant);
+        if assigned(left) then
+         begin
+           hp:=self;
+           while assigned(hp) do
+            begin
+              inserttypeconv(hp.left,def);
+              hp:=tarrayconstructornode(hp.right);
+            end;
+         end;
+      end;
+
+
+    procedure tarrayconstructornode.insert_typeconvs;
+      var
+        hp        : tarrayconstructornode;
+        dovariant : boolean;
+      begin
+        dovariant:=(nf_forcevaria in flags) or (ado_isvariant in tarraydef(resultdef).arrayoptions);
+        { only pass left tree, right tree contains next construct if any }
+        if assigned(left) then
+         begin
+           hp:=self;
+           while assigned(hp) do
+            begin
+              typecheckpass(hp.left);
+              { Insert typeconvs for array of const }
+              if dovariant then
+                { at this time C varargs are no longer an arrayconstructornode }
+                insert_varargstypeconv(hp.left,false);
+              hp:=tarrayconstructornode(hp.right);
+            end;
+         end;
+      end;
+
+
+    function tarrayconstructornode.pass_1 : tnode;
+      var
+        hp : tarrayconstructornode;
+        do_variant:boolean;
+      begin
+        do_variant:=(nf_forcevaria in flags) or (ado_isvariant in tarraydef(resultdef).arrayoptions);
+        result:=nil;
+        { Insert required type convs, this must be
+          done in pass 1, because the call must be
+          typecheckpassed already }
+        if assigned(left) then
+          begin
+            insert_typeconvs;
+            { call firstpass for all nodes }
+            hp:=self;
+            while assigned(hp) do
+              begin
+                if hp.left<>nil then
+                  begin
+                    {This check is pessimistic; a call will happen depending
+                     on the location in which the elements will be found in
+                     pass 2.}
+                    if not do_variant then
+                      include(current_procinfo.flags,pi_do_call);
+                    firstpass(hp.left);
+                  end;
+                hp:=tarrayconstructornode(hp.right);
+              end;
+          end;
+        expectloc:=LOC_CREFERENCE;
+      end;
+
+
+    function tarrayconstructornode.docompare(p: tnode): boolean;
+      begin
+        docompare:=inherited docompare(p);
+      end;
+
+
+{*****************************************************************************
+                              TTYPENODE
+*****************************************************************************}
+
+    constructor ttypenode.create(def:tdef);
+      begin
+         inherited create(typen);
+         typedef:=def;
+         typesym:=def.typesym;
+         allowed:=false;
+         helperallowed:=false;
+      end;
+
+
+    constructor ttypenode.ppuload(t:tnodetype;ppufile:tcompilerppufile);
+      begin
+        inherited ppuload(t,ppufile);
+        ppufile.getderef(typedefderef);
+        ppufile.getderef(typesymderef);
+        allowed:=boolean(ppufile.getbyte);
+        helperallowed:=boolean(ppufile.getbyte);
+      end;
+
+
+    procedure ttypenode.ppuwrite(ppufile:tcompilerppufile);
+      begin
+        inherited ppuwrite(ppufile);
+        ppufile.putderef(typedefderef);
+        ppufile.putderef(typesymderef);
+        ppufile.putbyte(byte(allowed));
+        ppufile.putbyte(byte(helperallowed));
+      end;
+
+
+    procedure ttypenode.buildderefimpl;
+      begin
+        inherited buildderefimpl;
+        typedefderef.build(typedef);
+        typesymderef.build(typesym);
+      end;
+
+
+    procedure ttypenode.derefimpl;
+      begin
+        inherited derefimpl;
+        typedef:=tdef(typedefderef.resolve);
+        typesym:=tsym(typesymderef.resolve);
+      end;
+
+
+    function ttypenode.pass_typecheck:tnode;
+      begin
+        result:=nil;
+        resultdef:=typedef;
+        { check if it's valid }
+        if typedef.typ = errordef then
+          CGMessage(parser_e_illegal_expression);
+      end;
+
+
+    function ttypenode.pass_1 : tnode;
+      begin
+         result:=nil;
+         expectloc:=LOC_VOID;
+         { a typenode can't generate code, so we give here
+           an error. Else it'll be an abstract error in pass_generate_code.
+           Only when the allowed flag is set we don't generate
+           an error }
+         if not allowed then
+          Message(parser_e_no_type_not_allowed_here);
+         if not helperallowed and is_objectpascal_helper(typedef) then
+           Message(parser_e_no_category_as_types);
+      end;
+
+
+    function ttypenode.dogetcopy : tnode;
+      var
+         n : ttypenode;
+      begin
+         n:=ttypenode(inherited dogetcopy);
+         n.allowed:=allowed;
+         n.typedef:=typedef;
+         n.helperallowed:=helperallowed;
+         result:=n;
+      end;
+
+
+    function ttypenode.docompare(p: tnode): boolean;
+      begin
+        docompare :=
+          inherited docompare(p);
+      end;
+
+
+{*****************************************************************************
+                              TRTTINODE
+*****************************************************************************}
+
+
+    constructor trttinode.create(def:tstoreddef;rt:trttitype;dt:Trttidatatype);
+      begin
+         inherited create(rttin);
+         rttidef:=def;
+         rttitype:=rt;
+         rttidatatype:=dt;
+      end;
+
+
+    constructor trttinode.ppuload(t:tnodetype;ppufile:tcompilerppufile);
+      begin
+        inherited ppuload(t,ppufile);
+        ppufile.getderef(rttidefderef);
+        rttitype:=trttitype(ppufile.getbyte);
+        rttidatatype:=trttidatatype(ppufile.getbyte);
+      end;
+
+
+    procedure trttinode.ppuwrite(ppufile:tcompilerppufile);
+      begin
+        inherited ppuwrite(ppufile);
+        ppufile.putderef(rttidefderef);
+        ppufile.putbyte(byte(rttitype));
+        ppufile.putbyte(byte(rttidatatype));
+      end;
+
+
+    procedure trttinode.buildderefimpl;
+      begin
+        inherited buildderefimpl;
+        rttidefderef.build(rttidef);
+      end;
+
+
+    procedure trttinode.derefimpl;
+      begin
+        inherited derefimpl;
+        rttidef:=tstoreddef(rttidefderef.resolve);
+      end;
+
+
+    function trttinode.dogetcopy : tnode;
+      var
+         n : trttinode;
+      begin
+         n:=trttinode(inherited dogetcopy);
+         n.rttidef:=rttidef;
+         n.rttitype:=rttitype;
+         n.rttidatatype:=rttidatatype;
+         result:=n;
+      end;
+
+
+    function trttinode.pass_typecheck:tnode;
+      begin
+        { rtti information will be returned as a void pointer }
+        result:=nil;
+        resultdef:=voidpointertype;
+      end;
+
+
+    function trttinode.pass_1 : tnode;
+      begin
+        result:=nil;
+        expectloc:=LOC_CREFERENCE;
+      end;
+
+
+    function trttinode.docompare(p: tnode): boolean;
+      begin
+        docompare :=
+          inherited docompare(p) and
+          (rttidef = trttinode(p).rttidef) and
+          (rttitype = trttinode(p).rttitype);
+      end;
+
+end.