mirror of
				https://gitlab.com/freepascal.org/fpc/source.git
				synced 2025-11-04 09:02:22 +01:00 
			
		
		
		
	
		
			
				
	
	
		
			207 lines
		
	
	
		
			6.4 KiB
		
	
	
	
		
			ObjectPascal
		
	
	
	
	
	
			
		
		
	
	
			207 lines
		
	
	
		
			6.4 KiB
		
	
	
	
		
			ObjectPascal
		
	
	
	
	
	
{
 | 
						|
    $Id$
 | 
						|
    Copyright (c) 1998-2002 by Florian Klaempfl and Carl Eric Codere
 | 
						|
 | 
						|
    Generate PowerPC assembler for in set/case 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 nppcset;
 | 
						|
 | 
						|
{$i fpcdefs.inc}
 | 
						|
 | 
						|
interface
 | 
						|
 | 
						|
    uses
 | 
						|
       node,nset,ncgset,cpubase,cginfo,cgbase,cgobj,aasmbase,aasmtai;
 | 
						|
 | 
						|
    type
 | 
						|
 | 
						|
       tppccasenode = class(tcgcasenode)
 | 
						|
         protected
 | 
						|
           procedure genlinearlist(hp : pcaserecord); override;
 | 
						|
       end;
 | 
						|
 | 
						|
 | 
						|
implementation
 | 
						|
 | 
						|
    uses
 | 
						|
      globtype,systems,
 | 
						|
      verbose,globals,
 | 
						|
      symconst,symdef,defbase,
 | 
						|
      paramgr,
 | 
						|
      pass_2,cgcpu,
 | 
						|
      ncon,
 | 
						|
      cga,tgobj,ncgutil,regvars,rgobj,aasmcpu;
 | 
						|
 | 
						|
 | 
						|
 | 
						|
{*****************************************************************************
 | 
						|
                            TCGCASENODE
 | 
						|
*****************************************************************************}
 | 
						|
 | 
						|
 | 
						|
    procedure tppccasenode.genlinearlist(hp : pcaserecord);
 | 
						|
 | 
						|
      var
 | 
						|
         first : boolean;
 | 
						|
         last : TConstExprInt;
 | 
						|
         resflags: tresflags;
 | 
						|
 | 
						|
      procedure genitem(t : pcaserecord);
 | 
						|
 | 
						|
          procedure gensub(value:longint);
 | 
						|
          var
 | 
						|
            tmpreg: tregister;
 | 
						|
          begin
 | 
						|
            value := -value;
 | 
						|
            if (value >= low(smallint)) and
 | 
						|
               (value <= high(smallint)) then
 | 
						|
              exprasmlist.concat(taicpu.op_reg_reg_const(A_ADDIC_,hregister,
 | 
						|
                hregister,value))
 | 
						|
            else
 | 
						|
              begin
 | 
						|
                tmpreg := cg.get_scratch_reg_int(exprasmlist);
 | 
						|
                cg.a_load_const_reg(exprasmlist,OS_INT,value,tmpreg);
 | 
						|
                exprasmlist.concat(taicpu.op_reg_reg_reg(A_ADD_,hregister,
 | 
						|
                  hregister,tmpreg));
 | 
						|
                cg.free_scratch_reg(exprasmlist,tmpreg);
 | 
						|
              end;
 | 
						|
          end;
 | 
						|
 | 
						|
        begin
 | 
						|
           if assigned(t^.less) then
 | 
						|
             genitem(t^.less);
 | 
						|
           { need we to test the first value }
 | 
						|
           if first and (t^._low>get_min_value(left.resulttype.def)) then
 | 
						|
             begin
 | 
						|
               cg.a_cmp_const_reg_label(exprasmlist,OS_INT,jmp_lt,
 | 
						|
                 longint(t^._low),hregister,elselabel);
 | 
						|
             end;
 | 
						|
           if t^._low=t^._high then
 | 
						|
             begin
 | 
						|
                if t^._low-last=0 then
 | 
						|
                  exprasmlist.concat(taicpu.op_reg_reg_const(A_CMPWI,R_CR0,
 | 
						|
                    hregister,0))
 | 
						|
                else
 | 
						|
                  gensub(longint(t^._low-last));
 | 
						|
                last:=t^._low;
 | 
						|
                resflags.cr := R_CR0;
 | 
						|
                resflags.flag := F_EQ;
 | 
						|
                cg.a_jmp_flags(exprasmlist,resflags,t^.statement);
 | 
						|
             end
 | 
						|
           else
 | 
						|
             begin
 | 
						|
                { it begins with the smallest label, if the value }
 | 
						|
                { is even smaller then jump immediately to the    }
 | 
						|
                { ELSE-label                                }
 | 
						|
                if first then
 | 
						|
                  begin
 | 
						|
                     { have we to ajust the first value ? }
 | 
						|
                     if (t^._low>get_min_value(left.resulttype.def)) then
 | 
						|
                       gensub(longint(t^._low));
 | 
						|
                  end
 | 
						|
                else
 | 
						|
                  begin
 | 
						|
                    { if there is no unused label between the last and the }
 | 
						|
                    { present label then the lower limit can be checked    }
 | 
						|
                    { immediately. else check the range in between:       }
 | 
						|
 | 
						|
                    { note: you can't use gensub() here because dec doesn't }
 | 
						|
                    { change the carry flag (needed for jmp_lxx) (JM)       }
 | 
						|
                    gensub(longint(t^._low-last));
 | 
						|
                    tcgppc(cg).a_jmp_cond(exprasmlist,jmp_lt,elselabel);
 | 
						|
                  end;
 | 
						|
                gensub(longint(t^._high-t^._low));
 | 
						|
                tcgppc(cg).a_jmp_cond(exprasmlist,jmp_le,t^.statement);
 | 
						|
                last:=t^._high;
 | 
						|
             end;
 | 
						|
           first:=false;
 | 
						|
           if assigned(t^.greater) then
 | 
						|
             genitem(t^.greater);
 | 
						|
        end;
 | 
						|
 | 
						|
      begin
 | 
						|
         { do we need to generate cmps? }
 | 
						|
         if (with_sign and (min_label<0)) then
 | 
						|
           genlinearcmplist(hp)
 | 
						|
         else
 | 
						|
           begin
 | 
						|
              last:=0;
 | 
						|
              first:=true;
 | 
						|
              genitem(hp);
 | 
						|
              cg.a_jmp_always(exprasmlist,elselabel);
 | 
						|
           end;
 | 
						|
      end;
 | 
						|
 | 
						|
 | 
						|
 | 
						|
 | 
						|
begin
 | 
						|
   ccasenode:=tppccasenode;
 | 
						|
end.
 | 
						|
{
 | 
						|
  $Log$
 | 
						|
  Revision 1.1  2002-08-11 11:39:12  jonas
 | 
						|
    + powerpc-specific genlinearlist
 | 
						|
 | 
						|
  Revision 1.13  2002/08/11 06:14:40  florian
 | 
						|
    * fixed powerpc compilation problems
 | 
						|
 | 
						|
  Revision 1.12  2002/08/10 17:15:12  jonas
 | 
						|
    * optimizations and bugfix
 | 
						|
 | 
						|
  Revision 1.11  2002/07/28 09:24:18  carl
 | 
						|
  + generic case node
 | 
						|
 | 
						|
  Revision 1.10  2002/07/23 14:31:00  daniel
 | 
						|
  * Added internal error when asked to generate code for 'if expr in []'
 | 
						|
 | 
						|
  Revision 1.9  2002/07/23 12:34:30  daniel
 | 
						|
  * Readded old set code. To use it define 'oldset'. Activated by default
 | 
						|
    for ppc.
 | 
						|
 | 
						|
  Revision 1.8  2002/07/22 11:48:04  daniel
 | 
						|
  * Sets are now internally sets.
 | 
						|
 | 
						|
  Revision 1.7  2002/07/21 16:58:20  jonas
 | 
						|
    * fixed some bugs in tcginnode.pass_2() and optimized the bit test
 | 
						|
 | 
						|
  Revision 1.6  2002/07/20 11:57:54  florian
 | 
						|
    * types.pas renamed to defbase.pas because D6 contains a types
 | 
						|
      unit so this would conflicts if D6 programms are compiled
 | 
						|
    + Willamette/SSE2 instructions to assembler added
 | 
						|
 | 
						|
  Revision 1.5  2002/07/11 14:41:28  florian
 | 
						|
    * start of the new generic parameter handling
 | 
						|
 | 
						|
  Revision 1.4  2002/07/07 10:16:29  florian
 | 
						|
    * problems with last commit fixed
 | 
						|
 | 
						|
  Revision 1.3  2002/07/06 20:19:25  carl
 | 
						|
  + generic set handling
 | 
						|
 | 
						|
  Revision 1.2  2002/07/01 16:23:53  peter
 | 
						|
    * cg64 patch
 | 
						|
    * basics for currency
 | 
						|
    * asnode updates for class and interface (not finished)
 | 
						|
 | 
						|
  Revision 1.1  2002/06/16 08:14:56  carl
 | 
						|
  + generic sets
 | 
						|
 | 
						|
}
 |