mirror of
				https://gitlab.com/freepascal.org/fpc/source.git
				synced 2025-11-04 03:19:47 +01:00 
			
		
		
		
	
		
			
				
	
	
		
			677 lines
		
	
	
		
			25 KiB
		
	
	
	
		
			ObjectPascal
		
	
	
	
	
	
			
		
		
	
	
			677 lines
		
	
	
		
			25 KiB
		
	
	
	
		
			ObjectPascal
		
	
	
	
	
	
{
 | 
						|
    $Id$
 | 
						|
    Copyright (c) 1998-2002 by Florian Klaempfl and Carl Eric Codere
 | 
						|
 | 
						|
    Generate generic inline 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 ncginl;
 | 
						|
 | 
						|
{$i fpcdefs.inc}
 | 
						|
 | 
						|
interface
 | 
						|
 | 
						|
    uses
 | 
						|
       node,ninl;
 | 
						|
 | 
						|
    type
 | 
						|
       tcginlinenode = class(tinlinenode)
 | 
						|
          procedure pass_2;override;
 | 
						|
          procedure second_assigned;virtual; abstract;
 | 
						|
          procedure second_assert;virtual;
 | 
						|
          procedure second_sizeoftypeof;virtual;
 | 
						|
          procedure second_length;virtual;
 | 
						|
          procedure second_predsucc;virtual;
 | 
						|
          procedure second_incdec;virtual;
 | 
						|
          procedure second_typeinfo;virtual;
 | 
						|
          procedure second_includeexclude;virtual; 
 | 
						|
          procedure second_pi; virtual;
 | 
						|
          procedure second_arctan_real; virtual;
 | 
						|
          procedure second_abs_real; virtual;
 | 
						|
          procedure second_sqr_real; virtual;
 | 
						|
          procedure second_sqrt_real; virtual;
 | 
						|
          procedure second_ln_real; virtual;
 | 
						|
          procedure second_cos_real; virtual;
 | 
						|
          procedure second_sin_real; virtual;
 | 
						|
       end;
 | 
						|
 | 
						|
implementation
 | 
						|
 | 
						|
    uses
 | 
						|
      globtype,systems,
 | 
						|
      cutils,verbose,globals,fmodule,
 | 
						|
      symconst,symdef,defbase,
 | 
						|
      aasmbase,aasmtai,aasmcpu,
 | 
						|
      cginfo,cgbase,pass_1,pass_2,
 | 
						|
      cpubase,paramgr,
 | 
						|
      nbas,ncon,ncal,ncnv,nld,
 | 
						|
      cga,tgobj,ncgutil,cgobj,cg64f32,rgobj,rgcpu;
 | 
						|
 | 
						|
 | 
						|
{*****************************************************************************
 | 
						|
                              TCGINLINENODE
 | 
						|
*****************************************************************************}
 | 
						|
 | 
						|
 | 
						|
    procedure tcginlinenode.pass_2;
 | 
						|
       var
 | 
						|
         asmop : tasmop;
 | 
						|
         l : longint;
 | 
						|
         oldpushedparasize : longint;
 | 
						|
      begin
 | 
						|
         { save & reset pushedparasize }
 | 
						|
         oldpushedparasize:=pushedparasize;
 | 
						|
         pushedparasize:=0;
 | 
						|
         case inlinenumber of
 | 
						|
            in_assert_x_y:
 | 
						|
              begin
 | 
						|
                 second_Assert;
 | 
						|
              end;
 | 
						|
            in_sizeof_x,
 | 
						|
            in_typeof_x :
 | 
						|
              begin
 | 
						|
                 second_SizeofTypeOf;
 | 
						|
              end;
 | 
						|
            in_length_x :
 | 
						|
              begin
 | 
						|
                 second_Length;
 | 
						|
              end;
 | 
						|
            in_pred_x,
 | 
						|
            in_succ_x:
 | 
						|
              begin
 | 
						|
                 second_PredSucc;
 | 
						|
              end;
 | 
						|
            in_dec_x,
 | 
						|
            in_inc_x :
 | 
						|
              begin
 | 
						|
                second_IncDec;
 | 
						|
              end;
 | 
						|
            in_typeinfo_x:
 | 
						|
               begin
 | 
						|
                  second_TypeInfo;
 | 
						|
               end;
 | 
						|
            in_assigned_x :
 | 
						|
              begin
 | 
						|
                 second_Assigned;
 | 
						|
              end;
 | 
						|
            in_include_x_y,
 | 
						|
            in_exclude_x_y:
 | 
						|
              begin
 | 
						|
                 second_IncludeExclude;
 | 
						|
              end;
 | 
						|
            in_pi:
 | 
						|
              begin
 | 
						|
                second_pi;
 | 
						|
              end;
 | 
						|
            in_sin_extended:
 | 
						|
              begin
 | 
						|
                second_sin_real;
 | 
						|
              end;
 | 
						|
            in_arctan_extended:
 | 
						|
              begin
 | 
						|
                second_arctan_real;
 | 
						|
              end;
 | 
						|
            in_abs_extended:
 | 
						|
              begin
 | 
						|
                second_abs_real;
 | 
						|
              end;
 | 
						|
            in_sqr_extended:
 | 
						|
              begin
 | 
						|
                second_sqr_real;
 | 
						|
              end;
 | 
						|
            in_sqrt_extended:
 | 
						|
              begin
 | 
						|
                second_sqrt_real;
 | 
						|
              end;
 | 
						|
            in_ln_extended:
 | 
						|
              begin
 | 
						|
                second_ln_real;
 | 
						|
              end;
 | 
						|
            in_cos_extended:
 | 
						|
              begin
 | 
						|
                 second_cos_real;
 | 
						|
              end;
 | 
						|
{$ifdef SUPPORT_MMX}
 | 
						|
            in_mmx_pcmpeqb..in_mmx_pcmpgtw:
 | 
						|
              begin
 | 
						|
                 location_reset(location,LOC_MMXREGISTER,OS_NO);
 | 
						|
                 if left.location.loc=LOC_REGISTER then
 | 
						|
                   begin
 | 
						|
                      {!!!!!!!}
 | 
						|
                   end
 | 
						|
                 else if tcallparanode(left).left.location.loc=LOC_REGISTER then
 | 
						|
                   begin
 | 
						|
                      {!!!!!!!}
 | 
						|
                   end
 | 
						|
                 else
 | 
						|
                   begin
 | 
						|
                      {!!!!!!!}
 | 
						|
                   end;
 | 
						|
              end;
 | 
						|
{$endif SUPPORT_MMX}
 | 
						|
            else internalerror(9);
 | 
						|
         end;
 | 
						|
         { reset pushedparasize }
 | 
						|
         pushedparasize:=oldpushedparasize;
 | 
						|
      end;
 | 
						|
 | 
						|
 | 
						|
{*****************************************************************************
 | 
						|
                          ASSERT GENERIC HANDLING
 | 
						|
*****************************************************************************}
 | 
						|
    procedure tcginlinenode.second_Assert;
 | 
						|
     var
 | 
						|
         hp2 : tstringconstnode;
 | 
						|
         otlabel,oflabel{,l1}   : tasmlabel;
 | 
						|
     begin
 | 
						|
       { the node should be removed in the firstpass }
 | 
						|
       if not (cs_do_assertion in aktlocalswitches) then
 | 
						|
          internalerror(7123458);
 | 
						|
       otlabel:=truelabel;
 | 
						|
       oflabel:=falselabel;
 | 
						|
       getlabel(truelabel);
 | 
						|
       getlabel(falselabel);
 | 
						|
       secondpass(tcallparanode(left).left);
 | 
						|
       maketojumpbool(exprasmlist,tcallparanode(left).left,lr_load_regvars);
 | 
						|
       cg.a_label(exprasmlist,falselabel);
 | 
						|
       { erroraddr }
 | 
						|
       cg.a_param_reg(exprasmlist,OS_ADDR,FRAME_POINTER_REG,paramanager.getintparaloc(4));
 | 
						|
       { lineno }
 | 
						|
       cg.a_param_const(exprasmlist,OS_INT,aktfilepos.line,paramanager.getintparaloc(3));
 | 
						|
       { filename string }
 | 
						|
       hp2:=cstringconstnode.createstr(current_module.sourcefiles.get_file_name(aktfilepos.fileindex),st_shortstring);
 | 
						|
       firstpass(hp2);
 | 
						|
       secondpass(hp2);
 | 
						|
       if codegenerror then
 | 
						|
          exit;
 | 
						|
       cg.a_paramaddr_ref(exprasmlist,hp2.location.reference,paramanager.getintparaloc(2));
 | 
						|
       hp2.free;
 | 
						|
       { push msg }
 | 
						|
       secondpass(tcallparanode(tcallparanode(left).right).left);
 | 
						|
       cg.a_paramaddr_ref(exprasmlist,tcallparanode(tcallparanode(left).right).left.location.reference,paramanager.getintparaloc(1));
 | 
						|
       { call }
 | 
						|
       cg.a_call_name(exprasmlist,'FPC_ASSERT');
 | 
						|
       cg.a_label(exprasmlist,truelabel);
 | 
						|
       truelabel:=otlabel;
 | 
						|
       falselabel:=oflabel;
 | 
						|
     end;
 | 
						|
 | 
						|
 | 
						|
{*****************************************************************************
 | 
						|
                          SIZEOF / TYPEOF GENERIC HANDLING
 | 
						|
*****************************************************************************}
 | 
						|
 | 
						|
    { second_handle_ the sizeof and typeof routines }
 | 
						|
    procedure tcginlinenode.second_SizeOfTypeOf;
 | 
						|
      var
 | 
						|
         href : treference;
 | 
						|
         hregister : tregister;
 | 
						|
      begin
 | 
						|
        location_reset(location,LOC_REGISTER,OS_ADDR);
 | 
						|
        { for both cases load vmt }
 | 
						|
        if left.nodetype=typen then
 | 
						|
          begin
 | 
						|
            hregister:=rg.getaddressregister(exprasmlist);
 | 
						|
            reference_reset_symbol(href,newasmsymbol(tobjectdef(left.resulttype.def).vmt_mangledname),0);
 | 
						|
            cg.a_loadaddr_ref_reg(exprasmlist,href,hregister);
 | 
						|
          end
 | 
						|
        else
 | 
						|
          begin
 | 
						|
            secondpass(left);
 | 
						|
            location_release(exprasmlist,left.location);
 | 
						|
            hregister:=rg.getaddressregister(exprasmlist);
 | 
						|
            { load VMT pointer }
 | 
						|
            inc(left.location.reference.offset,tobjectdef(left.resulttype.def).vmt_offset);
 | 
						|
            cg.a_load_ref_reg(exprasmlist,OS_ADDR,left.location.reference,hregister);
 | 
						|
          end;
 | 
						|
        { in sizeof load size }
 | 
						|
        if inlinenumber=in_sizeof_x then
 | 
						|
           begin
 | 
						|
             reference_reset_base(href,hregister,0);
 | 
						|
             rg.ungetaddressregister(exprasmlist,hregister);
 | 
						|
             hregister:=rg.getregisterint(exprasmlist);
 | 
						|
             cg.a_load_ref_reg(exprasmlist,OS_INT,href,hregister);
 | 
						|
           end;
 | 
						|
        location.register:=hregister;
 | 
						|
     end;
 | 
						|
 | 
						|
 | 
						|
 | 
						|
{*****************************************************************************
 | 
						|
                          LENGTH GENERIC HANDLING
 | 
						|
*****************************************************************************}
 | 
						|
 | 
						|
    procedure tcginlinenode.second_Length;
 | 
						|
      var
 | 
						|
        lengthlab : tasmlabel;
 | 
						|
        hregister : tregister;
 | 
						|
        href : treference;
 | 
						|
      begin
 | 
						|
        secondpass(left);
 | 
						|
        { length in ansi strings is at offset -8 }
 | 
						|
        if is_ansistring(left.resulttype.def) or
 | 
						|
           is_widestring(left.resulttype.def) then
 | 
						|
            begin
 | 
						|
              location_force_reg(exprasmlist,left.location,OS_ADDR,false);
 | 
						|
              hregister:=left.location.register;
 | 
						|
              getlabel(lengthlab);
 | 
						|
              cg.a_cmp_const_reg_label(exprasmlist,OS_ADDR,OC_EQ,0,hregister,lengthlab);
 | 
						|
              reference_reset_base(href,hregister,-8);
 | 
						|
              cg.a_load_ref_reg(exprasmlist,OS_32,href,hregister);
 | 
						|
              cg.a_label(exprasmlist,lengthlab);
 | 
						|
              location_reset(location,LOC_REGISTER,OS_32);
 | 
						|
              location.register:=hregister;
 | 
						|
            end
 | 
						|
         else
 | 
						|
            begin
 | 
						|
              location_copy(location,left.location);
 | 
						|
              location.size:=OS_8;
 | 
						|
            end;
 | 
						|
      end;
 | 
						|
 | 
						|
 | 
						|
{*****************************************************************************
 | 
						|
                         PRED/SUCC GENERIC HANDLING
 | 
						|
*****************************************************************************}
 | 
						|
 | 
						|
    procedure tcginlinenode.second_PredSucc;
 | 
						|
      var
 | 
						|
         cgsize : TCGSize;
 | 
						|
         cgop : topcg;
 | 
						|
      begin
 | 
						|
        secondpass(left);
 | 
						|
        if inlinenumber=in_pred_x then
 | 
						|
           cgop:=OP_SUB
 | 
						|
        else
 | 
						|
           cgop:=OP_ADD;
 | 
						|
        cgsize:=def_cgsize(resulttype.def);
 | 
						|
 | 
						|
        { we need a value in a register }
 | 
						|
        location_copy(location,left.location);
 | 
						|
        location_force_reg(exprasmlist,location,cgsize,false);
 | 
						|
 | 
						|
        if cgsize in [OS_64,OS_S64] then
 | 
						|
          cg64.a_op64_const_reg(exprasmlist,cgop,1,
 | 
						|
                      location.register64)
 | 
						|
        else
 | 
						|
          cg.a_op_const_reg(exprasmlist,cgop,1,location.register);
 | 
						|
 | 
						|
        cg.g_overflowcheck(exprasmlist,self);
 | 
						|
        cg.g_rangecheck(exprasmlist,self,resulttype.def);
 | 
						|
      end;
 | 
						|
 | 
						|
 | 
						|
{*****************************************************************************
 | 
						|
                         INC/DEC GENERIC HANDLING
 | 
						|
*****************************************************************************}
 | 
						|
      procedure tcginlinenode.second_IncDec;
 | 
						|
       const
 | 
						|
         addsubop:array[in_inc_x..in_dec_x] of TOpCG=(OP_ADD,OP_SUB);
 | 
						|
        var
 | 
						|
         addvalue : longint;
 | 
						|
         addconstant : boolean;
 | 
						|
         hregisterhi,
 | 
						|
         hregister : tregister;
 | 
						|
         cgsize : tcgsize;
 | 
						|
         pushedregs : tmaybesave;
 | 
						|
        begin
 | 
						|
          { set defaults }
 | 
						|
          addconstant:=true;
 | 
						|
          { load first parameter, must be a reference }
 | 
						|
          secondpass(tcallparanode(left).left);
 | 
						|
          cgsize:=def_cgsize(tcallparanode(left).left.resulttype.def);
 | 
						|
          { get addvalue }
 | 
						|
          case tcallparanode(left).left.resulttype.def.deftype of
 | 
						|
            orddef,
 | 
						|
            enumdef :
 | 
						|
                addvalue:=1;
 | 
						|
            pointerdef :
 | 
						|
               begin
 | 
						|
                 if is_void(tpointerdef(tcallparanode(left).left.resulttype.def).pointertype.def) then
 | 
						|
                   addvalue:=1
 | 
						|
                 else
 | 
						|
                   addvalue:=tpointerdef(tcallparanode(left).left.resulttype.def).pointertype.def.size;
 | 
						|
               end;
 | 
						|
           else
 | 
						|
               internalerror(10081);
 | 
						|
          end;
 | 
						|
          { second_ argument specified?, must be a s32bit in register }
 | 
						|
          if assigned(tcallparanode(left).right) then
 | 
						|
            begin
 | 
						|
              maybe_save(exprasmlist,tcallparanode(tcallparanode(left).right).left.registers32,
 | 
						|
                 tcallparanode(left).left.location,pushedregs);
 | 
						|
              secondpass(tcallparanode(tcallparanode(left).right).left);
 | 
						|
              maybe_restore(exprasmlist,tcallparanode(left).left.location,pushedregs);
 | 
						|
              { when constant, just multiply the addvalue }
 | 
						|
              if is_constintnode(tcallparanode(tcallparanode(left).right).left) then
 | 
						|
                 addvalue:=addvalue*get_ordinal_value(tcallparanode(tcallparanode(left).right).left)
 | 
						|
              else
 | 
						|
                begin
 | 
						|
                  location_force_reg(exprasmlist,tcallparanode(tcallparanode(left).right).left.location,cgsize,false);
 | 
						|
                  hregister:=tcallparanode(tcallparanode(left).right).left.location.register;
 | 
						|
                  hregisterhi:=tcallparanode(tcallparanode(left).right).left.location.registerhigh;
 | 
						|
                  { insert multiply with addvalue if its >1 }
 | 
						|
                  if addvalue>1 then
 | 
						|
                    cg.a_op_const_reg(exprasmlist,OP_IMUL,addvalue,hregister);
 | 
						|
                  addconstant:=false;
 | 
						|
                end;
 | 
						|
            end;
 | 
						|
          { write the add instruction }
 | 
						|
          if addconstant then
 | 
						|
            begin
 | 
						|
              if cgsize in [OS_64,OS_S64] then
 | 
						|
               cg64.a_op64_const_loc(exprasmlist,addsubop[inlinenumber],
 | 
						|
                  addvalue,tcallparanode(left).left.location)
 | 
						|
              else
 | 
						|
               cg.a_op_const_loc(exprasmlist,addsubop[inlinenumber],
 | 
						|
                  addvalue,tcallparanode(left).left.location);
 | 
						|
            end
 | 
						|
           else
 | 
						|
             begin
 | 
						|
               if cgsize in [OS_64,OS_S64] then
 | 
						|
                 cg64.a_op64_reg_loc(exprasmlist,addsubop[inlinenumber],
 | 
						|
                   joinreg64(hregister,hregisterhi),tcallparanode(left).left.location)
 | 
						|
               else
 | 
						|
                 cg.a_op_reg_loc(exprasmlist,addsubop[inlinenumber],
 | 
						|
                   hregister,tcallparanode(left).left.location);
 | 
						|
                 location_release(exprasmlist,tcallparanode(tcallparanode(left).right).left.location);
 | 
						|
             end;
 | 
						|
          cg.g_overflowcheck(exprasmlist,tcallparanode(left).left);
 | 
						|
          cg.g_rangecheck(exprasmlist,tcallparanode(left).left,tcallparanode(left).left.resulttype.def);
 | 
						|
        end;
 | 
						|
 | 
						|
 | 
						|
{*****************************************************************************
 | 
						|
                         TYPEINFO GENERIC HANDLING
 | 
						|
*****************************************************************************}
 | 
						|
      procedure tcginlinenode.second_typeinfo;
 | 
						|
        var
 | 
						|
         href : treference;
 | 
						|
        begin
 | 
						|
          location_reset(location,LOC_REGISTER,OS_ADDR);
 | 
						|
          location.register:=rg.getaddressregister(exprasmlist);
 | 
						|
          reference_reset_symbol(href,tstoreddef(ttypenode(tcallparanode(left).left).resulttype.def).get_rtti_label(fullrtti),0);
 | 
						|
          cg.a_loadaddr_ref_reg(exprasmlist,href,location.register);
 | 
						|
        end;
 | 
						|
 | 
						|
 | 
						|
{*****************************************************************************
 | 
						|
                         ASSIGNED GENERIC HANDLING
 | 
						|
*****************************************************************************}
 | 
						|
(*
 | 
						|
      procedure tcginlinenode.second_Assigned;
 | 
						|
        var
 | 
						|
         hreg : tregister;
 | 
						|
         ptrvalidlabel : tasmlabel;
 | 
						|
        begin
 | 
						|
          secondpass(tcallparanode(left).left);
 | 
						|
          location_release(exprasmlist,tcallparanode(left).left.location);
 | 
						|
          hreg := rg.getregisterint(exprasmlist);
 | 
						|
          if (tcallparanode(left).left.location.loc in [LOC_REGISTER,LOC_CREGISTER]) then
 | 
						|
            begin
 | 
						|
              { if pointer is non-nil, and is in register, this directly the value we can use }
 | 
						|
              cg.a_load_reg_reg(exprasmlist, OS_ADDR, tcallparanode(left).left.location.register, hreg);
 | 
						|
            end
 | 
						|
          else
 | 
						|
            begin
 | 
						|
              getlabel(ptrvalidlabel);
 | 
						|
              cg.a_load_const_reg(exprasmlist, OS_INT, 1, hreg);
 | 
						|
              cg.a_cmp_const_ref_label(exprasmlist, OS_ADDR, OC_NE, 0,
 | 
						|
                  tcallparanode(left).left.location.reference, ptrvalidlabel);
 | 
						|
              cg.a_load_const_reg(exprasmlist, OS_INT, 0, hreg);
 | 
						|
              cg.a_label(exprasmlist,ptrvalidlabel);
 | 
						|
            end;
 | 
						|
          location.register := hreg;
 | 
						|
          location_reset(location,LOC_REGISTER,OS_INT);
 | 
						|
          WriteLn('Exiting assigned node!');
 | 
						|
        end;
 | 
						|
 | 
						|
*)
 | 
						|
{*****************************************************************************
 | 
						|
                     INCLUDE/EXCLUDE GENERIC HANDLING
 | 
						|
*****************************************************************************}
 | 
						|
      procedure tcginlinenode.second_IncludeExclude;
 | 
						|
        var
 | 
						|
         scratch_reg : boolean;
 | 
						|
         hregister : tregister;
 | 
						|
         asmop : tasmop;
 | 
						|
         L : longint;
 | 
						|
         pushedregs : TMaybesave;
 | 
						|
         cgop : topcg;
 | 
						|
         addrreg, hregister2: tregister;
 | 
						|
         use_small : boolean;
 | 
						|
         cgsize : tcgsize;
 | 
						|
         href : treference;
 | 
						|
        begin
 | 
						|
          location_copy(location,left.location);
 | 
						|
          secondpass(tcallparanode(left).left);
 | 
						|
          if tcallparanode(tcallparanode(left).right).left.nodetype=ordconstn then
 | 
						|
            begin
 | 
						|
              { calculate bit position }
 | 
						|
              l:=1 shl (tordconstnode(tcallparanode(tcallparanode(left).right).left).value mod 32);
 | 
						|
 | 
						|
              { determine operator }
 | 
						|
              if inlinenumber=in_include_x_y then
 | 
						|
                cgop:=OP_OR
 | 
						|
              else
 | 
						|
                begin
 | 
						|
                  cgop:=OP_AND;
 | 
						|
                  l:=not(l);
 | 
						|
                end;
 | 
						|
              if (tcallparanode(left).left.location.loc=LOC_REFERENCE) then
 | 
						|
                begin
 | 
						|
                  inc(tcallparanode(left).left.location.reference.offset,
 | 
						|
                    (tordconstnode(tcallparanode(tcallparanode(left).right).left).value div 32)*4);
 | 
						|
                  cg.a_op_const_ref(exprasmlist,cgop,OS_INT,l,tcallparanode(left).left.location.reference);
 | 
						|
                  location_release(exprasmlist,tcallparanode(left).left.location);
 | 
						|
                end
 | 
						|
              else
 | 
						|
                { LOC_CREGISTER }
 | 
						|
                begin
 | 
						|
                  cg.a_op_const_reg(exprasmlist,cgop,l,tcallparanode(left).left.location.register);
 | 
						|
                end;
 | 
						|
            end
 | 
						|
          else
 | 
						|
            begin
 | 
						|
             use_small:=
 | 
						|
                 { set type }
 | 
						|
                 (tsetdef(tcallparanode(left).left.resulttype.def).settype=smallset) 
 | 
						|
                  and
 | 
						|
                   { elemenut number between 1 and 32 } 
 | 
						|
                  ((tcallparanode(tcallparanode(left).right).left.resulttype.def.deftype=orddef) and 
 | 
						|
                   (torddef(tcallparanode(tcallparanode(left).right).left.resulttype.def).high<=32) or
 | 
						|
                   (tcallparanode(tcallparanode(left).right).left.resulttype.def.deftype=enumdef) and 
 | 
						|
                   (tenumdef(tcallparanode(tcallparanode(left).right).left.resulttype.def).max<=32));
 | 
						|
            
 | 
						|
              { generate code for the element to set }
 | 
						|
              maybe_save(exprasmlist,tcallparanode(tcallparanode(left).right).left.registers32,
 | 
						|
                        tcallparanode(left).left.location,pushedregs);
 | 
						|
              secondpass(tcallparanode(tcallparanode(left).right).left);
 | 
						|
              maybe_restore(exprasmlist,tcallparanode(left).left.location,pushedregs);
 | 
						|
              
 | 
						|
              { bitnumber - which must be loaded into register }
 | 
						|
              hregister := cg.get_scratch_reg_int(exprasmlist);
 | 
						|
              hregister2 := rg.getregisterint(exprasmlist);
 | 
						|
              
 | 
						|
              case tcallparanode(tcallparanode(left).right).left.location.loc of
 | 
						|
                 LOC_CREGISTER,
 | 
						|
                 LOC_REGISTER:
 | 
						|
                   begin
 | 
						|
                     cg.a_load_reg_reg(exprasmlist,OS_INT,
 | 
						|
                       tcallparanode(tcallparanode(left).right).left.location.register,hregister);
 | 
						|
                   end;
 | 
						|
                 LOC_REFERENCE:
 | 
						|
                   begin
 | 
						|
                     cgsize := def_cgsize(tcallparanode(tcallparanode(left).right).left.resulttype.def);
 | 
						|
                     cg.a_load_ref_reg(exprasmlist,cgsize,
 | 
						|
                       tcallparanode(tcallparanode(left).right).left.location.reference,hregister);
 | 
						|
                   end;
 | 
						|
               else
 | 
						|
                 internalerror(20020727);
 | 
						|
               end;
 | 
						|
               { hregister contains the bitnumber to add }
 | 
						|
               cg.a_load_const_reg(exprasmlist, OS_INT, 1, hregister2);
 | 
						|
               cg.a_op_reg_reg(exprasmlist, OP_SHL, OS_INT, hregister, hregister2);
 | 
						|
              
 | 
						|
              
 | 
						|
              if use_small then
 | 
						|
                begin
 | 
						|
                  { possiblities : 
 | 
						|
                       bitnumber : LOC_REFERENCE, LOC_REGISTER, LOC_CREGISTER
 | 
						|
                       set value : LOC_REFERENCE, LOC_REGISTER
 | 
						|
                  }
 | 
						|
                  { location of set }
 | 
						|
                  if (tcallparanode(left).left.location.loc=LOC_REFERENCE) then
 | 
						|
                    begin
 | 
						|
                     if inlinenumber=in_include_x_y then
 | 
						|
                       begin
 | 
						|
                         cg.a_op_reg_ref(exprasmlist, OP_OR, OS_32, hregister2, 
 | 
						|
                         tcallparanode(left).left.location.reference);
 | 
						|
                       end
 | 
						|
                     else
 | 
						|
                       begin
 | 
						|
                         cg.a_op_reg_reg(exprasmlist, OP_NOT, OS_32, hregister2, 
 | 
						|
                         hregister2);
 | 
						|
                         cg.a_op_reg_ref(exprasmlist, OP_AND, OS_32, hregister2, 
 | 
						|
                         tcallparanode(left).left.location.reference);
 | 
						|
                       end;
 | 
						|
                      
 | 
						|
                    end
 | 
						|
                  else
 | 
						|
                    internalerror(20020728);
 | 
						|
                end
 | 
						|
              else
 | 
						|
                begin
 | 
						|
                  { possiblities : 
 | 
						|
                       bitnumber : LOC_REFERENCE, LOC_REGISTER, LOC_CREGISTER
 | 
						|
                       set value : LOC_REFERENCE
 | 
						|
                  }
 | 
						|
                  { hregister contains the bitnumber (div 32 to get the correct offset) }
 | 
						|
                  cg.a_op_const_reg(exprasmlist, OP_SHR, 5, hregister);
 | 
						|
                  addrreg := cg.get_scratch_reg_address(exprasmlist);
 | 
						|
                  { calculate the correct address of the operand }
 | 
						|
                  cg.a_loadaddr_ref_reg(exprasmlist, tcallparanode(left).left.location.reference,addrreg);
 | 
						|
                  cg.a_op_reg_reg(exprasmlist, OP_ADD, OS_INT, hregister, addrreg);
 | 
						|
                  reference_reset_base(href,addrreg,0);
 | 
						|
                  
 | 
						|
                  if inlinenumber=in_include_x_y then
 | 
						|
                       begin
 | 
						|
                         cg.a_op_reg_ref(exprasmlist, OP_OR, OS_32, hregister2, href);
 | 
						|
                       end
 | 
						|
                     else
 | 
						|
                       begin
 | 
						|
                         cg.a_op_reg_reg(exprasmlist, OP_NOT, OS_32, hregister2, hregister2);
 | 
						|
                         cg.a_op_reg_ref(exprasmlist, OP_AND, OS_32, hregister2, href);
 | 
						|
                       end;
 | 
						|
                       
 | 
						|
                  cg.free_scratch_reg(exprasmlist, addrreg);
 | 
						|
                end;
 | 
						|
                cg.free_scratch_reg(exprasmlist,hregister);
 | 
						|
                rg.ungetregisterint(exprasmlist,hregister2); 
 | 
						|
            end;
 | 
						|
        end;
 | 
						|
 | 
						|
{*****************************************************************************
 | 
						|
                            FLOAT GENERIC HANDLING
 | 
						|
*****************************************************************************}
 | 
						|
 | 
						|
{
 | 
						|
  These routines all call internal RTL routines, so if they are
 | 
						|
  called here, they give an internal error
 | 
						|
}
 | 
						|
    procedure tcginlinenode.second_pi;
 | 
						|
      begin
 | 
						|
        internalerror(20020718);
 | 
						|
      end;
 | 
						|
 | 
						|
    procedure tcginlinenode.second_arctan_real;
 | 
						|
      begin
 | 
						|
        internalerror(20020718);
 | 
						|
      end;
 | 
						|
 | 
						|
    procedure tcginlinenode.second_abs_real;
 | 
						|
      begin
 | 
						|
        internalerror(20020718);
 | 
						|
      end;
 | 
						|
 | 
						|
 | 
						|
    procedure tcginlinenode.second_sqr_real;
 | 
						|
      begin
 | 
						|
        internalerror(20020718);
 | 
						|
      end;
 | 
						|
 | 
						|
    procedure tcginlinenode.second_sqrt_real;
 | 
						|
      begin
 | 
						|
        internalerror(20020718);
 | 
						|
      end;
 | 
						|
 | 
						|
    procedure tcginlinenode.second_ln_real;
 | 
						|
      begin
 | 
						|
        internalerror(20020718);
 | 
						|
      end;
 | 
						|
 | 
						|
    procedure tcginlinenode.second_cos_real;
 | 
						|
      begin
 | 
						|
        internalerror(20020718);
 | 
						|
      end;
 | 
						|
 | 
						|
    procedure tcginlinenode.second_sin_real;
 | 
						|
      begin
 | 
						|
        internalerror(20020718);
 | 
						|
      end;
 | 
						|
 | 
						|
begin
 | 
						|
   cinlinenode:=tcginlinenode;
 | 
						|
end.
 | 
						|
 | 
						|
{
 | 
						|
  $Log$
 | 
						|
  Revision 1.10  2002-08-05 18:27:48  carl
 | 
						|
    + more more more documentation
 | 
						|
    + first version include/exclude (can't test though, not enough scratch for i386 :()...
 | 
						|
 | 
						|
  Revision 1.9  2002/08/04 19:06:41  carl
 | 
						|
    + added generic exception support (still does not work!)
 | 
						|
    + more documentation
 | 
						|
 | 
						|
  Revision 1.8  2002/07/31 07:54:59  jonas
 | 
						|
    * re-enabled second_assigned()
 | 
						|
 | 
						|
  Revision 1.7  2002/07/30 20:50:43  florian
 | 
						|
    * the code generator knows now if parameters are in registers
 | 
						|
 | 
						|
  Revision 1.6  2002/07/29 21:23:42  florian
 | 
						|
    * more fixes for the ppc
 | 
						|
    + wrappers for the tcnvnode.first_* stuff introduced
 | 
						|
 | 
						|
  Revision 1.5  2002/07/28 20:45:22  florian
 | 
						|
    + added direct assembler reader for PowerPC
 | 
						|
 | 
						|
  Revision 1.4  2002/07/26 09:45:20  florian
 | 
						|
    * fixed a mistake in yesterday's commit, forgot to commit it
 | 
						|
 | 
						|
  Revision 1.3  2002/07/25 22:58:30  florian
 | 
						|
  no message
 | 
						|
 | 
						|
  Revision 1.2  2002/07/25 17:55:41  carl
 | 
						|
    + First working revision
 | 
						|
 | 
						|
  Revision 1.1  2002/07/24 04:07:49  carl
 | 
						|
   + first revision (incomplete)
 | 
						|
}
 |