fpc/compiler/nbas.pas

{
    Copyright (c) 2000-2002 by Florian Klaempfl

    This unit implements some basic 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 nbas;

{$i fpcdefs.inc}

interface

    uses
       globtype,
       cgbase,cgutils,
       aasmtai,aasmdata,aasmcpu,
       node,
       symtype;

    type
       tnothingnode = class(tnode)
          constructor create;virtual;
          function pass_1 : tnode;override;
          function pass_typecheck:tnode;override;
{$ifdef DEBUG_NODE_XML}
          procedure XMLPrintNodeTree(var T: Text); override;
{$endif DEBUG_NODE_XML}
       end;
       tnothingnodeclass = class of tnothingnode;

       terrornode = class(tnode)
          constructor create;virtual;
          function pass_1 : tnode;override;
          function pass_typecheck:tnode;override;
          procedure mark_write;override;
       end;
       terrornodeclass = class of terrornode;

       tspecializenode = class(tunarynode)
          sym:tsym;
          getaddr:boolean;
          inheriteddef:tdef;
          unit_specific:boolean;
          constructor create(l:tnode;g:boolean;s:tsym;u:boolean);virtual;
          constructor create_inherited(l:tnode;g:boolean;s:tsym;i:tdef);virtual;
          function pass_1:tnode;override;
          function pass_typecheck:tnode;override;
       end;
       tspecializenodeclass = class of tspecializenode;

       tfinalizetempsnode = class(tnode)
          constructor create;virtual;
          function pass_1 : tnode;override;
          function pass_typecheck:tnode;override;
          function docompare(p: tnode): boolean; override;
       end;
       tfinalizetempsnodeclass = class of tfinalizetempsnode;

       TAsmNodeFlag = (
         asmnf_get_asm_position,
         { Used registers in assembler block }
         asmnf_has_registerlist
       );

       TAsmNodeFlags = set of TAsmNodeFlag;

       tasmnode = class(tnode)
          asmnodeflags : TAsmNodeFlags;
          p_asm : TAsmList;
          currenttai : tai;
          constructor create(p : TAsmList);virtual;
          constructor create_get_position;
          destructor destroy;override;
          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;
{$ifdef DEBUG_NODE_XML}
          procedure XMLPrintNodeInfo(var T: Text); override;
          procedure XMLPrintNodeData(var T: Text); override;
       protected
          class procedure XMLPadString(var S: string; Len: Integer); static;

          function XMLFormatOp(const Oper: POper): string; virtual;
          procedure XMLProcessInstruction(var T: Text; p: tai); virtual;
{$endif DEBUG_NODE_XML}
       end;
       tasmnodeclass = class of tasmnode;

       tstatementnode = class(tbinarynode)
          constructor create(l,r : tnode);virtual;
          function simplify(forinline : boolean) : tnode; override;
          function pass_1 : tnode;override;
          function pass_typecheck:tnode;override;
          procedure printnodetree(var t:text);override;
          property statement : tnode read left write left;
          property next : tnode read right write right;
       end;
       tstatementnodeclass = class of tstatementnode;

       TBlockNodeFlag = (
         bnf_strippable { Block node can be removed via simplify etc. }
       );

       TBlockNodeFlags = set of TBlockNodeFlag;

       tblocknode = class(tunarynode)
          blocknodeflags : TBlockNodeFlags;
          constructor create(l : tnode);virtual;
          destructor destroy; override;
          constructor ppuload(t:tnodetype;ppufile:tcompilerppufile);override;
          procedure ppuwrite(ppufile:tcompilerppufile);override;
          function dogetcopy : tnode;override;
          function simplify(forinline : boolean) : tnode; override;
          function pass_1 : tnode;override;
          function pass_typecheck:tnode;override;
{$ifdef state_tracking}
          function track_state_pass(exec_known:boolean):boolean;override;
{$endif state_tracking}
{$ifdef DEBUG_NODE_XML}
          procedure XMLPrintNodeInfo(var T: Text); override;
{$endif DEBUG_NODE_XML}
          property statements : tnode read left write left;
       end;
       tblocknodeclass = class of tblocknode;

       ttempcreatenode = class;

       ttempinfoflag = (
         { temp can be kept in a register as far as the original creator is
          concerned }
         ti_may_be_in_reg,
         { the ttempcreatenode has been process and the temp's location is
           valid (-> the ttempdeletenode has not yet been processed, or
           in case it's a "create_to_normal()" one, the final ttemprefnode
           has not yet been processed) }
         ti_valid,
         { when performing a getcopy of a nodetree, we have to hook up the
           copies of ttemprefnodes and ttempdestroynode to the copied
           ttempinfo. this is done by setting hookoncopy in the original
           ttempinfo to point to the new one. if the temp is deleted via a
           regular ttempdeletenode, the hookoncopy is simply set to nil once
           it's processed. otherwise, it sets the ti_nextref_set_hookoncopy_nil
           and after processing the final ttemprefnode, hookoncopy is set to nil
         }
         ti_nextref_set_hookoncopy_nil,
         { the address of this temp is taken (-> cannot be kept in a register,
           even if the creator didn't mind)
         }
         ti_addr_taken,
         { temps can get an extra node tree that contains the value to which
           they should be initialised when they are created. this initialisation
           has to be performed right before the first reference to the temp.
           this flag indicates that the ttempcreatenode has been
           processed by pass_generate_code, but that the first ttemprefnode
           hasn't yet and hence will have to perform the initialisation
         }
         ti_executeinitialisation,
         { in case an expression like "inc(x[func()],1)" is translated into
           a regular addition, you have to create a temp to hold the address
           representing x[func()], since otherwise func() will be called twice
           and that can spell trouble in case it has side effects. on platforms
           without pointers, we cannot just take the address though. this flag
           has to be combined with ti_executeinitialisation above and will,
           rather than loading the value at the calculated location and store
           it in the temp, keep a copy of the calculated location if possible
           and required (not possible for regvars, because SSA may change their
           register, but not required for them either since calculating their
           location has no side-effects
         }
         ti_reference,
         { this temp only allows reading (makes it possible to safely use as
           reference under more circumstances)
         }
         ti_readonly,
         { if this is a managed temp, it doesn't have to be finalised before use
         }
         ti_nofini,
         { the value described by this temp. node is const/immutable, this is important for
           managed types like ansistrings where temp. refs are pointers to the actual value
           -- in this case, assignments to the temp do not increase the
             reference count, and if the assigned value was a temp itself then
             that temp is not deallocated until this temp is deleted (since
             otherwise the assigned value may be freed before the last use of
             the temp) }
         ti_const,
         { the temp. needs no final sync instruction if it is located in a register,
           so there are no loops involved in the usage of the temp.
         }
         ti_no_final_regsync,
         { this applied only to delete nodes: the single purpose of the temp. delete node is to clean up memory. In case
           of cse it might happen that the tempcreate node is optimized away so tempinfo is never initialized properly but
           the allocated memory must be disposed
           If a temp. node has this flag set, the life time of the temp. data must be determined by reg. life, the temp.
           location (in the sense of stack space/register) is never release }
         ti_cleanup_only
         );
       ttempinfoflags = set of ttempinfoflag;

     const
       tempinfostoreflags = [ti_may_be_in_reg,ti_addr_taken,ti_reference,ti_readonly,ti_no_final_regsync,ti_nofini,ti_const];

     type
       { to allow access to the location by temp references even after the temp has }
       { already been disposed and to make sure the coherency between temps and     }
       { temp references is kept after a getcopy                                    }
       ptempinfo = ^ttempinfo;
       ttempinfo = record
        private
         flags                      : ttempinfoflags;
        public
         { set to the copy of a tempcreate pnode (if it gets copied) so that the }
         { refs and deletenode can hook to this copy once they get copied too    }
         hookoncopy                 : ptempinfo;
         typedef                    : tdef;
         typedefderef               : tderef;
         temptype                   : ttemptype;
         owner                      : ttempcreatenode;
         withnode                   : tnode;
         location                   : tlocation;
         tempinitcode               : tnode;
       end;

       ttempinfoaccessor = class
         class procedure settempinfoflags(tempinfo: ptempinfo; const flags: ttempinfoflags); virtual;
         class function gettempinfoflags(tempinfo: ptempinfo): ttempinfoflags; static; inline;
       end;
       ttempinfoaccessorclass = class of ttempinfoaccessor;

       ttempbasenode = class(tnode)
        protected
          class var tempinfoaccessor: ttempinfoaccessorclass;
        protected
          procedure settempinfoflags(const tempflags: ttempinfoflags); inline;
          function gettempinfoflags: ttempinfoflags; inline;
        public
          tempinfo: ptempinfo;
          procedure includetempflag(flag: ttempinfoflag); inline;
          procedure excludetempflag(flag: ttempinfoflag); inline;
          property tempflags: ttempinfoflags read gettempinfoflags write settempinfoflags;
{$ifdef DEBUG_NODE_XML}
          procedure XMLPrintNodeInfo(var T: Text); override;
          procedure XMLPrintNodeData(var T: Text); override;
{$endif DEBUG_NODE_XML}
       end;

       { a node which will create a (non)persistent temp of a given type with a given  }
       { size (the size is separate to allow creating "void" temps with a custom size) }
       ttempcreatenode = class(ttempbasenode)
          size: tcgint;
          ftemplvalue : tnode;
          { * persistent temps are used in manually written code where the temp }
          { be usable among different statements and where you can manually say }
          { when the temp has to be freed (using a ttempdeletenode)             }
          { * non-persistent temps are mostly used in typeconversion helpers,   }
          { where the node that receives the temp becomes responsible for       }
          { freeing it. In this last case, you must use only one reference      }
          { to it and *not* generate a ttempdeletenode                          }
          constructor create(_typedef: tdef; _size: tcgint; _temptype: ttemptype;allowreg:boolean); virtual;
          constructor create_withnode(_typedef: tdef; _size: tcgint; _temptype: ttemptype; allowreg:boolean; withnode: tnode); virtual;
          constructor create_value(_typedef:tdef; _size: tcgint; _temptype: ttemptype;allowreg:boolean; templvalue: tnode);
          constructor create_reference(_typedef:tdef; _size: tcgint; _temptype: ttemptype;allowreg:boolean; templvalue: tnode; readonly: boolean);
          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;
          procedure printnodedata(var t:text);override;
{$ifdef DEBUG_NODE_XML}
          procedure XMLPrintNodeData(var T: Text); override;
{$endif DEBUG_NODE_XML}
        end;
       ttempcreatenodeclass = class of ttempcreatenode;

        { a node which is a reference to a certain temp }
        ttemprefnode = class(ttempbasenode)
          constructor create(const temp: ttempcreatenode); virtual;
          constructor ppuload(t:tnodetype;ppufile:tcompilerppufile);override;
          procedure ppuwrite(ppufile:tcompilerppufile);override;
          procedure resolveppuidx;override;
          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;
         private
          tempidx : longint;
        end;
       ttemprefnodeclass = class of ttemprefnode;

        { a node which removes a temp }
        ttempdeletenode = class(ttempbasenode)
          constructor create(const temp: ttempcreatenode); virtual;
          { this will convert the persistant temp to a normal temp
            for returning to the other nodes }
          constructor create_normal_temp(const temp: ttempcreatenode);
          constructor ppuload(t:tnodetype;ppufile:tcompilerppufile);override;
          procedure ppuwrite(ppufile:tcompilerppufile);override;
          procedure resolveppuidx;override;
          function dogetcopy: tnode; override;
          function pass_1: tnode; override;
          function pass_typecheck: tnode; override;
          function docompare(p: tnode): boolean; override;
          destructor destroy; override;
          procedure printnodedata(var t:text);override;
{$ifdef DEBUG_NODE_XML}
          procedure XMLPrintNodeData(var T: Text); override;
{$endif DEBUG_NODE_XML}
         protected
          release_to_normal : boolean;
        private
          tempidx : longint;
        end;
       ttempdeletenodeclass = class of ttempdeletenode;

    var
       cnothingnode : tnothingnodeclass = tnothingnode;
       cerrornode : terrornodeclass = terrornode;
       cspecializenode : tspecializenodeclass = tspecializenode;
       cfinalizetempsnode: tfinalizetempsnodeclass = tfinalizetempsnode;
       casmnode : tasmnodeclass = tasmnode;
       cstatementnode : tstatementnodeclass = tstatementnode;
       cblocknode : tblocknodeclass = tblocknode;
       ctempinfoaccessor : ttempinfoaccessorclass = ttempinfoaccessor;
       ctempcreatenode : ttempcreatenodeclass = ttempcreatenode;
       ctemprefnode : ttemprefnodeclass = ttemprefnode;
       ctempdeletenode : ttempdeletenodeclass = ttempdeletenode;

       { Create a blocknode and statement node for multiple statements
         generated internally by the parser }
       function  internalstatements(out laststatement:tstatementnode):tblocknode;
       function  laststatement(block:tblocknode):tstatementnode;
       procedure addstatement(var laststatement:tstatementnode;n:tnode);

       { if the complexity of n is "high", creates a reference temp to n's
         location and replace n with a ttemprefnode referring to that location }
       function maybereplacewithtempref(var n: tnode; var block: tblocknode; var stat: tstatementnode; size: ASizeInt; readonly: boolean): ttempcreatenode;
       { same as above, but create a regular temp rather than reference temp }
       function maybereplacewithtemp(var n: tnode; var block: tblocknode; var stat: tstatementnode; size: ASizeInt; allowreg: boolean): ttempcreatenode;

implementation

    uses
      verbose,globals,systems,
      ppu,
      symsym,symconst,symdef,defutil,defcmp,
      pass_1,
      nutils,nld,ncnv,
      procinfo
{$ifdef DEBUG_NODE_XML}
{$ifndef jvm}
      ,
      cpubase,
      cutils,
{$ifdef arm}
      agarmgas, { Needed for gas_shiftmode2str }
{$endif arm}
{$ifdef aarch64}
      agcpugas, { Needed for gas_shiftmode2str }
{$endif aarch64}
      itcpugas
{$endif jvm}
{$endif DEBUG_NODE_XML}
      ;


{*****************************************************************************
                                     Helpers
*****************************************************************************}

    function internalstatements(out laststatement:tstatementnode):tblocknode;
      begin
        { create dummy initial statement }
        laststatement := cstatementnode.create(cnothingnode.create,nil);
        result := cblocknode.create(laststatement);
        Include(result.blocknodeflags, bnf_strippable);
      end;


    function laststatement(block:tblocknode):tstatementnode;
      begin
        result:=tstatementnode(block.left);
        while assigned(result) and assigned(result.right) do
          result:=tstatementnode(result.right);
      end;


    procedure addstatement(var laststatement:tstatementnode;n:tnode);
      begin
        if assigned(laststatement.right) then
          internalerror(200204201);
        laststatement.right:=cstatementnode.create(n,nil);
        laststatement:=tstatementnode(laststatement.right);
      end;


    function maybereplacewithtempref(var n: tnode; var block: tblocknode; var stat: tstatementnode; size: ASizeInt; readonly: boolean): ttempcreatenode;
      begin
        result:=nil;
        if (node_complexity(n)>4) or
           might_have_sideeffects(n) then
          begin
            result:=ctempcreatenode.create_reference(n.resultdef,size,tt_persistent,true,n,readonly);
            typecheckpass(tnode(result));
            n:=ctemprefnode.create(result);
            typecheckpass(n);
            if not assigned(stat) then
              block:=internalstatements(stat);
            addstatement(stat,result)
          end;
      end;

    function maybereplacewithtemp(var n: tnode; var block: tblocknode; var stat: tstatementnode; size: ASizeInt; allowreg: boolean): ttempcreatenode;
      begin
        result:=nil;
        if (node_complexity(n)>4) or
           might_have_sideeffects(n) then
          begin
            result:=ctempcreatenode.create_value(n.resultdef,size,tt_persistent,allowreg,n);
            typecheckpass(tnode(result));
            n:=ctemprefnode.create(result);
            typecheckpass(n);
            if not assigned(stat) then
              block:=internalstatements(stat);
            addstatement(stat,result)
          end;
      end;

{*****************************************************************************
                             TFIRSTNOTHING
*****************************************************************************}

    constructor tnothingnode.create;
      begin
        inherited create(nothingn);
      end;


    function tnothingnode.pass_typecheck:tnode;
      begin
        result:=nil;
        resultdef:=voidtype;
      end;


    function tnothingnode.pass_1 : tnode;
      begin
        result:=nil;
        expectloc:=LOC_VOID;
      end;

{$ifdef DEBUG_NODE_XML}
    procedure TNothingNode.XMLPrintNodeTree(var T: Text);
      begin
        Write(T, PrintNodeIndention, '<', nodetype2str[nodetype]);
        XMLPrintNodeInfo(T);
        { "Nothing nodes" contain no data, so just use "/>" to terminate it early }
        WriteLn(T, ' />');
      end;
{$endif DEBUG_NODE_XML}

{*****************************************************************************
                             TFIRSTERROR
*****************************************************************************}

    constructor terrornode.create;

      begin
         inherited create(errorn);
      end;


    function terrornode.pass_typecheck:tnode;
      begin
         result:=nil;
         include(transientflags,tnf_error);
         codegenerror:=true;
         resultdef:=generrordef;
      end;


    function terrornode.pass_1 : tnode;
      begin
         result:=nil;
         expectloc:=LOC_VOID;
         codegenerror:=true;
      end;


    procedure terrornode.mark_write;
      begin
      end;


{*****************************************************************************
                             TSPECIALIZENODE
*****************************************************************************}

    constructor tspecializenode.create(l:tnode;g:boolean;s:tsym;u:boolean);
      begin
         inherited create(specializen,l);
         sym:=s;
         getaddr:=g;
         unit_specific:=u;
      end;

    constructor tspecializenode.create_inherited(l:tnode;g:boolean;s:tsym;i:tdef);
      begin
        create(l,g,s,false);
        inheriteddef:=i;
      end;


    function tspecializenode.pass_typecheck:tnode;
      begin
         result:=nil;
         resultdef:=cundefinedtype;
      end;


    function tspecializenode.pass_1:tnode;
      begin
         { such a node should not reach pass_1 }
         internalerror(2015071704);
         result:=nil;
         expectloc:=LOC_VOID;
         codegenerror:=true;
      end;


{*****************************************************************************
                             TFINALIZETEMPSNODE
*****************************************************************************}

    constructor tfinalizetempsnode.create;
      begin
        inherited create(finalizetempsn);
      end;

    function tfinalizetempsnode.pass_1: tnode;
      begin
        result:=nil;
        expectloc:=LOC_VOID;
      end;

    function tfinalizetempsnode.pass_typecheck: tnode;
      begin
        resultdef:=voidtype;
        result:=nil;
      end;

    function tfinalizetempsnode.docompare(p: tnode): boolean;
      begin
        { these nodes should never be coalesced }
        result:=false;
      end;


{*****************************************************************************
                            TSTATEMENTNODE
*****************************************************************************}

    constructor tstatementnode.create(l,r : tnode);

      begin
         inherited create(statementn,l,r);
      end;


    function is_exit_statement(var n: tnode; arg: pointer): foreachnoderesult;
      begin
        if (n.nodetype<>exitn) then
          result:=fen_false
        else
          result:=fen_norecurse_true;
      end;


    function no_exit_statement_in_block(n: tnode): boolean;
      begin
        result:=not foreachnodestatic(n,@is_exit_statement,nil);
      end;


    function tstatementnode.simplify(forinline: boolean) : tnode;
      begin
        result:=nil;
        { these "optimizations" are only to make it more easy to recognise    }
        { blocknodes which at the end of inlining only contain one single     }
        { statement. Simplifying inside blocknode.simplify could be dangerous }
        { because if the main blocknode which makes up a procedure/function   }
        { body were replaced with a statementn/nothingn, this could cause     }
        { problems elsewhere in the compiler which expects a blocknode        }

        { remove next statement if it's a nothing-statement (since if it's }
        { the last, it won't remove itself -- see next simplification)     }
        while assigned(right) and
              (tstatementnode(right).left.nodetype = nothingn) do
          begin
            result:=tstatementnode(right).right;
            tstatementnode(right).right:=nil;
            right.free;
            right:=result;
            result:=nil;
          end;

        { Remove initial nothingn if there are other statements. If there }
        { are no other statements, returning nil doesn't help (will be    }
        { interpreted as "can't be simplified") and replacing the         }
        { statementnode with a nothingnode cannot be done (because it's   }
        { possible this statementnode is a child of a blocknode, and      }
        { blocknodes are expected to only contain statementnodes)         }
        if (left.nodetype = nothingn) and
           assigned(right) then
          begin
            result:=right;
            right:=nil;
            exit;
          end;

        { if the current statement contains a block with one statement,
          replace the current statement with that block's statement
          (but only if the block does not have nf_block_with_exit set
           or has no exit statement, because otherwise it needs an own
           exit label, see tests/test/tinline10)

           Further, it might not be the user code entry
        }
        if (left.nodetype = blockn) and
           ((left.flags*[nf_block_with_exit,nf_usercode_entry]=[]) or
            ((left.flags*[nf_block_with_exit,nf_usercode_entry]=[nf_block_with_exit]) and no_exit_statement_in_block(left))) and
           assigned(tblocknode(left).left) and
           not assigned(tstatementnode(tblocknode(left).left).right) then
          begin
            result:=tblocknode(left).left;
            tstatementnode(result).right:=right;
            right:=nil;
            tblocknode(left).left:=nil;
            exit;
          end;
      end;


    function tstatementnode.pass_typecheck:tnode;
      begin
         result:=nil;
         resultdef:=voidtype;

         { left is the statement itself calln assignn or a complex one }
         typecheckpass(left);
         if codegenerror then
           exit;

         { right is the next statement in the list }
         if assigned(right) then
           typecheckpass(right);
         if codegenerror then
           exit;
      end;


    function tstatementnode.pass_1 : tnode;
      begin
         result:=nil;
         { left is the statement itself calln assignn or a complex one }
         firstpass(left);
         if codegenerror then
           exit;
         expectloc:=left.expectloc;
         { right is the next in the list }
         if assigned(right) then
           firstpass(right);
         if codegenerror then
           exit;
      end;


    procedure tstatementnode.printnodetree(var t:text);
      begin
        printnodelist(t);
      end;

{*****************************************************************************
                             TBLOCKNODE
*****************************************************************************}

    constructor tblocknode.create(l : tnode);

      begin
         inherited create(blockn,l);
         blocknodeflags:=[];
      end;

    destructor tblocknode.destroy;

      var
        hp, next: tstatementnode;
      begin
        hp := tstatementnode(left);
        left := nil;
        while assigned(hp) do
          begin
            next := tstatementnode(hp.right);
            hp.right := nil;
            hp.free;
            hp := next;
          end;
        inherited destroy;
      end;


    constructor tblocknode.ppuload(t:tnodetype;ppufile:tcompilerppufile);
      begin
        inherited ppuload(t,ppufile);
        ppufile.getset(tppuset1(blocknodeflags));
      end;


    procedure tblocknode.ppuwrite(ppufile:tcompilerppufile);
      begin
        inherited ppuwrite(ppufile);
        ppufile.putset(tppuset1(blocknodeflags));
      end;


    function tblocknode.dogetcopy : tnode;
      begin
        Result:=inherited dogetcopy;
        TBlockNode(Result).blocknodeflags:=blocknodeflags;
      end;


    function NodesEqual(var n: tnode; arg: pointer): foreachnoderesult;
      begin
        if n.IsEqual(tnode(arg)) then
          result:=fen_norecurse_true
        else
          result:=fen_false;
      end;


    function tblocknode.simplify(forinline : boolean): tnode;
      const
        NodeStripTerminators = [labeln, asmn, tempcreaten, tempdeleten];

      var
        n, p, first, last: tstatementnode;
{$ifdef break_inlining}
        a : array[0..3] of tstatementnode;
{$endif break_inlining}
      begin
        result := nil;
        { Warning: never replace a blocknode with another node type,
          since the block may be the main block of a procedure/function/
          main program body, and those nodes should always be blocknodes
          since that's what the compiler expects elsewhere. }

        if assigned(left) then
          begin
            if not assigned(tstatementnode(left).right) then
              begin
                { Block has a lone statement }
                case tstatementnode(left).left.nodetype of
                  blockn:
                    begin
                      { if the current block contains only one statement, and
                        this one statement only contains another block, replace
                        this block with that other block.                       }
                      result:=tstatementnode(left).left;
                      tstatementnode(left).left:=nil;
                      { make sure the nf_block_with_exit flag is safeguarded }
                      result.flags:=result.flags+(flags*[nf_block_with_exit,nf_usercode_entry]);
                      exit;
                    end;
                  nothingn:
                    begin
                      { if the block contains only a statement with a nothing node,
                        get rid of the statement }
                      left.Free;
                      left:=nil;
                      exit;
                    end;
                  else
                    ;
                end;
              end
            else if forinline or (cs_opt_level2 in current_settings.optimizerswitches) then
              begin
                n := TStatementNode(left);
                while Assigned(n) do
                  begin
                    case n.left.nodetype of
                      raisen, exitn, breakn, continuen, goton:
                        { Remove all subsequent statements, stopping only at a
                          label or asm block since code can theoretically jump
                          to them.  Also, don't delete temp creates and deletes }
                        begin
                          last := n;
                          p := TStatementNode(n.Next);
                          while Assigned(p) do
                            begin
                              if has_node_of_type(TStatementNode(p).left, NodeStripTerminators) then
                                Break;

                              last := p;
                              p := TStatementNode(p.Next);
                            end;

                          if (last <> n) then
                            begin
                              last.next := nil; { Make sure we stop one before p }
                              n.next.Free;
                              n.next := p;
                              n := p;
                              Continue;
                            end;
                        end;
                      else
                        ;
                    end;

                    { Look one statement ahead in case it can be deleted - we
                      need the previous statement to stitch the tree correctly
                    }
                    p := TStatementNode(n.Next);
                    if not Assigned(p) then
                      Break;

                    if Assigned(p.left) then
                      begin
                        case p.left.nodetype of
                          blockn:
                            if (bnf_strippable in TBlockNode(p.left).blocknodeflags) and
                              ((p.left.flags * [nf_block_with_exit] = []) or no_exit_statement_in_block(p.left)) then
                              begin
                                { Attempt to merge this block into the main statement
                                  set }

                                { Find last statement }
                                first := TStatementNode(TBlockNode(p.left).PruneKeepLeft());
                                if Assigned(first) then
                                  begin
                                    last := first;
                                    while Assigned(last.right) do
                                      last := TStatementNode(last.right);

                                    n.right := first;
                                  end
                                else
                                  last := n;

                                last.right := p.PruneKeepRight();

                                { make sure the nf_usercode_entry flag is safeguarded }
                                Flags := Flags + (p.left.flags * [nf_usercode_entry]);

                                p.Free;
                                Continue;
                              end;
                          else
                            ;
                        end;
                      end;
                    n := TStatementNode(n.Next);
                  end;
              end;
          end;
{$ifdef break_inlining}
        { simple sequence of tempcreate, assign and return temp.? }
        if GetStatements(left,a) and
          (a[0].left.nodetype=tempcreaten) and
          (a[1].left.nodetype=assignn) and
          (actualtargetnode(@tassignmentnode(a[1].left).left)^.nodetype=temprefn) and
          (a[2].left.nodetype=tempdeleten) and
          (a[3].left.nodetype=temprefn) and
          (ttempcreatenode(a[0].left).tempinfo=ttemprefnode(actualtargetnode(@tassignmentnode(a[1].left).left)^).tempinfo) and
          (ttempcreatenode(a[0].left).tempinfo=ttempdeletenode(a[2].left).tempinfo) and
          (ttempcreatenode(a[0].left).tempinfo=ttemprefnode(a[3].left).tempinfo) and
          { the temp. node might not be references inside the assigned expression }
          not(foreachnodestatic(tassignmentnode(a[1].left).right,@NodesEqual,actualtargetnode(@tassignmentnode(a[1].left).left)^)) then
          begin
            result:=tassignmentnode(a[1].left).right;
            tassignmentnode(a[1].left).right:=nil;
            { ensure the node is first passed, so the resultdef does not get changed if the
              the type conv. below is merged }
            firstpass(result);
            result:=ctypeconvnode.create_internal(result,ttemprefnode(a[3].left).resultdef);
            firstpass(result);
            exit;
          end;
{$endif break_inlining}
      end;


    function tblocknode.pass_typecheck:tnode;
      var
         hp : tstatementnode;
      begin
         result:=nil;
         resultdef:=voidtype;

         hp:=tstatementnode(left);
         while assigned(hp) do
           begin
              if assigned(hp.left) then
                begin
                   codegenerror:=false;
                   typecheckpass(hp.left);
                   { the resultdef of the block is the last type that is
                     returned. Normally this is a voidtype. But when the
                     compiler inserts a block of multiple statements then the
                     last entry can return a value }
                   resultdef:=hp.left.resultdef;
                end;
              hp:=tstatementnode(hp.right);
           end;
      end;


    function tblocknode.pass_1 : tnode;
      var
         hp : tstatementnode;
         FirstNode: Boolean;
         //count : longint;
      begin
         result:=nil;
         expectloc:=LOC_VOID;
         //count:=0;
         hp:=tstatementnode(left);
         FirstNode := True;
         while assigned(hp) do
           begin
              if assigned(hp.left) then
                begin
                   { Calling firstpass on a statement node normally causes
                     problems, so we have to be a little bit hacky if we want
                     to remove nothing nodes }
                   codegenerror:=false;
                   firstpass(tnode(hp));
                   { If the first node gets deleted, left must be updated,
                     otherwise it will be a dangling pointer }
                   if FirstNode then
                     begin
                       { If multiple statements are to be removed, they would
                         have all been removed by the firstpass call above, so
                         the next one will not be removed, hence it's safe to
                         set FirstNode to false }
                       FirstNode := False;
                       left := hp;
                     end;

                   if assigned(hp.left) then
                     hp.expectloc:=hp.left.expectloc;
                end;
              expectloc:=hp.expectloc;
              //inc(count);
              hp:=tstatementnode(hp.right);
           end;
      end;

{$ifdef state_tracking}
      function Tblocknode.track_state_pass(exec_known:boolean):boolean;

      var hp:Tstatementnode;

      begin
        track_state_pass:=false;
        hp:=Tstatementnode(left);
        while assigned(hp) do
            begin
                if hp.left.track_state_pass(exec_known) then
                    track_state_pass:=true;
                hp:=Tstatementnode(hp.right);
            end;
      end;
{$endif state_tracking}
{$ifdef DEBUG_NODE_XML}
    procedure TBlockNode.XMLPrintNodeInfo(var T: Text);
      var
        i_bnf: TBlockNodeFlag;
        First: Boolean;
      begin
        inherited XMLPrintNodeInfo(T);

        First := True;
        for i_bnf in blocknodeflags do
          begin
            if First then
              begin
                Write(T, ' blocknodeflags="', i_bnf);
                First := False;
              end
            else
              Write(T, ',', i_bnf)
          end;

        if not First then
          write(T,'"');
      end;
{$endif DEBUG_NODE_XML}

{*****************************************************************************
                             TASMNODE
*****************************************************************************}

    constructor tasmnode.create(p : TAsmList);
      begin
        inherited create(asmn);
        p_asm:=p;
        asmnodeflags:=[];
        currenttai:=nil;
      end;


    constructor tasmnode.create_get_position;
      begin
        inherited create(asmn);
        p_asm:=nil;
        asmnodeflags:=[asmnf_get_asm_position];
        currenttai:=nil;
      end;


    destructor tasmnode.destroy;
      begin
        if assigned(p_asm) then
          p_asm.free;
        inherited destroy;
      end;


    constructor tasmnode.ppuload(t:tnodetype;ppufile:tcompilerppufile);
      var
        hp : tai;
      begin
        inherited ppuload(t,ppufile);
        ppufile.getset(tppuset1(asmnodeflags));
        if not(asmnf_get_asm_position in asmnodeflags) then
          begin
            p_asm:=TAsmList.create;
            repeat
              hp:=ppuloadai(ppufile);
              if hp=nil then
                break;
              p_asm.concat(hp);
              if hp.typ=ait_section then
                inc(p_asm.section_count);
            until false;
          end
        else
          p_asm:=nil;
        currenttai:=nil;
      end;


    procedure tasmnode.ppuwrite(ppufile:tcompilerppufile);
      var
        hp : tai;
      begin
        inherited ppuwrite(ppufile);
        ppufile.putset(tppuset1(asmnodeflags));
{ TODO: FIXME Add saving of register sets}
        if not(asmnf_get_asm_position in asmnodeflags) then
          begin
            hp:=tai(p_asm.first);
            while assigned(hp) do
             begin
               ppuwriteai(ppufile,hp);
               hp:=tai(hp.next);
             end;
            { end is marked by a nil }
            ppuwriteai(ppufile,nil);
          end;
      end;


    procedure tasmnode.buildderefimpl;
      var
        hp : tai;
      begin
        inherited buildderefimpl;
        if not(asmnf_get_asm_position in asmnodeflags) then
          begin
            hp:=tai(p_asm.first);
            while assigned(hp) do
             begin
               hp.buildderefimpl;
               hp:=tai(hp.next);
             end;
          end;
      end;


    procedure tasmnode.derefimpl;
      var
        hp : tai;
      begin
        inherited derefimpl;
        if not(asmnf_get_asm_position in asmnodeflags) then
          begin
            hp:=tai(p_asm.first);
            while assigned(hp) do
             begin
               hp.derefimpl;
               hp:=tai(hp.next);
             end;
          end;
      end;


    function tasmnode.dogetcopy: tnode;
      var
        n: tasmnode;
      begin
        n:=tasmnode(inherited dogetcopy);
        n.asmnodeflags:=asmnodeflags;
        if assigned(p_asm) then
          begin
            n.p_asm:=TAsmList.create;
            n.p_asm.concatlistcopy(p_asm);
          end
        else
          n.p_asm:=nil;
        n.currenttai:=currenttai;
        result:=n;
      end;


    function tasmnode.pass_typecheck:tnode;
      begin
        result:=nil;
        resultdef:=voidtype;
        if not(asmnf_get_asm_position in asmnodeflags) then
          include(current_procinfo.flags,pi_has_assembler_block);
      end;


    function tasmnode.pass_1 : tnode;
      begin
        result:=nil;
        expectloc:=LOC_VOID;
      end;


    function tasmnode.docompare(p: tnode): boolean;
      begin
        { comparing of asmlists is not implemented (JM) }
        docompare := false;
      end;

{$ifdef DEBUG_NODE_XML}
    procedure TAsmNode.XMLPrintNodeInfo(var T: Text);
      var
        i: TAsmNodeFlag;
        First: Boolean;
      begin
        inherited XMLPrintNodeInfo(T);
        First := True;
        for i in asmnodeflags do
          begin
            if First then
              begin
                Write(T, ' asmnodeflags="', i);
                First := False;
              end
            else
              Write(T, ',', i)
          end;
        if not First then
          Write(T, '"');
      end;


    procedure TAsmNode.XMLProcessInstruction(var T: Text; p: tai);
      var
        ThisOp, ThisOper: string;
        X: Integer;
      begin
        case p.typ of
          { Instructions are handled on a per-platform basis }

          ait_label:
            WriteLn(T, PrintNodeIndention, tai_label(p).labsym.name, ':');

          ait_const:
            begin
              case tai_const(p).consttype of
                aitconst_64bit:
                  WriteLn(T, PrintNodeIndention, '.quad 0x', hexstr(tai_const(p).value, 16));
                aitconst_32bit:
                  WriteLn(T, PrintNodeIndention, '.long 0x', hexstr(tai_const(p).value, 8));
                aitconst_16bit:
                  WriteLn(T, PrintNodeIndention, '.word 0x', hexstr(tai_const(p).value, 4));
                aitconst_8bit:
                  WriteLn(T, PrintNodeIndention, '.byte 0x', hexstr(tai_const(p).value, 2));
                else
                  WriteLn(T, PrintNodeIndention, '; (Other constant)');
              end;
            end;

          ait_realconst:
            WriteLn(T, PrintNodeIndention, '; (Real constant)');

          else
            { Do nothing };
        end;
      end;


    class procedure TAsmNode.XMLPadString(var S: string; Len: Integer);
      var
        X, C: Integer;
      begin
        C := Length(S);
        if C < Len then
          begin
            SetLength(S, Len);
            for X := C + 1 to Len do
              S[X] := ' '
          end;
      end;


    function TAsmNode.XMLFormatOp(const Oper: POper): string;
      begin
        case Oper^.typ of
          top_reg:
            Result := gas_regname(Oper^.reg);

          top_local:
            { Local variable }
            Result := TSym(Oper^.localoper^.localsym).prettyname;

          top_bool:
            begin
              if Oper^.b then
                Result := 'TRUE'
              else
                Result := 'FALSE';
            end;
          else
            Result := '(unk)';
        end;
      end;


    procedure TAsmNode.XMLPrintNodeData(var T: Text);
      begin
        if not Assigned(p_asm) then
          Exit;

        WriteLn(T, PrintNodeIndention, '(Assembler output not currently supported on this platform)');
      end;
{$endif DEBUG_NODE_XML}

{*****************************************************************************
                          TEMPBASENODE
*****************************************************************************}

    class procedure ttempinfoaccessor.settempinfoflags(tempinfo: ptempinfo; const flags: ttempinfoflags);
      begin
        tempinfo^.flags:=flags;
      end;


    class function ttempinfoaccessor.gettempinfoflags(tempinfo: ptempinfo): ttempinfoflags;
      begin
        result:=tempinfo^.flags;
      end;


{*****************************************************************************
                          TEMPBASENODE
*****************************************************************************}

    procedure ttempbasenode.settempinfoflags(const tempflags: ttempinfoflags);
      begin
        ctempinfoaccessor.settempinfoflags(tempinfo,tempflags);
      end;


    function ttempbasenode.gettempinfoflags: ttempinfoflags;
      begin
        result:=ctempinfoaccessor.gettempinfoflags(tempinfo);
      end;


    procedure ttempbasenode.includetempflag(flag: ttempinfoflag);
      begin
        { go through settempinfoflags() so it can filter out unsupported tempflags }
        settempinfoflags(gettempinfoflags+[flag])
      end;


    procedure ttempbasenode.excludetempflag(flag: ttempinfoflag);
      begin
        { go through settempinfoflags() so it can prevent required tempflags from
          being removed (if any) }
        settempinfoflags(gettempinfoflags-[flag])
      end;

{$ifdef DEBUG_NODE_XML}
    procedure TTempBaseNode.XMLPrintNodeInfo(var T: Text);
      begin
        inherited XMLPrintNodeInfo(T);

        { The raw pointer is the only way to uniquely identify the temp }
        Write(T, ' id="', WritePointer(tempinfo), '"');
      end;


    procedure TTempBaseNode.XMLPrintNodeData(var T: Text);
      var
        Flag: TTempInfoFlag;
        NotFirst: Boolean;
      begin
        inherited XMLPrintNodeData(t);

        if not assigned(tempinfo) then
          exit;

        WriteLn(T, PrintNodeIndention, '<typedef>', SanitiseXMLString(tempinfo^.typedef.typesymbolprettyname), '</typedef>');

        NotFirst := False;
        for Flag := Low(TTempInfoFlag) to High(TTempInfoFlag) do
          if (Flag in tempinfo^.flags) then
            if not NotFirst then
              begin
                Write(T, PrintNodeIndention, '<tempflags>', Flag);
                NotFirst := True;
              end
            else
              Write(T, ',', Flag);

        if NotFirst then
          WriteLn(T, '</tempflags>')
        else
          WriteLn(T, PrintNodeIndention, '<tempflags />');

        WriteLn(T, PrintNodeIndention, '<temptype>', tempinfo^.temptype, '</temptype>');
      end;
{$endif DEBUG_NODE_XML}

{*****************************************************************************
                          TEMPCREATENODE
*****************************************************************************}

    constructor ttempcreatenode.create(_typedef:tdef; _size: tcgint; _temptype: ttemptype;allowreg:boolean);
      begin
        inherited create(tempcreaten);
        size := _size;
        new(tempinfo);
        fillchar(tempinfo^,sizeof(tempinfo^),0);
        tempinfo^.typedef := _typedef;
        tempinfo^.temptype := _temptype;
        tempinfo^.owner := self;
        tempinfo^.withnode := nil;
        if allowreg and
           { temp must fit a single register }
           (tstoreddef(_typedef).is_fpuregable or
            (tstoreddef(_typedef).is_intregable and
             (_size<=TCGSize2Size[OS_64]))) and
           { size of register operations must be known }
           (def_cgsize(_typedef)<>OS_NO) and
           { no init/final needed }
           not is_managed_type(_typedef) then
          includetempflag(ti_may_be_in_reg);
      end;


    constructor ttempcreatenode.create_withnode(_typedef: tdef; _size: tcgint; _temptype: ttemptype; allowreg:boolean; withnode: tnode);
      begin
        self.create(_typedef,_size,_temptype,allowreg);
        tempinfo^.withnode:=withnode.getcopy;
      end;


    constructor ttempcreatenode.create_value(_typedef:tdef; _size: tcgint; _temptype: ttemptype;allowreg:boolean; templvalue: tnode);
      begin
        self.create(_typedef,_size,_temptype,allowreg);
        // store in ppuwrite
        ftemplvalue:=templvalue;
        // create from stored ftemplvalue in ppuload
        tempinfo^.tempinitcode:=cassignmentnode.create(ctemprefnode.create(self),ftemplvalue);
      end;


     constructor ttempcreatenode.create_reference(_typedef: tdef; _size: tcgint; _temptype: ttemptype; allowreg: boolean; templvalue: tnode; readonly: boolean);
      begin
        // store in ppuwrite
        self.create(_typedef,_size,_temptype,allowreg);
        ftemplvalue:=templvalue;
        // no assignment node, just the tempvalue
        tempinfo^.tempinitcode:=ftemplvalue;
        includetempflag(ti_reference);
        if readonly then
          includetempflag(ti_readonly);
      end;


    function ttempcreatenode.dogetcopy: tnode;
      var
        n: ttempcreatenode;
      begin
        n := ttempcreatenode(inherited dogetcopy);
        n.size := size;

        new(n.tempinfo);
        fillchar(n.tempinfo^,sizeof(n.tempinfo^),0);
        n.tempinfo^.owner:=n;
        n.tempinfo^.typedef := tempinfo^.typedef;
        n.tempinfo^.temptype := tempinfo^.temptype;
        n.tempflags := tempflags * tempinfostoreflags;

        { when the tempinfo has already a hookoncopy then it is not
          reset by a tempdeletenode }
        if assigned(tempinfo^.hookoncopy) then
          internalerror(200211262);
        { signal the temprefs that the temp they point to has been copied, }
        { so that if the refs get copied as well, they can hook themselves }
        { to the copy of the temp                                          }
        tempinfo^.hookoncopy := n.tempinfo;
        excludetempflag(ti_nextref_set_hookoncopy_nil);

        if assigned(tempinfo^.withnode) then
          n.tempinfo^.withnode := tempinfo^.withnode.getcopy
        else
          n.tempinfo^.withnode := nil;

        if assigned(tempinfo^.tempinitcode) then
          n.tempinfo^.tempinitcode := tempinfo^.tempinitcode.getcopy
        else
          n.tempinfo^.tempinitcode := nil;

        result := n;
      end;


    constructor ttempcreatenode.ppuload(t:tnodetype;ppufile:tcompilerppufile);
      begin
        inherited ppuload(t,ppufile);

        size:=ppufile.getlongint;
        new(tempinfo);
        fillchar(tempinfo^,sizeof(tempinfo^),0);
        ppufile.getset(tppuset2(tempinfo^.flags));
        ppufile.getderef(tempinfo^.typedefderef);
        tempinfo^.temptype := ttemptype(ppufile.getbyte);
        tempinfo^.owner:=self;
        tempinfo^.withnode:=ppuloadnode(ppufile);
        ftemplvalue:=ppuloadnode(ppufile);
      end;


    procedure ttempcreatenode.ppuwrite(ppufile:tcompilerppufile);
      begin
        inherited ppuwrite(ppufile);
        ppufile.putlongint(size);
        ppufile.putset(tppuset2(tempinfo^.flags));
        ppufile.putderef(tempinfo^.typedefderef);
        ppufile.putbyte(byte(tempinfo^.temptype));
        ppuwritenode(ppufile,tempinfo^.withnode);
        ppuwritenode(ppufile,ftemplvalue);
      end;


    procedure ttempcreatenode.buildderefimpl;
      begin
        inherited buildderefimpl;
        tempinfo^.typedefderef.build(tempinfo^.typedef);
        if assigned(tempinfo^.withnode) then
          tempinfo^.withnode.buildderefimpl;
        if assigned(ftemplvalue) then
          ftemplvalue.buildderefimpl;
      end;


    procedure ttempcreatenode.derefimpl;
      begin
        inherited derefimpl;
        tempinfo^.typedef:=tdef(tempinfo^.typedefderef.resolve);
        if assigned(tempinfo^.withnode) then
          tempinfo^.withnode.derefimpl;
        if assigned(ftemplvalue) then
          begin
            ftemplvalue.derefimpl;
            tempinfo^.tempinitcode:=cassignmentnode.create(ctemprefnode.create(self),ftemplvalue);
          end;
      end;


    function ttempcreatenode.pass_1 : tnode;
      begin
        result := nil;
        expectloc:=LOC_VOID;
        { temps which are immutable do not need to be initialized/finalized }
        if (tempinfo^.typedef.needs_inittable) and not(ti_const in tempflags) then
          include(current_procinfo.flags,pi_needs_implicit_finally);
        if assigned(tempinfo^.withnode) then
          firstpass(tempinfo^.withnode);
        if assigned(tempinfo^.tempinitcode) then
          firstpass(tempinfo^.tempinitcode);
        inc(current_procinfo.estimatedtempsize,size);
        { if a temp. create node is loaded from a ppu, it could be that the unit was compiled with other settings which
          enabled a certain type to be stored in a register while the current settings do not support this, so correct this here
          if needed
        }
        if not(tstoreddef(tempinfo^.typedef).is_fpuregable) and not(tstoreddef(tempinfo^.typedef).is_intregable) and (ti_may_be_in_reg in tempflags) then
          excludetempflag(ti_may_be_in_reg);
      end;


    function ttempcreatenode.pass_typecheck: tnode;
      begin
        result := nil;
        { a tempcreatenode doesn't have a resultdef, only temprefnodes do }
        resultdef := voidtype;
        if assigned(tempinfo^.withnode) then
          typecheckpass(tempinfo^.withnode);
        if assigned(tempinfo^.tempinitcode) then
          typecheckpass(tempinfo^.tempinitcode);
      end;


    function ttempcreatenode.docompare(p: tnode): boolean;
      begin
        result :=
          inherited docompare(p) and
          (ttempcreatenode(p).size = size) and
          (ttempcreatenode(p).tempflags*tempinfostoreflags=tempflags*tempinfostoreflags) and
          equal_defs(ttempcreatenode(p).tempinfo^.typedef,tempinfo^.typedef) and
          (ttempcreatenode(p).tempinfo^.withnode.isequal(tempinfo^.withnode)) and
          (ttempcreatenode(p).tempinfo^.tempinitcode.isequal(tempinfo^.tempinitcode));
      end;


    procedure ttempcreatenode.printnodedata(var t:text);
      var
        f: ttempinfoflag;
        first: Boolean;
      begin
        inherited printnodedata(t);
        writeln(t,printnodeindention,'size = ',size,', temptypedef = ',tempinfo^.typedef.typesymbolprettyname,' = "',
          tempinfo^.typedef.GetTypeName,'", tempinfo = $',hexstr(ptrint(tempinfo),sizeof(ptrint)*2));
        write(t,printnodeindention,'[');
        first:=true;
        for f in tempflags do
          begin
            if not(first) then
              write(t,',');
            write(t,f);
            first:=false;
          end;
        writeln(t,']');
        writeln(t,printnodeindention,'tempinit =');
        printnode(t,tempinfo^.tempinitcode);
      end;

{$ifdef DEBUG_NODE_XML}
    procedure TTempCreateNode.XMLPrintNodeData(var T: Text);
      begin
        inherited XMLPrintNodeData(T);
        WriteLn(T, PrintNodeIndention, '<size>', size, '</size>');
        if Assigned(TempInfo^.TempInitCode) then
          begin
            WriteLn(T, PrintNodeIndention, '<tempinit>');
            PrintNodeIndent;
            XMLPrintNode(T, TempInfo^.TempInitCode);
            PrintNodeUnindent;
            WriteLn(T, PrintNodeIndention, '</tempinit>');
          end
        else
          WriteLn(T, PrintNodeIndention, '<tempinit />');
      end;
{$endif DEBUG_NODE_XML}

{*****************************************************************************
                             TEMPREFNODE
*****************************************************************************}

    constructor ttemprefnode.create(const temp: ttempcreatenode);
      begin
        inherited create(temprefn);
        tempinfo := temp.tempinfo;
      end;


    function ttemprefnode.dogetcopy: tnode;
      var
        n: ttemprefnode;
      begin
        n := ttemprefnode(inherited dogetcopy);

        if assigned(tempinfo^.hookoncopy) then
          { if the temp has been copied, assume it becomes a new }
          { temp which has to be hooked by the copied reference  }
          begin
            { hook the ref to the copied temp }
            n.tempinfo := tempinfo^.hookoncopy;
            { if we passed a ttempdeletenode that changed the temp }
            { from a persistent one into a normal one, we must be  }
            { the last reference (since our parent should free the }
            { temp (JM)                                            }
            if (ti_nextref_set_hookoncopy_nil in tempflags) then
              tempinfo^.hookoncopy := nil;
          end
        else
          { if the temp we refer to hasn't been copied, assume }
          { we're just a new reference to that temp            }
          begin
            n.tempinfo := tempinfo;
          end;

        if not assigned(n.tempinfo) then
          internalerror(2005071901);

        result := n;
      end;


    constructor ttemprefnode.ppuload(t:tnodetype;ppufile:tcompilerppufile);
      begin
        inherited ppuload(t,ppufile);
        tempidx:=ppufile.getlongint;
      end;


    procedure ttemprefnode.ppuwrite(ppufile:tcompilerppufile);
      begin
        inherited ppuwrite(ppufile);
        ppufile.putlongint(tempinfo^.owner.ppuidx);
      end;


    procedure ttemprefnode.resolveppuidx;
      var
        temp : ttempcreatenode;
      begin
        temp:=ttempcreatenode(nodeppuidxget(tempidx));
        if temp.nodetype<>tempcreaten then
          internalerror(200311075);
        tempinfo:=temp.tempinfo;
      end;


    function ttemprefnode.pass_1 : tnode;
      begin
        expectloc := LOC_REFERENCE;
        if not tempinfo^.typedef.needs_inittable and
           (ti_may_be_in_reg in tempflags) then
          begin
            if tempinfo^.typedef.typ=floatdef then
              begin
                if not use_vectorfpu(tempinfo^.typedef) then
                  if (tempinfo^.temptype = tt_persistent) then
                    expectloc := LOC_CFPUREGISTER
                  else
                    expectloc := LOC_FPUREGISTER
                else
                  if (tempinfo^.temptype = tt_persistent) then
                    expectloc := LOC_CMMREGISTER
                  else
                    expectloc := LOC_MMREGISTER
              end
            else
              begin
                if (tempinfo^.temptype = tt_persistent) then
                  expectloc := LOC_CREGISTER
                else
                  expectloc := LOC_REGISTER;
              end;
          end;
        result := nil;
      end;


    function ttemprefnode.pass_typecheck: tnode;
      begin
        { check if the temp is already resultdef passed }
        if not assigned(tempinfo^.typedef) then
          internalerror(200108233);
        result := nil;
        resultdef := tempinfo^.typedef;
      end;


    function ttemprefnode.docompare(p: tnode): boolean;
      begin
        result :=
          inherited docompare(p) and
          (ttemprefnode(p).tempinfo = tempinfo);
      end;


    procedure ttemprefnode.mark_write;
      begin
        include(flags,nf_write);
      end;


    procedure ttemprefnode.printnodedata(var t:text);
      var
        f : ttempinfoflag;
        notfirst : Boolean;
      begin
        inherited printnodedata(t);
        write(t,printnodeindention,'temptypedef = ',tempinfo^.typedef.typesymbolprettyname,' = "',
          tempinfo^.typedef.GetTypeName,'", (tempinfo = $',hexstr(ptrint(tempinfo),sizeof(ptrint)*2),' flags = [');
        notfirst:=false;
        for f in tempinfo^.flags do
          begin
            if notfirst then
              write(t,',');
            write(t,f);
            notfirst:=true;
          end;
        writeln(t,'])');
      end;


{*****************************************************************************
                             TEMPDELETENODE
*****************************************************************************}

    constructor ttempdeletenode.create(const temp: ttempcreatenode);
      begin
        inherited create(tempdeleten);
        tempinfo := temp.tempinfo;
        release_to_normal := false;
      end;


    constructor ttempdeletenode.create_normal_temp(const temp: ttempcreatenode);
      begin
        inherited create(tempdeleten);
        tempinfo := temp.tempinfo;
        release_to_normal := true;
        if tempinfo^.temptype <> tt_persistent then
          internalerror(200204211);
      end;


    function ttempdeletenode.dogetcopy: tnode;
      var
        n: ttempdeletenode;
      begin
        n:=ttempdeletenode(inherited dogetcopy);
        n.release_to_normal:=release_to_normal;

        if assigned(tempinfo^.hookoncopy) then
          { if the temp has been copied, assume it becomes a new }
          { temp which has to be hooked by the copied deletenode }
          begin
            { hook the tempdeletenode to the copied temp }
            n.tempinfo:=tempinfo^.hookoncopy;
            { the temp shall not be used, reset hookoncopy    }
            { Only if release_to_normal is false, otherwise   }
            { the temp can still be referenced once more (JM) }
            if (not release_to_normal) then
              tempinfo^.hookoncopy:=nil
            else
              includetempflag(ti_nextref_set_hookoncopy_nil);
          end
        else
          { if the temp we refer to hasn't been copied, we have a }
          { problem since that means we now have two delete nodes }
          { for one temp                                          }
          internalerror(200108234);
        result:=n;
      end;


    constructor ttempdeletenode.ppuload(t:tnodetype;ppufile:tcompilerppufile);
      begin
        inherited ppuload(t,ppufile);
        tempidx:=ppufile.getlongint;
        release_to_normal:=(ppufile.getbyte<>0);
      end;


    procedure ttempdeletenode.ppuwrite(ppufile:tcompilerppufile);
      begin
        inherited ppuwrite(ppufile);
        ppufile.putlongint(tempinfo^.owner.ppuidx);
        ppufile.putbyte(byte(release_to_normal));
      end;


    procedure ttempdeletenode.resolveppuidx;
      var
        temp : ttempcreatenode;
      begin
        temp:=ttempcreatenode(nodeppuidxget(tempidx));
        if temp.nodetype<>tempcreaten then
          internalerror(2003110701);
        tempinfo:=temp.tempinfo;
      end;


    function ttempdeletenode.pass_1 : tnode;
      begin
         expectloc:=LOC_VOID;
         result := nil;
      end;

    function ttempdeletenode.pass_typecheck: tnode;
      begin
        result := nil;
        resultdef := voidtype;
      end;

    function ttempdeletenode.docompare(p: tnode): boolean;
      begin
        result :=
          inherited docompare(p) and
          (ttemprefnode(p).tempinfo = tempinfo);
      end;

    destructor ttempdeletenode.destroy;
      begin
        tempinfo^.withnode.free;
        tempinfo^.tempinitcode.free;
        dispose(tempinfo);
        inherited destroy;
      end;

    procedure ttempdeletenode.printnodedata(var t:text);
      begin
        inherited printnodedata(t);
        writeln(t,printnodeindention,'release_to_normal: ',release_to_normal,', temptypedef = ',tempinfo^.typedef.typesymbolprettyname,' = "',
          tempinfo^.typedef.GetTypeName,'", temptype = ',tempinfo^.temptype,', tempinfo = $',hexstr(ptrint(tempinfo),sizeof(ptrint)*2));
      end;

{$ifdef DEBUG_NODE_XML}
    procedure TTempDeleteNode.XMLPrintNodeData(var T: Text);
      begin
        inherited XMLPrintNodeData(T);
        WriteLn(T, PrintNodeIndention, '<release_to_normal>', release_to_normal, '</release_to_normal>');
      end;
{$endif DEBUG_NODE_XML}

end.