mirror of
				https://gitlab.com/freepascal.org/fpc/source.git
				synced 2025-11-04 09:39:32 +01:00 
			
		
		
		
	
		
			
				
	
	
		
			761 lines
		
	
	
		
			30 KiB
		
	
	
	
		
			ObjectPascal
		
	
	
	
	
	
			
		
		
	
	
			761 lines
		
	
	
		
			30 KiB
		
	
	
	
		
			ObjectPascal
		
	
	
	
	
	
{
 | 
						|
    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 : aint;
 | 
						|
         {# 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
 | 
						|
      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
 | 
						|
             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
 | 
						|
         else
 | 
						|
           begin
 | 
						|
             { left contains self, load vmt from self }
 | 
						|
             secondpass(left);
 | 
						|
             gen_load_vmt_register(exprasmlist,tobjectdef(left.resulttype.def),left.location,location.register);
 | 
						|
           end;
 | 
						|
      end;
 | 
						|
 | 
						|
 | 
						|
{*****************************************************************************
 | 
						|
                        TCGLOADPARENTFPNODE
 | 
						|
*****************************************************************************}
 | 
						|
 | 
						|
    procedure tcgloadparentfpnode.pass_2;
 | 
						|
      var
 | 
						|
        currpi : tprocinfo;
 | 
						|
        hsym   : tparavarsym;
 | 
						|
        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:=tparavarsym(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:=tparavarsym(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);
 | 
						|
 | 
						|
         location_reset(location,LOC_REGISTER,OS_ADDR);
 | 
						|
         location.register:=cg.getaddressregister(exprasmlist);
 | 
						|
         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_CREGISTER,
 | 
						|
            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_CREFERENCE,
 | 
						|
            LOC_REFERENCE:
 | 
						|
              begin
 | 
						|
                 location.reference.base:=cg.getaddressregister(exprasmlist);
 | 
						|
                 cg.a_load_loc_reg(exprasmlist,OS_ADDR,left.location,location.reference.base);
 | 
						|
              end;
 | 
						|
            LOC_CONSTANT:
 | 
						|
              begin
 | 
						|
                location.reference.offset:=left.location.value;
 | 
						|
              end;
 | 
						|
            else
 | 
						|
              internalerror(200507031);
 | 
						|
         end;
 | 
						|
         if (cs_use_heaptrc in aktglobalswitches) and
 | 
						|
            (cs_checkpointer in aktlocalswitches) and
 | 
						|
            not(cs_compilesystem in aktmoduleswitches) and
 | 
						|
            not(tpointerdef(left.resulttype.def).is_far) and
 | 
						|
            not(nf_no_checkpointer in flags) 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.allocallcpuregisters(exprasmlist);
 | 
						|
            cg.a_call_name(exprasmlist,'FPC_CHECKPOINTER');
 | 
						|
            cg.deallocallcpuregisters(exprasmlist);
 | 
						|
          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_use_heaptrc in aktglobalswitches) and
 | 
						|
                (cs_checkpointer in aktlocalswitches) 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.allocallcpuregisters(exprasmlist);
 | 
						|
                cg.a_call_name(exprasmlist,'FPC_CHECKPOINTER');
 | 
						|
                cg.deallocallcpuregisters(exprasmlist);
 | 
						|
              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_use_heaptrc in aktglobalswitches) and
 | 
						|
                (cs_checkpointer in aktlocalswitches) 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.allocallcpuregisters(exprasmlist);
 | 
						|
                cg.a_call_name(exprasmlist,'FPC_CHECKPOINTER');
 | 
						|
                cg.deallocallcpuregisters(exprasmlist);
 | 
						|
              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;
 | 
						|
      begin
 | 
						|
        location_reset(location,LOC_VOID,OS_NO);
 | 
						|
 | 
						|
        if assigned(left) then
 | 
						|
          secondpass(left);
 | 
						|
       end;
 | 
						|
 | 
						|
 | 
						|
{*****************************************************************************
 | 
						|
                            TCGVECNODE
 | 
						|
*****************************************************************************}
 | 
						|
 | 
						|
     function tcgvecnode.get_mul_size : aint;
 | 
						|
       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
 | 
						|
         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(tparavarsym(tloadnode(left).symtableentry));
 | 
						|
               { it must be available }
 | 
						|
               if not assigned(hightree) then
 | 
						|
                 internalerror(200212201);
 | 
						|
               firstpass(hightree);
 | 
						|
               secondpass(hightree);
 | 
						|
               { generate compares }
 | 
						|
               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);
 | 
						|
                   cg.a_load_loc_reg(exprasmlist,OS_INT,right.location,hreg);
 | 
						|
                 end;
 | 
						|
               objectlibrary.getjumplabel(neglabel);
 | 
						|
               objectlibrary.getjumplabel(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.allocallcpuregisters(exprasmlist);
 | 
						|
               cg.a_call_name(exprasmlist,'FPC_DYNARRAY_RANGECHECK');
 | 
						|
               cg.deallocallcpuregisters(exprasmlist);
 | 
						|
            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 : aint;
 | 
						|
         t        : tnode;
 | 
						|
         href     : treference;
 | 
						|
         otl,ofl  : tasmlabel;
 | 
						|
         newsize  : tcgsize;
 | 
						|
         mulsize  : aint;
 | 
						|
         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.allocallcpuregisters(exprasmlist);
 | 
						|
                   cg.a_call_name(exprasmlist,'FPC_'+upper(tstringdef(left.resulttype.def).stringtypname)+'_CHECKZERO');
 | 
						|
                   cg.deallocallcpuregisters(exprasmlist);
 | 
						|
                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);
 | 
						|
 | 
						|
         { location must be memory }
 | 
						|
         if not(location.loc in [LOC_REFERENCE,LOC_CREFERENCE]) then
 | 
						|
           internalerror(200411013);
 | 
						|
 | 
						|
         { 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,
 | 
						|
                         st_ansistring:
 | 
						|
                           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.allocallcpuregisters(exprasmlist);
 | 
						|
                              cg.a_call_name(exprasmlist,'FPC_'+upper(tstringdef(left.resulttype.def).stringtypname)+'_RANGECHECK');
 | 
						|
                              cg.deallocallcpuregisters(exprasmlist);
 | 
						|
                           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.getjumplabel(truelabel);
 | 
						|
                 ofl:=falselabel;
 | 
						|
                 objectlibrary.getjumplabel(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,
 | 
						|
                         st_ansistring:
 | 
						|
                           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.allocallcpuregisters(exprasmlist);
 | 
						|
                              cg.a_call_name(exprasmlist,'FPC_'+upper(tstringdef(left.resulttype.def).stringtypname)+'_RANGECHECK');
 | 
						|
                              cg.deallocallcpuregisters(exprasmlist);
 | 
						|
                           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.
 |