freepascal.compiler/compiler/ncgmem.pas

{
    $Id$
    Copyright (c) 1998-2002 by Florian Klaempfl

    Generate assembler for memory related nodes which are
    the same for all (most?) processors

    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 ncgmem;

{$i fpcdefs.inc}

interface

    uses
      globtype,cgbase,cpuinfo,cpubase,
      node,nmem;

    type
       tcgloadvmtaddrnode = class(tloadvmtaddrnode)
          procedure pass_2;override;
       end;

       tcgloadparentfpnode = class(tloadparentfpnode)
          procedure pass_2;override;
       end;

       tcgaddrnode = class(taddrnode)
          procedure pass_2;override;
       end;

       tcgderefnode = class(tderefnode)
          procedure pass_2;override;
       end;

       tcgsubscriptnode = class(tsubscriptnode)
          procedure pass_2;override;
       end;

       tcgwithnode = class(twithnode)
          procedure pass_2;override;
       end;

       tcgvecnode = class(tvecnode)
       private
         procedure rangecheck_array;
       protected
         function get_mul_size : longint;
         {# This routine is used to calculate the address of the reference.
            On entry reg contains the index in the array,
           and l contains the size of each element in the array.
           This routine should update location.reference correctly,
           so it points to the correct address.
         }
         procedure update_reference_reg_mul(reg:tregister;l:aint);virtual;
         procedure second_wideansistring;virtual;
         procedure second_dynamicarray;virtual;
       public
         procedure pass_2;override;
       end;


implementation

    uses
{$ifdef GDB}
      strings,
      gdb,
{$endif GDB}
      systems,
      cutils,verbose,globals,
      symconst,symdef,symsym,defutil,paramgr,
      aasmbase,aasmtai,
      procinfo,pass_2,parabase,
      pass_1,nld,ncon,nadd,nutils,
      cgutils,cgobj,
      tgobj,ncgutil
      ;


{*****************************************************************************
                              TCGLOADVMTADDRNODE
*****************************************************************************}

    procedure tcgloadvmtaddrnode.pass_2;
      var
       href : treference;

      begin
         location_reset(location,LOC_REGISTER,OS_ADDR);
         if (left.nodetype<>typen) then
          begin
            { left contains self, load vmt from self }
            secondpass(left);
            if is_object(left.resulttype.def) then
             begin
               case left.location.loc of
                  LOC_CREFERENCE,
                  LOC_REFERENCE:
                    begin
                       reference_reset_base(href,cg.getaddressregister(exprasmlist),tobjectdef(left.resulttype.def).vmt_offset);
                       cg.a_loadaddr_ref_reg(exprasmlist,left.location.reference,href.base);
                    end;
                  else
                    internalerror(200305056);
               end;
             end
            else
             begin
               case left.location.loc of
                  LOC_REGISTER:
                    begin
                    {$ifdef cpu_uses_separate_address_registers}
                      if getregtype(left.location.register)<>R_ADDRESSREGISTER then
                        begin
                          reference_reset_base(href,cg.getaddressregister(exprasmlist),tobjectdef(left.resulttype.def).vmt_offset);
                          cg.a_load_reg_reg(exprasmlist,OS_ADDR,OS_ADDR,left.location.register,href.base);
                        end
                      else
                    {$endif}
                        reference_reset_base(href,left.location.register,tobjectdef(left.resulttype.def).vmt_offset);
                    end;
                  LOC_CREGISTER,
                  LOC_CREFERENCE,
                  LOC_REFERENCE:
                    begin
                       reference_reset_base(href,cg.getaddressregister(exprasmlist),tobjectdef(left.resulttype.def).vmt_offset);
                       cg.a_load_loc_reg(exprasmlist,OS_ADDR,left.location,href.base);
                    end;
                  else
                    internalerror(200305057);
               end;
             end;
            location.register:=cg.getaddressregister(exprasmlist);
            cg.g_maybe_testself(exprasmlist,href.base);
            cg.a_load_ref_reg(exprasmlist,OS_ADDR,OS_ADDR,href,location.register);
          end
         else
          begin
            reference_reset_symbol(href,
              objectlibrary.newasmsymbol(tobjectdef(tclassrefdef(resulttype.def).pointertype.def).vmt_mangledname,AB_EXTERNAL,AT_DATA),0);
            location.register:=cg.getaddressregister(exprasmlist);
            cg.a_loadaddr_ref_reg(exprasmlist,href,location.register);
          end;
      end;


{*****************************************************************************
                        TCGLOADPARENTFPNODE
*****************************************************************************}

    procedure tcgloadparentfpnode.pass_2;
      var
        currpi : tprocinfo;
        hsym   : tvarsym;
        href   : treference;
      begin
        if (current_procinfo.procdef.parast.symtablelevel=parentpd.parast.symtablelevel) then
          begin
            location_reset(location,LOC_REGISTER,OS_ADDR);
            location.register:=current_procinfo.framepointer;
          end
        else
          begin
            currpi:=current_procinfo;
            location_reset(location,LOC_REGISTER,OS_ADDR);
            location.register:=cg.getaddressregister(exprasmlist);
            { load framepointer of current proc }
            hsym:=tvarsym(currpi.procdef.parast.search('parentfp'));
            if not assigned(hsym) then
              internalerror(200309281);
            cg.a_load_loc_reg(exprasmlist,OS_ADDR,hsym.localloc,location.register);
            { walk parents }
            while (currpi.procdef.owner.symtablelevel>parentpd.parast.symtablelevel) do
              begin
                currpi:=currpi.parent;
                if not assigned(currpi) then
                  internalerror(200311201);
                hsym:=tvarsym(currpi.procdef.parast.search('parentfp'));
                if not assigned(hsym) then
                  internalerror(200309282);
                if hsym.localloc.loc<>LOC_REFERENCE then
                  internalerror(200309283);
                reference_reset_base(href,location.register,hsym.localloc.reference.offset);
                cg.a_load_ref_reg(exprasmlist,OS_ADDR,OS_ADDR,href,location.register);
              end;
          end;
      end;


{*****************************************************************************
                             TCGADDRNODE
*****************************************************************************}

    procedure tcgaddrnode.pass_2;
      begin
         secondpass(left);

         { when loading procvar we do nothing with this node, so load the
           location of left }
         if nf_procvarload in flags then
          begin
            location_copy(location,left.location);
            exit;
          end;

         location_reset(location,LOC_REGISTER,OS_ADDR);
         location.register:=cg.getaddressregister(exprasmlist);
         { @ on a procvar means returning an address to the procedure that
           is stored in it }
         if (m_tp_procvar in aktmodeswitches) and
            (left.nodetype=loadn) and
            (tloadnode(left).resulttype.def.deftype=procvardef) and
            assigned(tloadnode(left).symtableentry) and
            (tloadnode(left).symtableentry.typ=varsym) then
           cg.a_load_ref_reg(exprasmlist,OS_ADDR,OS_ADDR,left.location.reference,location.register)
         else
           cg.a_loadaddr_ref_reg(exprasmlist,left.location.reference,location.register);
      end;


{*****************************************************************************
                           TCGDEREFNODE
*****************************************************************************}

    procedure tcgderefnode.pass_2;
      var
        paraloc1 : tcgpara;
      begin
         secondpass(left);
         location_reset(location,LOC_REFERENCE,def_cgsize(resulttype.def));
         case left.location.loc of
            LOC_REGISTER:
              begin
              {$ifdef cpu_uses_separate_address_registers}
                if getregtype(left.location.register)<>R_ADDRESSREGISTER then
                  begin
                    location.reference.base := cg.getaddressregister(exprasmlist);
                    cg.a_load_reg_reg(exprasmlist,OS_ADDR,OS_ADDR,left.location.register,
                      location.reference.base);
                  end
                else
              {$endif}
                  location.reference.base := left.location.register;
              end;
            LOC_CREGISTER,
            LOC_CREFERENCE,
            LOC_REFERENCE:
              begin
                 location.reference.base:=cg.getaddressregister(exprasmlist);
                 cg.a_load_loc_reg(exprasmlist,OS_ADDR,left.location,location.reference.base);
              end;
         end;
         if (cs_gdb_heaptrc in aktglobalswitches) and
            (cs_checkpointer in aktglobalswitches) and
            not(cs_compilesystem in aktmoduleswitches) and
            (not tpointerdef(left.resulttype.def).is_far) then
          begin
            paraloc1.init;
            paramanager.getintparaloc(pocall_default,1,paraloc1);
            paramanager.allocparaloc(exprasmlist,paraloc1);
            cg.a_param_reg(exprasmlist, OS_ADDR,location.reference.base,paraloc1);
            paramanager.freeparaloc(exprasmlist,paraloc1);
            paraloc1.done;
            cg.alloccpuregisters(exprasmlist,R_INTREGISTER,paramanager.get_volatile_registers_int(pocall_default));
            cg.a_call_name(exprasmlist,'FPC_CHECKPOINTER');
            cg.dealloccpuregisters(exprasmlist,R_INTREGISTER,paramanager.get_volatile_registers_int(pocall_default));
          end;
      end;


{*****************************************************************************
                          TCGSUBSCRIPTNODE
*****************************************************************************}

    procedure tcgsubscriptnode.pass_2;
      var
        paraloc1 : tcgpara;
      begin
         secondpass(left);
         if codegenerror then
           exit;
         paraloc1.init;
         { classes and interfaces must be dereferenced implicit }
         if is_class_or_interface(left.resulttype.def) then
           begin
             location_reset(location,LOC_REFERENCE,def_cgsize(resulttype.def));
             case left.location.loc of
                LOC_CREGISTER,
                LOC_REGISTER:
                  begin
                  {$ifdef cpu_uses_separate_address_registers}
                    if getregtype(left.location.register)<>R_ADDRESSREGISTER then
                      begin
                        location.reference.base:=rg.getaddressregister(exprasmlist);
                        cg.a_load_reg_reg(exprasmlist,OS_ADDR,OS_ADDR,
                          left.location.register,location.reference.base);
                      end
                    else
                  {$endif}
                      location.reference.base := left.location.register;
                  end;
                LOC_CREFERENCE,
                LOC_REFERENCE:
                  begin
                     location.reference.base:=cg.getaddressregister(exprasmlist);
                     cg.a_load_loc_reg(exprasmlist,OS_ADDR,left.location,location.reference.base);
                  end;
             end;
             { implicit deferencing }
             if (cs_gdb_heaptrc in aktglobalswitches) and
                (cs_checkpointer in aktglobalswitches) and
                not(cs_compilesystem in aktmoduleswitches) then
              begin
                paramanager.getintparaloc(pocall_default,1,paraloc1);
                paramanager.allocparaloc(exprasmlist,paraloc1);
                cg.a_param_reg(exprasmlist, OS_ADDR,location.reference.base,paraloc1);
                paramanager.freeparaloc(exprasmlist,paraloc1);
                cg.alloccpuregisters(exprasmlist,R_INTREGISTER,paramanager.get_volatile_registers_int(pocall_default));
                cg.a_call_name(exprasmlist,'FPC_CHECKPOINTER');
                cg.dealloccpuregisters(exprasmlist,R_INTREGISTER,paramanager.get_volatile_registers_int(pocall_default));
              end;
           end
         else if is_interfacecom(left.resulttype.def) then
           begin
             tg.GetTempTyped(exprasmlist,left.resulttype.def,tt_normal,location.reference);
             cg.a_load_loc_ref(exprasmlist,OS_ADDR,left.location,location.reference);
             { implicit deferencing also for interfaces }
             if (cs_gdb_heaptrc in aktglobalswitches) and
                (cs_checkpointer in aktglobalswitches) and
                not(cs_compilesystem in aktmoduleswitches) then
              begin
                paramanager.getintparaloc(pocall_default,1,paraloc1);
                paramanager.allocparaloc(exprasmlist,paraloc1);
                cg.a_param_reg(exprasmlist, OS_ADDR,location.reference.base,paraloc1);
                paramanager.freeparaloc(exprasmlist,paraloc1);
                cg.alloccpuregisters(exprasmlist,R_INTREGISTER,paramanager.get_volatile_registers_int(pocall_default));
                cg.a_call_name(exprasmlist,'FPC_CHECKPOINTER');
                cg.dealloccpuregisters(exprasmlist,R_INTREGISTER,paramanager.get_volatile_registers_int(pocall_default));
              end;
           end
         else
           location_copy(location,left.location);

         inc(location.reference.offset,vs.fieldoffset);
         { also update the size of the location }
         location.size:=def_cgsize(resulttype.def);
         paraloc1.done;
      end;


{*****************************************************************************
                            TCGWITHNODE
*****************************************************************************}

    procedure tcgwithnode.pass_2;
{$ifdef WITHNODEDEBUG}
      const
        withlevel : longint = 0;
      var
        withstartlabel,withendlabel : tasmlabel;
        pp : pchar;
        mangled_length  : longint;
        refnode : tnode;
{$endif WITHNODEDEBUG}
      begin
        location_reset(location,LOC_VOID,OS_NO);

{$ifdef WITHNODEDEBUG}
        if (cs_debuginfo in aktmoduleswitches) then
          begin
            { load reference }
            if (withrefnode.nodetype=derefn) and
               (tderefnode(withrefnode).left.nodetype=temprefn) then
              refnode:=tderefnode(withrefnode).left
            else
              refnode:=withrefnode;
            secondpass(refnode);
            location_freetemp(exprasmlist,refnode.location);
            if not(refnode.location.loc in [LOC_REFERENCE,LOC_CREFERENCE]) then
              internalerror(2003092810);

            inc(withlevel);
            objectlibrary.getaddrlabel(withstartlabel);
            objectlibrary.getaddrlabel(withendlabel);
            cg.a_label(exprasmlist,withstartlabel);
            withdebugList.concat(Tai_stabs.Create(strpnew(
               '"with'+tostr(withlevel)+':'+tostr(symtablestack.getnewtypecount)+
               '=*'+tstoreddef(left.resulttype.def).numberstring+'",'+
               tostr(N_LSYM)+',0,0,'+tostr(refnode.location.reference.offset))));
            mangled_length:=length(current_procinfo.procdef.mangledname);
            getmem(pp,mangled_length+50);
            strpcopy(pp,'192,0,0,'+withstartlabel.name);
            if (target_info.use_function_relative_addresses) then
              begin
                strpcopy(strend(pp),'-');
                strpcopy(strend(pp),current_procinfo.procdef.mangledname);
              end;
            withdebugList.concat(Tai_stabn.Create(strnew(pp)));
          end;
{$endif WITHNODEDEBUG}

        if assigned(left) then
          secondpass(left);

{$ifdef WITHNODEDEBUG}
        if (cs_debuginfo in aktmoduleswitches) then
          begin
            cg.a_label(exprasmlist,withendlabel);
            strpcopy(pp,'224,0,0,'+withendlabel.name);
           if (target_info.use_function_relative_addresses) then
             begin
               strpcopy(strend(pp),'-');
               strpcopy(strend(pp),current_procinfo.procdef.mangledname);
             end;
            withdebugList.concat(Tai_stabn.Create(strnew(pp)));
            freemem(pp,mangled_length+50);
            dec(withlevel);
          end;
{$endif WITHNODEDEBUG}
       end;


{*****************************************************************************
                            TCGVECNODE
*****************************************************************************}

     function tcgvecnode.get_mul_size : longint;
       begin
         if nf_memindex in flags then
          get_mul_size:=1
         else
          begin
            if (left.resulttype.def.deftype=arraydef) then
             get_mul_size:=tarraydef(left.resulttype.def).elesize
            else
             get_mul_size:=resulttype.def.size;
          end
       end;


     procedure tcgvecnode.update_reference_reg_mul(reg:tregister;l:aint);
       var
         hreg: tregister;
       begin
         if location.reference.base=NR_NO then
          begin
            if l<>1 then
              cg.a_op_const_reg(exprasmlist,OP_IMUL,OS_ADDR,l,reg);
            location.reference.base:=reg;
          end
         else if location.reference.index=NR_NO then
          begin
            if l<>1 then
              cg.a_op_const_reg(exprasmlist,OP_IMUL,OS_ADDR,l,reg);
            location.reference.index:=reg;
          end
         else
          begin
            hreg := cg.getaddressregister(exprasmlist);
            cg.a_loadaddr_ref_reg(exprasmlist,location.reference,hreg);
            reference_reset_base(location.reference,hreg,0);
            { insert new index register }
            if l<>1 then
              cg.a_op_const_reg(exprasmlist,OP_IMUL,OS_ADDR,l,reg);
            location.reference.index:=reg;
          end;
       end;


     procedure tcgvecnode.second_wideansistring;
       begin
       end;

     procedure tcgvecnode.second_dynamicarray;
       begin
       end;


     procedure tcgvecnode.rangecheck_array;
       var
         freereg : boolean;
         hightree : tnode;
         poslabel,
         neglabel : tasmlabel;
         hreg : tregister;
         paraloc1,paraloc2 : tcgpara;
       begin
         paraloc1.init;
         paraloc2.init;
         if is_open_array(left.resulttype.def) or
            is_array_of_const(left.resulttype.def) then
          begin
            { cdecl functions don't have high() so we can not check the range }
            if not(current_procinfo.procdef.proccalloption in [pocall_cdecl,pocall_cppdecl]) then
             begin
               { Get high value }
               hightree:=load_high_value_node(tvarsym(tloadnode(left).symtableentry));
               { it must be available }
               if not assigned(hightree) then
                 internalerror(200212201);
               firstpass(hightree);
               secondpass(hightree);
               { generate compares }
               freereg:=false;
               if (right.location.loc in [LOC_REGISTER,LOC_CREGISTER]) then
                 hreg:=cg.makeregsize(exprasmlist,right.location.register,OS_INT)
               else
                 begin
                   hreg:=cg.getintregister(exprasmlist,OS_INT);
                   freereg:=true;
                   cg.a_load_loc_reg(exprasmlist,OS_INT,right.location,hreg);
                 end;
               objectlibrary.getlabel(neglabel);
               objectlibrary.getlabel(poslabel);
               cg.a_cmp_const_reg_label(exprasmlist,OS_INT,OC_LT,0,hreg,poslabel);
               cg.a_cmp_loc_reg_label(exprasmlist,OS_INT,OC_BE,hightree.location,hreg,neglabel);
               cg.a_label(exprasmlist,poslabel);
               cg.a_call_name(exprasmlist,'FPC_RANGEERROR');
               cg.a_label(exprasmlist,neglabel);
               { release hightree }
               hightree.free;
             end;
          end
         else
          if is_dynamic_array(left.resulttype.def) then
            begin
               paramanager.getintparaloc(pocall_default,1,paraloc1);
               paramanager.getintparaloc(pocall_default,2,paraloc2);
               paramanager.allocparaloc(exprasmlist,paraloc2);
               cg.a_param_loc(exprasmlist,right.location,paraloc2);
               paramanager.allocparaloc(exprasmlist,paraloc1);
               cg.a_param_loc(exprasmlist,left.location,paraloc1);
               paramanager.freeparaloc(exprasmlist,paraloc1);
               paramanager.freeparaloc(exprasmlist,paraloc2);
               cg.alloccpuregisters(exprasmlist,R_INTREGISTER,paramanager.get_volatile_registers_int(pocall_default));
               cg.a_call_name(exprasmlist,'FPC_DYNARRAY_RANGECHECK');
               cg.dealloccpuregisters(exprasmlist,R_INTREGISTER,paramanager.get_volatile_registers_int(pocall_default));
            end
         else
           cg.g_rangecheck(exprasmlist,right.location,right.resulttype.def,left.resulttype.def);
         paraloc1.done;
         paraloc2.done;
       end;


    procedure tcgvecnode.pass_2;

      var
         offsetdec,
         extraoffset : longint;
         t : tnode;
         href : treference;
         otl,ofl : tasmlabel;
         newsize : tcgsize;
         mulsize: longint;
         isjump  : boolean;
         paraloc1,paraloc2 : tcgpara;
      begin
         paraloc1.init;
         paraloc2.init;
         mulsize := get_mul_size;

         newsize:=def_cgsize(resulttype.def);
         secondpass(left);
         if left.location.loc=LOC_CREFERENCE then
           location_reset(location,LOC_CREFERENCE,newsize)
         else
           location_reset(location,LOC_REFERENCE,newsize);

         { an ansistring needs to be dereferenced }
         if is_ansistring(left.resulttype.def) or
            is_widestring(left.resulttype.def) then
           begin
              if nf_callunique in flags then
                internalerror(200304236);

              {DM!!!!!}
              case left.location.loc of
                LOC_REGISTER,
                LOC_CREGISTER :
                  location.reference.base:=left.location.register;
                LOC_CREFERENCE,
                LOC_REFERENCE :
                  begin
                    location.reference.base:=cg.getaddressregister(exprasmlist);
                    cg.a_load_ref_reg(exprasmlist,OS_ADDR,OS_ADDR,left.location.reference,location.reference.base);
                  end;
                else
                  internalerror(2002032218);
              end;

              { check for a zero length string,
                we can use the ansistring routine here }
              if (cs_check_range in aktlocalswitches) then
                begin
                   paramanager.getintparaloc(pocall_default,1,paraloc1);
                   paramanager.allocparaloc(exprasmlist,paraloc1);
                   cg.a_param_reg(exprasmlist,OS_ADDR,location.reference.base,paraloc1);
                   paramanager.freeparaloc(exprasmlist,paraloc1);
                   cg.alloccpuregisters(exprasmlist,R_INTREGISTER,paramanager.get_volatile_registers_int(pocall_default));
                   cg.a_call_name(exprasmlist,'FPC_'+upper(tstringdef(left.resulttype.def).stringtypname)+'_CHECKZERO');
                   cg.dealloccpuregisters(exprasmlist,R_INTREGISTER,paramanager.get_volatile_registers_int(pocall_default));
                end;

              { in ansistrings/widestrings S[1] is p<w>char(S)[0] !! }
              if is_ansistring(left.resulttype.def) then
                offsetdec:=1
              else
                offsetdec:=2;
              dec(location.reference.offset,offsetdec);
           end
         else if is_dynamic_array(left.resulttype.def) then
           begin
              case left.location.loc of
                LOC_REGISTER,
                LOC_CREGISTER :
                  location.reference.base:=left.location.register;
                LOC_REFERENCE,
                LOC_CREFERENCE :
                  begin
                     location.reference.base:=cg.getaddressregister(exprasmlist);
                     cg.a_load_ref_reg(exprasmlist,OS_ADDR,OS_ADDR,
                      left.location.reference,location.reference.base);
                  end;
                else
                  internalerror(2002032219);
              end;
           end
         else
           location_copy(location,left.location);

         { offset can only differ from 0 if arraydef }
         if (left.resulttype.def.deftype=arraydef) and
            not(is_dynamic_array(left.resulttype.def)) then
           dec(location.reference.offset,mulsize*tarraydef(left.resulttype.def).lowrange);

         if right.nodetype=ordconstn then
           begin
              { offset can only differ from 0 if arraydef }
              case left.resulttype.def.deftype of
                arraydef :
                  begin
                     if not(is_open_array(left.resulttype.def)) and
                        not(is_array_of_const(left.resulttype.def)) and
                        not(is_dynamic_array(left.resulttype.def)) then
                       begin
                          if (tordconstnode(right).value>tarraydef(left.resulttype.def).highrange) or
                             (tordconstnode(right).value<tarraydef(left.resulttype.def).lowrange) then
                            begin
                              { this should be caught in the resulttypepass! (JM) }
                              if (cs_check_range in aktlocalswitches) then
                                CGMessage(parser_e_range_check_error)
                              else
                                CGMessage(parser_w_range_check_error);
                            end;
                       end
                     else
                       begin
                          { range checking for open and dynamic arrays needs
                            runtime code }
                          secondpass(right);
                          if (cs_check_range in aktlocalswitches) then
                            rangecheck_array;
                       end;
                  end;
                stringdef :
                  begin
                    if (cs_check_range in aktlocalswitches) then
                     begin
                       case tstringdef(left.resulttype.def).string_typ of
                         { it's the same for ansi- and wide strings }
                         st_widestring,
                       {$ifdef ansistring_bits}
                         st_ansistring16,st_ansistring32,st_ansistring64:
                       {$else}
                         st_ansistring:
                       {$endif}
                           begin
                              paramanager.getintparaloc(pocall_default,1,paraloc1);
                              paramanager.getintparaloc(pocall_default,2,paraloc2);
                              paramanager.allocparaloc(exprasmlist,paraloc2);
                              cg.a_param_const(exprasmlist,OS_INT,tordconstnode(right).value,paraloc2);
                              href:=location.reference;
                              dec(href.offset,sizeof(aint)-offsetdec);
                              paramanager.allocparaloc(exprasmlist,paraloc1);
                              cg.a_param_ref(exprasmlist,OS_INT,href,paraloc1);
                              paramanager.freeparaloc(exprasmlist,paraloc1);
                              paramanager.freeparaloc(exprasmlist,paraloc2);
                              cg.alloccpuregisters(exprasmlist,R_INTREGISTER,paramanager.get_volatile_registers_int(pocall_default));
                              cg.a_call_name(exprasmlist,'FPC_'+upper(tstringdef(left.resulttype.def).stringtypname)+'_RANGECHECK');
                              cg.dealloccpuregisters(exprasmlist,R_INTREGISTER,paramanager.get_volatile_registers_int(pocall_default));
                           end;

                         st_shortstring:
                           begin
                              {!!!!!!!!!!!!!!!!!}
                           end;

                         st_longstring:
                           begin
                              {!!!!!!!!!!!!!!!!!}
                           end;
                       end;
                     end;
                   end;
              end;
              inc(location.reference.offset,
                  mulsize*tordconstnode(right).value);
           end
         else
         { not nodetype=ordconstn }
           begin
              if (cs_regvars in aktglobalswitches) and
                 { if we do range checking, we don't }
                 { need that fancy code (it would be }
                 { buggy)                            }
                 not(cs_check_range in aktlocalswitches) and
                 (left.resulttype.def.deftype=arraydef) then
                begin
                   extraoffset:=0;
                   if (right.nodetype=addn) then
                     begin
                        if taddnode(right).right.nodetype=ordconstn then
                          begin
                             extraoffset:=tordconstnode(taddnode(right).right).value;
                             t:=taddnode(right).left;
                             { First pass processed this with the assumption   }
                             { that there was an add node which may require an }
                             { extra register. Fake it or die with IE10 (JM)   }
                             t.registersint := taddnode(right).registersint;
                             taddnode(right).left:=nil;
                             right.free;
                             right:=t;
                          end
                        else if taddnode(right).left.nodetype=ordconstn then
                          begin
                             extraoffset:=tordconstnode(taddnode(right).left).value;
                             t:=taddnode(right).right;
                             t.registersint :=  right.registersint;
                             taddnode(right).right:=nil;
                             right.free;
                             right:=t;
                          end;
                     end
                   else if (right.nodetype=subn) then
                     begin
                        if taddnode(right).right.nodetype=ordconstn then
                          begin
                             extraoffset:=-tordconstnode(taddnode(right).right).value;
                             t:=taddnode(right).left;
                             t.registersint :=  right.registersint;
                             taddnode(right).left:=nil;
                             right.free;
                             right:=t;
                          end
{ You also have to negate right.right in this case! I can't add an
  unaryminusn without causing a crash, so I've disabled it (JM)
                        else if right.left.nodetype=ordconstn then
                          begin
                             extraoffset:=right.left.value;
                             t:=right.right;
                             t^.registersint :=  right.registersint;
                             putnode(right);
                             putnode(right.left);
                             right:=t;
                         end;}
                     end;
                   inc(location.reference.offset,
                       mulsize*extraoffset);
                end;
              { calculate from left to right }
              if not(location.loc in [LOC_CREFERENCE,LOC_REFERENCE]) then
                internalerror(200304237);
              isjump:=(right.location.loc=LOC_JUMP);
              if isjump then
               begin
                 otl:=truelabel;
                 objectlibrary.getlabel(truelabel);
                 ofl:=falselabel;
                 objectlibrary.getlabel(falselabel);
               end;
              secondpass(right);

              if cs_check_range in aktlocalswitches then
               begin
                 if left.resulttype.def.deftype=arraydef then
                   rangecheck_array;
               end;

              { if mulsize = 1, we won't have to modify the index }
              location_force_reg(exprasmlist,right.location,OS_ADDR,(mulsize = 1));

              if isjump then
               begin
                 truelabel:=otl;
                 falselabel:=ofl;
               end;

            { produce possible range check code: }
              if cs_check_range in aktlocalswitches then
               begin
                 if left.resulttype.def.deftype=arraydef then
                   begin
                     { done defore (PM) }
                   end
                 else if (left.resulttype.def.deftype=stringdef) then
                   begin
                      case tstringdef(left.resulttype.def).string_typ of
                         { it's the same for ansi- and wide strings }
                         st_widestring,
                       {$ifdef ansistring_bits}
                         st_ansistring16,st_ansistring32,st_ansistring64:
                       {$else}
                         st_ansistring:
                       {$endif}
                           begin
                              paramanager.getintparaloc(pocall_default,1,paraloc1);
                              paramanager.getintparaloc(pocall_default,2,paraloc2);
                              paramanager.allocparaloc(exprasmlist,paraloc2);
                              cg.a_param_reg(exprasmlist,OS_INT,right.location.register,paraloc2);
                              href:=location.reference;
                              dec(href.offset,sizeof(aint)-offsetdec);
                              //dec(href.offset,7);
                              paramanager.allocparaloc(exprasmlist,paraloc1);
                              cg.a_param_ref(exprasmlist,OS_INT,href,paraloc1);
                              paramanager.freeparaloc(exprasmlist,paraloc1);
                              paramanager.freeparaloc(exprasmlist,paraloc2);
                              cg.alloccpuregisters(exprasmlist,R_INTREGISTER,paramanager.get_volatile_registers_int(pocall_default));
                              cg.a_call_name(exprasmlist,'FPC_'+upper(tstringdef(left.resulttype.def).stringtypname)+'_RANGECHECK');
                              cg.dealloccpuregisters(exprasmlist,R_INTREGISTER,paramanager.get_volatile_registers_int(pocall_default));
                           end;
                         st_shortstring:
                           begin
                              {!!!!!!!!!!!!!!!!!}
                           end;
                         st_longstring:
                           begin
                              {!!!!!!!!!!!!!!!!!}
                           end;
                      end;
                   end;
               end;

              { insert the register and the multiplication factor in the
                reference }
              update_reference_reg_mul(right.location.register,mulsize);
           end;

        location.size:=newsize;
        paraloc1.done;
        paraloc2.done;
      end;


begin
   cloadvmtaddrnode:=tcgloadvmtaddrnode;
   cloadparentfpnode:=tcgloadparentfpnode;
   caddrnode:=tcgaddrnode;
   cderefnode:=tcgderefnode;
   csubscriptnode:=tcgsubscriptnode;
   cwithnode:=tcgwithnode;
   cvecnode:=tcgvecnode;
end.
{
  $Log$
  Revision 1.97  2004-09-25 14:23:54  peter
    * ungetregister is now only used for cpuregisters, renamed to
      ungetcpuregister
    * renamed (get|unget)explicitregister(s) to ..cpuregister
    * removed location-release/reference_release

  Revision 1.96  2004/09/21 17:25:12  peter
    * paraloc branch merged

  Revision 1.95.4.1  2004/08/31 20:43:06  peter
    * paraloc patch

  Revision 1.95  2004/08/02 09:15:03  michael
  + Fixed range check for non-constant indexes in strings

  Revision 1.94  2004/07/12 17:58:19  peter
    * remove maxlen field from ansistring/widestrings

  Revision 1.93  2004/06/20 08:55:29  florian
    * logs truncated

  Revision 1.92  2004/06/16 20:07:08  florian
    * dwarf branch merged

  Revision 1.91  2004/04/29 19:56:37  daniel
    * Prepare compiler infrastructure for multiple ansistring types

  Revision 1.90  2004/04/21 17:39:40  jonas
    - disabled with-symtable debugging code since it was broken and
      at the same time confused the register allocator and therefore also
      the optimizer. May be fixed in the future using dwarf support

  Revision 1.89.2.4  2004/05/10 21:28:34  peter
    * section_smartlink enabled for gas under linux

  Revision 1.89.2.3  2004/05/02 13:04:28  peter
    * ofs fixed

}