Browse Source

* range checking is now processor independent (part in cgobj, part in cg64f32) and should work correctly again (it needed some changes after the changes of the low and high of tordef's to int64) * maketojumpbool() is now processor independent (in ncgutil) * getregister32 is now called getregisterint

Jonas Maebe 23 years ago
parent
commit
f15dbd7bf0

+ 251 - 3
compiler/cg64f32.pas

@@ -30,7 +30,7 @@ unit cg64f32;
   interface
   interface
 
 
     uses
     uses
-       aasm, cgobj, cpubase;
+       aasm, cgobj, cpubase,node,symtype;
 
 
     type
     type
       tcg64f32 = class(tcg)
       tcg64f32 = class(tcg)
@@ -38,12 +38,30 @@ unit cg64f32;
         procedure a_load64_ref_reg(list : taasmoutput;const ref : treference;reglo,reghi : tregister);
         procedure a_load64_ref_reg(list : taasmoutput;const ref : treference;reglo,reghi : tregister);
         procedure a_load64_reg_reg(list : taasmoutput;reglosrc,reghisrc,reglodst,reghidst : tregister);
         procedure a_load64_reg_reg(list : taasmoutput;reglosrc,reghisrc,reglodst,reghidst : tregister);
         procedure a_load64_loc_reg(list : taasmoutput;const l : tlocation;reglo,reghi : tregister);
         procedure a_load64_loc_reg(list : taasmoutput;const l : tlocation;reglo,reghi : tregister);
+        procedure a_load64high_reg_ref(list : taasmoutput;reg : tregister;const ref : treference);
+        procedure a_load64low_reg_ref(list : taasmoutput;reg : tregister;const ref : treference);
+        procedure a_load64high_ref_reg(list : taasmoutput;const ref : treference;reg : tregister);
+        procedure a_load64low_ref_reg(list : taasmoutput;const ref : treference;reg : tregister);
+
+        { override to catch 64bit rangechecks }
+        procedure g_rangecheck(list: taasmoutput; const p: tnode;
+          const todef: tdef); override;
+
+       private
+         { produces range check code for 32bit processors when one of the }
+         { operands is 64 bit                                             }
+         procedure g_rangecheck64(list : taasmoutput; p : tnode;todef : tdef);
+
       end;
       end;
 
 
   implementation
   implementation
 
 
     uses
     uses
-       globals,systems,cgbase,verbose;
+       globtype,globals,systems,
+       cgbase,
+       verbose,
+       symbase,symconst,symdef,types,
+       cpuinfo;
 
 
     procedure tcg64f32.a_load64_reg_ref(list : taasmoutput;reglo, reghi : tregister;const ref : treference);
     procedure tcg64f32.a_load64_reg_ref(list : taasmoutput;reglo, reghi : tregister;const ref : treference);
       var
       var
@@ -100,6 +118,233 @@ unit cg64f32;
         end;
         end;
       end;
       end;
 
 
+
+    procedure tcg64f32.a_load64high_reg_ref(list : taasmoutput;reg : tregister;const ref : treference);
+      var
+        tmpref: treference;
+      begin
+        if target_info.endian = endian_big then
+          a_load_reg_ref(list,OS_32,reg,ref)
+        else
+          begin
+            tmpref := ref;
+            inc(tmpref.offset,4);
+            a_load_reg_ref(list,OS_32,reg,tmpref)
+          end;
+      end;
+
+    procedure tcg64f32.a_load64low_reg_ref(list : taasmoutput;reg : tregister;const ref : treference);
+      var
+        tmpref: treference;
+      begin
+        if target_info.endian = endian_little then
+          a_load_reg_ref(list,OS_32,reg,ref)
+        else
+          begin
+            tmpref := ref;
+            inc(tmpref.offset,4);
+            a_load_reg_ref(list,OS_32,reg,tmpref)
+          end;
+      end;
+
+    procedure tcg64f32.a_load64high_ref_reg(list : taasmoutput;const ref : treference;reg : tregister);
+      var
+        tmpref: treference;
+      begin
+        if target_info.endian = endian_big then
+          a_load_ref_reg(list,OS_32,ref,reg)
+        else
+          begin
+            tmpref := ref;
+            inc(tmpref.offset,4);
+            a_load_ref_reg(list,OS_32,tmpref,reg)
+          end;
+      end;
+
+    procedure tcg64f32.a_load64low_ref_reg(list : taasmoutput;const ref : treference;reg : tregister);
+      var
+        tmpref: treference;
+      begin
+        if target_info.endian = endian_little then
+          a_load_ref_reg(list,OS_32,ref,reg)
+        else
+          begin
+            tmpref := ref;
+            inc(tmpref.offset,4);
+            a_load_ref_reg(list,OS_32,tmpref,reg)
+          end;
+      end;
+
+
+    procedure tcg64f32.g_rangecheck(list: taasmoutput; const p: tnode;
+        const todef: tdef);
+      begin
+        { range checking on and range checkable value? }
+        if not(cs_check_range in aktlocalswitches) or
+           not(todef.deftype in [orddef,enumdef,arraydef]) then
+          exit;
+        { special case for 64bit rangechecks }
+        if is_64bitint(p.resulttype.def) or is_64bitint(todef) then
+          g_rangecheck64(list,p,todef)
+        else
+          inherited g_rangecheck(list,p,todef);
+      end;
+
+
+    procedure tcg64f32.g_rangecheck64(list : taasmoutput; p : tnode;todef : tdef);
+
+      var
+        neglabel,
+        poslabel,
+        endlabel: tasmlabel;
+        hreg   : tregister;
+        hdef   :  torddef;
+        fromdef : tdef;
+        opsize   : tcgsize;
+        oldregisterdef: boolean;
+        from_signed,to_signed: boolean;
+        got_scratch: boolean;
+
+      begin
+         fromdef:=p.resulttype.def;
+         from_signed := is_signed(fromdef);
+         to_signed := is_signed(todef);
+
+         if not is_64bitint(todef) then
+           begin
+             oldregisterdef := registerdef;
+             registerdef := false;
+
+             { get the high dword in a register }
+             if p.location.loc in [LOC_REGISTER,LOC_CREGISTER] then
+               begin
+                 hreg := p.location.registerhigh;
+                 got_scratch := false
+               end
+             else
+               begin
+                 hreg := get_scratch_reg(list);
+                 got_scratch := true;
+                 a_load64high_ref_reg(list,p.location.reference,hreg);
+               end;
+             getlabel(poslabel);
+
+             { check high dword, must be 0 (for positive numbers) }
+             a_cmp_const_reg_label(list,OS_32,OC_EQ,0,hreg,poslabel);
+
+             { It can also be $ffffffff, but only for negative numbers }
+             if from_signed and to_signed then
+               begin
+                 getlabel(neglabel);
+                 a_cmp_const_reg_label(list,OS_32,OC_EQ,aword(-1),hreg,neglabel);
+               end;
+             { !!! freeing of register should happen directly after compare! (JM) }
+             if got_scratch then
+               free_scratch_reg(list,hreg);
+             { For all other values we have a range check error }
+             a_call_name(list,'FPC_RANGEERROR',0);
+
+             { if the high dword = 0, the low dword can be considered a }
+             { simple cardinal                                          }
+             a_label(list,poslabel);
+             hdef:=torddef.create(u32bit,0,longint($ffffffff));
+             { the real p.resulttype.def is already saved in fromdef }
+             p.resulttype.def := hdef;
+             { no use in calling just "g_rangecheck" since that one will }
+             { simply call the inherited method too (JM)                 }
+             inherited g_rangecheck(list,p,todef);
+             hdef.free;
+             { restore original resulttype.def }
+             p.resulttype.def := todef;
+
+             if from_signed and to_signed then
+               begin
+                 getlabel(endlabel);
+                 a_jmp_cond(list,OC_NONE,endlabel);
+                 { if the high dword = $ffffffff, then the low dword (when }
+                 { considered as a longint) must be < 0                    }
+                 a_label(list,neglabel);
+                 if p.location.loc in [LOC_REGISTER,LOC_CREGISTER] then
+                   begin
+                     hreg := p.location.registerlow;
+                     got_scratch := false
+                   end
+                 else
+                   begin
+                     hreg := get_scratch_reg(list);
+                     got_scratch := true;
+                     a_load64low_ref_reg(list,p.location.reference,hreg);
+                   end;
+                 { get a new neglabel (JM) }
+                 getlabel(neglabel);
+                 a_cmp_const_reg_label(list,OS_32,OC_LT,0,hreg,neglabel);
+                 { !!! freeing of register should happen directly after compare! (JM) }
+                 if got_scratch then
+                   free_scratch_reg(list,hreg);
+
+                 a_call_name(list,'FPC_RANGEERROR',0);
+
+                 { if we get here, the 64bit value lies between }
+                 { longint($80000000) and -1 (JM)               }
+                 a_label(list,neglabel);
+                 hdef:=torddef.create(s32bit,longint($80000000),-1);
+                 p.resulttype.def := hdef;
+                 inherited g_rangecheck(list,p,todef);
+                 hdef.free;
+                 a_label(list,endlabel);
+               end;
+             registerdef := oldregisterdef;
+             p.resulttype.def := fromdef;
+             { restore p's resulttype.def }
+           end
+         else
+           { todef = 64bit int }
+           { no 64bit subranges supported, so only a small check is necessary }
+
+           { if both are signed or both are unsigned, no problem! }
+           if (from_signed xor to_signed) and
+              { also not if the fromdef is unsigned and < 64bit, since that will }
+              { always fit in a 64bit int (todef is 64bit)                       }
+              (from_signed or
+               (torddef(fromdef).typ = u64bit)) then
+             begin
+               { in all cases, there is only a problem if the higest bit is set }
+               if p.location.loc in [LOC_REGISTER,LOC_CREGISTER] then
+                 begin
+                   if is_64bitint(fromdef) then
+                     begin
+                       hreg := p.location.registerhigh;
+                       opsize := OS_32;
+                     end
+                   else
+                     begin
+                       hreg := p.location.register;
+                       opsize := def_cgsize(p.resulttype.def);
+                     end;
+                   got_scratch := false;
+                 end
+               else
+                 begin
+                   hreg := get_scratch_reg(list);
+                   got_scratch := true;
+
+                   opsize := def_cgsize(p.resulttype.def);
+                   if opsize in [OS_64,OS_S64] then
+                     a_load64high_ref_reg(list,p.location.reference,hreg)
+                   else
+                     a_load_ref_reg(list,opsize,p.location.reference,hreg);
+                 end;
+               getlabel(poslabel);
+               a_cmp_const_reg_label(list,opsize,OC_GTE,0,hreg,poslabel);
+
+               { !!! freeing of register should happen directly after compare! (JM) }
+               if got_scratch then
+                 free_scratch_reg(list,hreg);
+               a_call_name(list,'FPC_RANGEERROR',0);
+               a_label(list,poslabel);
+             end;
+      end;
+
 (*
 (*
     procedure int64f32_assignment_int64_reg(p : passignmentnode);
     procedure int64f32_assignment_int64_reg(p : passignmentnode);
 
 
@@ -113,7 +358,10 @@ begin
 end.
 end.
 {
 {
   $Log$
   $Log$
-  Revision 1.1  2001-12-29 15:29:58  jonas
+  Revision 1.2  2001-12-30 17:24:48  jonas
+    * range checking is now processor independent (part in cgobj, part in
    cg64f32) and should work correctly again (it needed some changes after
    the changes of the low and high of tordef's to int64)
  * maketojumpbool() is now processor independent (in ncgutil)
  * getregister32 is now called getregisterint
+
+  Revision 1.1  2001/12/29 15:29:58  jonas
     * powerpc/cgcpu.pas compiles :)
     * powerpc/cgcpu.pas compiles :)
     * several powerpc-related fixes
     * several powerpc-related fixes
     * cpuasm unit is now based on common tainst unit
     * cpuasm unit is now based on common tainst unit

+ 14 - 5
compiler/cgbase.pas

@@ -34,7 +34,7 @@ unit cgbase;
       { symtable }
       { symtable }
       symconst,symtype,symdef,symsym,
       symconst,symtype,symdef,symsym,
       { aasm }
       { aasm }
-      aasm,cpubase
+      aasm,cpubase, cpuinfo
       ;
       ;
 
 
     type
     type
@@ -185,6 +185,7 @@ unit cgbase;
 
 
 
 
     function def_cgsize(const p1: tdef): tcgsize;
     function def_cgsize(const p1: tdef): tcgsize;
+    function int_cgsize(const l: aword): tcgsize;
 
 
     { return the inverse condition of opcmp }
     { return the inverse condition of opcmp }
     function inverse_opcmp(opcmp: topcmp): topcmp;
     function inverse_opcmp(opcmp: topcmp): topcmp;
@@ -445,7 +446,14 @@ implementation
 
 
     function def_cgsize(const p1: tdef): tcgsize;
     function def_cgsize(const p1: tdef): tcgsize;
       begin
       begin
-        case p1.size of
+        result := int_cgsize(p1.size);
+        if is_signed(p1) then
+          result := tcgsize(ord(result)+(ord(OS_S8)-ord(OS_8)));
+      end;
+
+    function int_cgsize(const l: aword): tcgsize;
+      begin
+        case l of
           1: result := OS_8;
           1: result := OS_8;
           2: result := OS_16;
           2: result := OS_16;
           4: result := OS_32;
           4: result := OS_32;
@@ -453,8 +461,6 @@ implementation
           else
           else
             internalerror(2001092311);
             internalerror(2001092311);
         end;
         end;
-        if is_signed(p1) then
-          result := tcgsize(ord(result)+(ord(OS_S8)-ord(OS_8)));
       end;
       end;
 
 
 
 
@@ -501,7 +507,10 @@ begin
 end.
 end.
 {
 {
   $Log$
   $Log$
-  Revision 1.4  2001-11-06 14:53:48  jonas
+  Revision 1.5  2001-12-30 17:24:48  jonas
+    * range checking is now processor independent (part in cgobj, part in
    cg64f32) and should work correctly again (it needed some changes after
    the changes of the low and high of tordef's to int64)
  * maketojumpbool() is now processor independent (in ncgutil)
  * getregister32 is now called getregisterint
+
+  Revision 1.4  2001/11/06 14:53:48  jonas
     * compiles again with -dmemdebug
     * compiles again with -dmemdebug
 
 
   Revision 1.3  2001/09/29 21:33:47  jonas
   Revision 1.3  2001/09/29 21:33:47  jonas

+ 159 - 6
compiler/cgobj.pas

@@ -29,7 +29,7 @@ unit cgobj;
 
 
     uses
     uses
        cclasses,aasm,symtable,cpuasm,cpubase,cgbase,cpuinfo,
        cclasses,aasm,symtable,cpuasm,cpubase,cgbase,cpuinfo,
-       symconst,symbase,symtype;
+       symconst,symbase,symtype,node;
 
 
     type
     type
        talignment = (AM_NATURAL,AM_NONE,AM_2BYTE,AM_4BYTE,AM_8BYTE);
        talignment = (AM_NATURAL,AM_NONE,AM_2BYTE,AM_4BYTE,AM_8BYTE);
@@ -146,19 +146,28 @@ unit cgobj;
           procedure a_op_reg_loc(list : taasmoutput; Op: TOpCG; size: TCGSize; reg: tregister; const loc: tlocation);
           procedure a_op_reg_loc(list : taasmoutput; Op: TOpCG; size: TCGSize; reg: tregister; const loc: tlocation);
           procedure a_op_ref_loc(list : taasmoutput; Op: TOpCG; size: TCGSize; const ref: TReference; const loc: tlocation);
           procedure a_op_ref_loc(list : taasmoutput; Op: TOpCG; size: TCGSize; const ref: TReference; const loc: tlocation);
 
 
+          { trinary operations for processors that support them, 'emulated' }
+          { on others. None with "ref" arguments since I don't think there  }
+          { are any processors that support it (JM)                         }
+          procedure a_op_const_reg_reg(list: taasmoutput; op: TOpCg;
+            size: tcgsize; a: aword; src, dst: tregister); virtual;
+          procedure a_op_reg_reg_reg(list: taasmoutput; op: TOpCg;
+            size: tcgsize; src1, src2, dst: tregister); virtual;
+
           {  comparison operations }
           {  comparison operations }
           procedure a_cmp_const_reg_label(list : taasmoutput;size : tcgsize;cmp_op : topcmp;a : aword;reg : tregister;
           procedure a_cmp_const_reg_label(list : taasmoutput;size : tcgsize;cmp_op : topcmp;a : aword;reg : tregister;
             l : tasmlabel);virtual; abstract;
             l : tasmlabel);virtual; abstract;
           procedure a_cmp_const_ref_label(list : taasmoutput;size : tcgsize;cmp_op : topcmp;a : aword;const ref : treference;
           procedure a_cmp_const_ref_label(list : taasmoutput;size : tcgsize;cmp_op : topcmp;a : aword;const ref : treference;
             l : tasmlabel); virtual;
             l : tasmlabel); virtual;
           procedure a_cmp_const_loc_label(list: taasmoutput; size: tcgsize;cmp_op: topcmp; a: aword; const loc: tlocation;
           procedure a_cmp_const_loc_label(list: taasmoutput; size: tcgsize;cmp_op: topcmp; a: aword; const loc: tlocation;
-            l : tasmlabel); virtual;
+            l : tasmlabel);
           procedure a_cmp_reg_reg_label(list : taasmoutput;size : tcgsize;cmp_op : topcmp;reg1,reg2 : tregister;l : tasmlabel); virtual; abstract;
           procedure a_cmp_reg_reg_label(list : taasmoutput;size : tcgsize;cmp_op : topcmp;reg1,reg2 : tregister;l : tasmlabel); virtual; abstract;
           procedure a_cmp_ref_reg_label(list : taasmoutput;size : tcgsize;cmp_op : topcmp; const ref: treference; reg : tregister; l : tasmlabel); virtual;
           procedure a_cmp_ref_reg_label(list : taasmoutput;size : tcgsize;cmp_op : topcmp; const ref: treference; reg : tregister; l : tasmlabel); virtual;
           procedure a_cmp_ref_loc_label(list: taasmoutput; size: tcgsize;cmp_op: topcmp; const ref: treference; const loc: tlocation;
           procedure a_cmp_ref_loc_label(list: taasmoutput; size: tcgsize;cmp_op: topcmp; const ref: treference; const loc: tlocation;
             l : tasmlabel);
             l : tasmlabel);
 
 
           procedure a_jmp_cond(list : taasmoutput;cond : TOpCmp;l: tasmlabel); virtual; abstract;
           procedure a_jmp_cond(list : taasmoutput;cond : TOpCmp;l: tasmlabel); virtual; abstract;
+          procedure a_jmp_flags(list : taasmoutput;const f : TResFlags;l: tasmlabel); virtual; abstract;
 
 
           procedure g_flags2reg(list: taasmoutput; const f: tresflags; reg: TRegister); virtual; abstract;
           procedure g_flags2reg(list: taasmoutput; const f: tresflags; reg: TRegister); virtual; abstract;
 
 
@@ -195,6 +204,13 @@ unit cgobj;
           { source points to                                    }
           { source points to                                    }
           procedure g_concatcopy(list : taasmoutput;const source,dest : treference;len : aword;delsource,loadref : boolean);virtual; abstract;
           procedure g_concatcopy(list : taasmoutput;const source,dest : treference;len : aword;delsource,loadref : boolean);virtual; abstract;
 
 
+          { generates rangechecking code for a node }
+          procedure g_rangecheck(list: taasmoutput; const p: tnode;
+            const todef: tdef); virtual;
+
+          { returns the tcgsize corresponding with the size of reg }
+          class function reg_cgsize(const reg: tregister) : tcgsize; virtual;
+
 {$ifdef i386}
 {$ifdef i386}
          { this one is only necessary due the the restrictions of the 80x86, }
          { this one is only necessary due the the restrictions of the 80x86, }
          { so make it a special case (JM)                                    }
          { so make it a special case (JM)                                    }
@@ -208,7 +224,7 @@ unit cgobj;
   implementation
   implementation
 
 
     uses
     uses
-       strings,globals,globtype,options,{files,}gdb,systems,
+       strings,globals,globtype,options,gdb,systems,
        ppu,verbose,types,{tgobj,}tgcpu,symdef,symsym,cga,tainst;
        ppu,verbose,types,{tgobj,}tgcpu,symdef,symsym,cga,tainst;
 
 
     const
     const
@@ -1071,7 +1087,7 @@ unit cgobj;
 {$ifdef i386}
 {$ifdef i386}
               case size of
               case size of
                 OS_8,OS_S8:
                 OS_8,OS_S8:
-                  tmpreg := reg32toreg8(getregister32);
+                  tmpreg := reg32toreg8(getregisterint);
                 OS_16,OS_S16:
                 OS_16,OS_S16:
                   tmpreg := reg32toreg16(get_scratch_reg(list));
                   tmpreg := reg32toreg16(get_scratch_reg(list));
                 else
                 else
@@ -1201,6 +1217,21 @@ unit cgobj;
         end;
         end;
       end;
       end;
 
 
+    procedure tcg.a_op_const_reg_reg(list: taasmoutput; op: TOpCg;
+        size: tcgsize; a: aword; src, dst: tregister);
+      begin
+        a_load_reg_reg(list,size,src,dst);
+        a_op_const_reg(list,op,a,dst);
+      end;
+
+    procedure tcg.a_op_reg_reg_reg(list: taasmoutput; op: TOpCg;
+        size: tcgsize; src1, src2, dst: tregister);
+      begin
+        a_load_reg_reg(list,size,src2,dst);
+        a_op_reg_reg(list,op,size,src1,dst);
+      end;
+
+
 
 
     procedure tcg.a_cmp_const_ref_label(list : taasmoutput;size : tcgsize;cmp_op : topcmp;a : aword;const ref : treference;
     procedure tcg.a_cmp_const_ref_label(list : taasmoutput;size : tcgsize;cmp_op : topcmp;a : aword;const ref : treference;
      l : tasmlabel);
      l : tasmlabel);
@@ -1258,7 +1289,7 @@ unit cgobj;
               { since all this is only necessary for the 80x86 (because EDI   }
               { since all this is only necessary for the 80x86 (because EDI   }
               { doesn't have an 8bit component which is directly addressable) }
               { doesn't have an 8bit component which is directly addressable) }
               if size in [OS_8,OS_S8] then
               if size in [OS_8,OS_S8] then
-                tmpreg := getregister32
+                tmpreg := getregisterint
               else
               else
 {$endif i386}
 {$endif i386}
               tmpreg := get_scratch_reg(list);
               tmpreg := get_scratch_reg(list);
@@ -1279,12 +1310,134 @@ unit cgobj;
         end;
         end;
       end;
       end;
 
 
+
+    procedure tcg.g_rangecheck(list: taasmoutput; const p: tnode;
+        const todef: tdef);
+    { generate range checking code for the value at location p. The type     }
+    { type used is checked against todefs ranges. fromdef (p.resulttype.def) }
+    { is the original type used at that location. When both defs are equal   }
+    { the check is also insert (needed for succ,pref,inc,dec)                }
+      var
+        neglabel : tasmlabel;
+        hreg : tregister;
+        fromdef : tdef;
+        lto,hto,
+        lfrom,hfrom : TConstExprInt;
+        from_signed: boolean;
+      begin
+        { range checking on and range checkable value? }
+        if not(cs_check_range in aktlocalswitches) or
+           not(todef.deftype in [orddef,enumdef,arraydef]) then
+          exit;
+        { only check when assigning to scalar, subranges are different, }
+        { when todef=fromdef then the check is always generated         }
+        fromdef:=p.resulttype.def;
+        getrange(p.resulttype.def,lfrom,hfrom);
+        getrange(todef,lto,hto);
+        { no range check if from and to are equal and are both longint/dword }
+        { (if we have a 32bit processor) or int64/qword, since such          }
+        { operations can at most cause overflows (JM)                        }
+        { Note that these checks are mostly processor independent, they only }
+        { have to be changed once we introduce 64bit subrange types          }
+        if (fromdef = todef) and
+          { then fromdef and todef can only be orddefs }
+           (((sizeof(aword) = 4) and
+             (((torddef(fromdef).typ = s32bit) and
+               (lfrom = low(longint)) and
+               (hfrom = high(longint))) or
+              ((torddef(fromdef).typ = u32bit) and
+               (lfrom = low(cardinal)) and
+               (hfrom = high(cardinal))))) or
+            is_64bitint(fromdef)) then
+          exit;
+        if todef<>fromdef then
+         begin
+           { if the from-range falls completely in the to-range, no check }
+           { is necessary                                                 }
+           if (lto<=lfrom) and (hto>=hfrom) then
+            exit;
+         end;
+        { generate the rangecheck code for the def where we are going to }
+        { store the result                                               }
+
+        { use the trick that                                                 }
+        { a <= x <= b <=> 0 <= x-a <= b-a <=> cardinal(x-a) <= cardinal(b-a) }
+
+        { To be able to do that, we have to make sure however that either    }
+        { fromdef and todef are both signed or unsigned, or that we leave    }
+        { the parts < 0 and > maxlongint out                                 }
+
+        { is_signed now also works for arrays (it checks the rangetype) (JM) }
+        from_signed := is_signed(fromdef);
+        if from_signed xor is_signed(todef) then
+          if from_signed then
+            { from is signed, to is unsigned }
+            begin
+              { if high(from) < 0 -> always range error }
+              if (hfrom < 0) or
+                 { if low(to) > maxlongint also range error }
+                 (lto > (high(aword) div 2)) then
+                begin
+                  a_call_name(list,'FPC_RANGEERROR',0);
+                  exit
+                end;
+              { from is signed and to is unsigned -> when looking at from }
+              { as an unsigned value, it must be < maxlongint (otherwise  }
+              { it's negative, which is invalid since "to" is unsigned)   }
+              if hto > (high(aword) div 2) then
+                hto := (high(aword) div 2);
+            end
+          else
+            { from is unsigned, to is signed }
+            begin
+              if (lfrom > (high(aword) div 2)) or
+                 (hto < 0) then
+                begin
+                  a_call_name(list,'FPC_RANGEERROR',0);
+                  exit
+                end;
+              { from is unsigned and to is signed -> when looking at to }
+              { as an unsigned value, it must be >= 0 (since negative   }
+              { values are the same as values > maxlongint)             }
+              if lto < 0 then
+                lto := 0;
+            end;
+
+        hreg := get_scratch_reg(list);
+        if (p.location.loc in [LOC_REGISTER,LOC_CREGISTER]) then
+          a_op_const_reg_reg(list,OP_SUB,def_cgsize(p.resulttype.def),
+           aword(lto),p.location.register,hreg)
+        else
+          begin
+            a_load_ref_reg(list,def_cgsize(p.resulttype.def),
+              p.location.reference,hreg);
+            a_op_const_reg(list,OP_SUB,aword(lto),hreg);
+          end;
+        getlabel(neglabel);
+        a_cmp_const_reg_label(list,OS_INT,OC_BE,aword(hto-lto),hreg,neglabel);
+        { !!! should happen right after the compare (JM) }
+        free_scratch_reg(list,hreg);
+        a_call_name(list,'FPC_RANGEERROR',0);
+        a_label(list,neglabel);
+      end;
+
+
+    function tcg.reg_cgsize(const reg: tregister) : tcgsize;
+      begin
+        reg_cgsize := OS_INT;
+      end;
+
+
+
 finalization
 finalization
   cg.free;
   cg.free;
 end.
 end.
 {
 {
   $Log$
   $Log$
-  Revision 1.5  2001-12-29 15:28:58  jonas
+  Revision 1.6  2001-12-30 17:24:48  jonas
+    * range checking is now processor independent (part in cgobj, part in
    cg64f32) and should work correctly again (it needed some changes after
    the changes of the low and high of tordef's to int64)
  * maketojumpbool() is now processor independent (in ncgutil)
  * getregister32 is now called getregisterint
+
+  Revision 1.5  2001/12/29 15:28:58  jonas
     * powerpc/cgcpu.pas compiles :)
     * powerpc/cgcpu.pas compiles :)
     * several powerpc-related fixes
     * several powerpc-related fixes
     * cpuasm unit is now based on common tainst unit
     * cpuasm unit is now based on common tainst unit

+ 11 - 8
compiler/i386/cga.pas

@@ -230,9 +230,9 @@ implementation
     function def_getreg(p1:tdef):tregister;
     function def_getreg(p1:tdef):tregister;
       begin
       begin
         case p1.size of
         case p1.size of
-         1 : def_getreg:=reg32toreg8(getregister32);
-         2 : def_getreg:=reg32toreg16(getregister32);
-         4 : def_getreg:=getregister32;
+         1 : def_getreg:=reg32toreg8(getregisterint);
+         2 : def_getreg:=reg32toreg16(getregisterint);
+         4 : def_getreg:=getregisterint;
         else
         else
          internalerror(130820003);
          internalerror(130820003);
         end;
         end;
@@ -284,7 +284,7 @@ implementation
       begin
       begin
         if (l.loc=LOC_FLAGS) then
         if (l.loc=LOC_FLAGS) then
          begin
          begin
-           hregister:=getregister32;
+           hregister:=getregisterint;
            case opsize of
            case opsize of
             S_W : hregister:=reg32toreg16(hregister);
             S_W : hregister:=reg32toreg16(hregister);
             S_B : hregister:=reg32toreg8(hregister);
             S_B : hregister:=reg32toreg8(hregister);
@@ -304,7 +304,7 @@ implementation
       begin
       begin
          if l.loc = LOC_JUMP then
          if l.loc = LOC_JUMP then
            begin
            begin
-             hregister:=getregister32;
+             hregister:=getregisterint;
              case opsize of
              case opsize of
                S_W : hregister:=reg32toreg16(hregister);
                S_W : hregister:=reg32toreg16(hregister);
                S_B : hregister:=reg32toreg8(hregister);
                S_B : hregister:=reg32toreg8(hregister);
@@ -361,7 +361,7 @@ implementation
       begin
       begin
          hreg:=makereg8(hregister);
          hreg:=makereg8(hregister);
          ai:=Taicpu.Op_reg(A_Setcc,S_B,hreg);
          ai:=Taicpu.Op_reg(A_Setcc,S_B,hreg);
-         ai.SetCondition(flag_2_cond[flag]);
+         ai.SetCondition(flags_to_cond(flag));
          exprasmList.concat(ai);
          exprasmList.concat(ai);
          if hreg<>hregister then
          if hreg<>hregister then
           begin
           begin
@@ -487,7 +487,7 @@ implementation
                                           { we can't do a getregister in the code generator }
                                           { we can't do a getregister in the code generator }
                                           { without problems!!!                             }
                                           { without problems!!!                             }
                                           if usablereg32>0 then
                                           if usablereg32>0 then
-                                            hreg:=reg32toreg8(getregister32)
+                                            hreg:=reg32toreg8(getregisterint)
                                           else
                                           else
                                             begin
                                             begin
                                                emit_reg(A_PUSH,S_L,R_EAX);
                                                emit_reg(A_PUSH,S_L,R_EAX);
@@ -2976,7 +2976,10 @@ implementation
 end.
 end.
 {
 {
   $Log$
   $Log$
-  Revision 1.12  2001-12-29 15:28:58  jonas
+  Revision 1.13  2001-12-30 17:24:45  jonas
+    * range checking is now processor independent (part in cgobj, part in
    cg64f32) and should work correctly again (it needed some changes after
    the changes of the low and high of tordef's to int64)
  * maketojumpbool() is now processor independent (in ncgutil)
  * getregister32 is now called getregisterint
+
+  Revision 1.12  2001/12/29 15:28:58  jonas
     * powerpc/cgcpu.pas compiles :)
     * powerpc/cgcpu.pas compiles :)
     * several powerpc-related fixes
     * several powerpc-related fixes
     * cpuasm unit is now based on common tainst unit
     * cpuasm unit is now based on common tainst unit

+ 125 - 4
compiler/i386/cgcpu.pas

@@ -27,10 +27,10 @@ unit cgcpu;
   interface
   interface
 
 
     uses
     uses
-       cgbase,cgobj,aasm,cpuasm,cpubase,cpuinfo;
+       cgbase,cgobj,cg64f32,aasm,cpuasm,cpubase,cpuinfo;
 
 
     type
     type
-      tcg386 = class(tcg)
+      tcg386 = class(tcg64f32)
 
 
         { passing parameters, per default the parameter is pushed }
         { passing parameters, per default the parameter is pushed }
         { nr gives the number of the parameter (enumerated from   }
         { nr gives the number of the parameter (enumerated from   }
@@ -53,6 +53,11 @@ unit cgcpu;
         procedure a_op_ref_reg(list : taasmoutput; Op: TOpCG; size: TCGSize; const ref: TReference; reg: TRegister); override;
         procedure a_op_ref_reg(list : taasmoutput; Op: TOpCG; size: TCGSize; const ref: TReference; reg: TRegister); override;
         procedure a_op_reg_ref(list : taasmoutput; Op: TOpCG; size: TCGSize;reg: TRegister; const ref: TReference); override;
         procedure a_op_reg_ref(list : taasmoutput; Op: TOpCG; size: TCGSize;reg: TRegister; const ref: TReference); override;
 
 
+        procedure a_op_const_reg_reg(list: taasmoutput; op: TOpCg;
+          size: tcgsize; a: aword; src, dst: tregister); override;
+        procedure a_op_reg_reg_reg(list: taasmoutput; op: TOpCg;
+          size: tcgsize; src1, src2, dst: tregister); override;
+
         { move instructions }
         { move instructions }
         procedure a_load_const_reg(list : taasmoutput; size: tcgsize; a : aword;reg : tregister);override;
         procedure a_load_const_reg(list : taasmoutput; size: tcgsize; a : aword;reg : tregister);override;
         procedure a_load_const_ref(list : taasmoutput; size: tcgsize; a : aword;const ref : treference);override;
         procedure a_load_const_ref(list : taasmoutput; size: tcgsize; a : aword;const ref : treference);override;
@@ -70,6 +75,8 @@ unit cgcpu;
         procedure a_cmp_ref_reg_label(list : taasmoutput;size : tcgsize;cmp_op : topcmp;const ref: treference; reg : tregister; l : tasmlabel); override;
         procedure a_cmp_ref_reg_label(list : taasmoutput;size : tcgsize;cmp_op : topcmp;const ref: treference; reg : tregister; l : tasmlabel); override;
 
 
         procedure a_jmp_cond(list : taasmoutput;cond : TOpCmp;l: tasmlabel); override;
         procedure a_jmp_cond(list : taasmoutput;cond : TOpCmp;l: tasmlabel); override;
+        procedure a_jmp_flags(list : taasmoutput;const f : TResFlags;l: tasmlabel); override;
+
         procedure g_flags2reg(list: taasmoutput; const f: tresflags; reg: TRegister); override;
         procedure g_flags2reg(list: taasmoutput; const f: tresflags; reg: TRegister); override;
 
 
 
 
@@ -86,6 +93,8 @@ unit cgcpu;
 
 
         function makeregsize(var reg: tregister; size: tcgsize): topsize; override;
         function makeregsize(var reg: tregister; size: tcgsize): topsize; override;
 
 
+        class function reg_cgsize(const reg: tregister): tcgsize; override;
+
        private
        private
 
 
         procedure sizes2load(s1: tcgsize; s2: topsize; var op: tasmop; var s3: topsize);
         procedure sizes2load(s1: tcgsize; s2: topsize; var op: tasmop; var s3: topsize);
@@ -307,6 +316,11 @@ unit cgcpu;
                 list.concat(taicpu.op_reg(A_INC,regsize(reg),reg))
                 list.concat(taicpu.op_reg(A_INC,regsize(reg),reg))
               else
               else
                 list.concat(taicpu.op_reg(A_DEC,regsize(reg),reg))
                 list.concat(taicpu.op_reg(A_DEC,regsize(reg),reg))
+            else if (a = 0) then
+              if (op <> OP_AND) then
+                exit
+              else
+                list.concat(taicpu.op_const_reg(A_MOV,regsize(reg),0,reg))
             else
             else
               list.concat(taicpu.op_const_reg(TOpCG2AsmOp[op],regsize(reg),
               list.concat(taicpu.op_const_reg(TOpCG2AsmOp[op],regsize(reg),
                 longint(a),reg));
                 longint(a),reg));
@@ -376,6 +390,11 @@ unit cgcpu;
               else
               else
                 list.concat(taicpu.op_ref(A_DEC,TCgSize2OpSize[size],
                 list.concat(taicpu.op_ref(A_DEC,TCgSize2OpSize[size],
                   newreference(ref)))
                   newreference(ref)))
+            else if (a = 0) then
+              if (op <> OP_AND) then
+                exit
+              else
+                a_load_const_ref(list,size,0,ref)
             else
             else
               list.concat(taicpu.op_const_ref(TOpCG2AsmOp[op],
               list.concat(taicpu.op_const_ref(TOpCG2AsmOp[op],
                 TCgSize2OpSize[size],longint(a),newreference(ref)));
                 TCgSize2OpSize[size],longint(a),newreference(ref)));
@@ -535,6 +554,88 @@ unit cgcpu;
          end;
          end;
        end;
        end;
 
 
+
+    procedure tcg386.a_op_const_reg_reg(list: taasmoutput; op: TOpCg;
+        size: tcgsize; a: aword; src, dst: tregister);
+      var
+        tmpref: treference;
+        power: longint;
+        opsize: topsize;
+      begin
+        opsize := regsize(src);
+        if (opsize <> S_L) or
+           not (size in [OS_32,OS_S32]) then
+          begin
+            inherited a_op_const_reg_reg(list,op,size,a,src,dst);
+            exit;
+          end;
+        { if we get here, we have to do a 32 bit calculation, guaranteed }
+        Case Op of
+          OP_DIV, OP_IDIV, OP_MUL, OP_AND, OP_OR, OP_XOR, OP_SHL, OP_SHR,
+          OP_SAR:
+            { can't do anything special for these }
+            inherited a_op_const_reg_reg(list,op,size,a,src,dst);
+          OP_IMUL:
+            begin
+              if not(cs_check_overflow in aktlocalswitches) and
+                 ispowerof2(longint(a),power) then
+                { can be done with a shift }
+                inherited a_op_const_reg_reg(list,op,size,a,src,dst);
+              list.concat(taicpu.op_const_reg_reg(A_IMUL,S_L,longint(a),src,dst));
+            end;
+          OP_ADD, OP_SUB:
+            if (a = 0) then
+              a_load_reg_reg(list,size,src,dst)
+            else
+              begin
+                reset_reference(tmpref);
+                tmpref.base := src;
+                tmpref.offset := longint(a);
+                if op = OP_SUB then
+                  tmpref.offset := -tmpref.offset;
+                list.concat(taicpu.op_ref_reg(A_LEA,S_L,newreference(tmpref),
+                  dst));
+              end
+          else internalerror(200112302);
+        end;
+      end;
+
+    procedure tcg386.a_op_reg_reg_reg(list: taasmoutput; op: TOpCg;
+        size: tcgsize; src1, src2, dst: tregister);
+      var
+        tmpref: treference;
+        power: longint;
+        opsize: topsize;
+      begin
+        opsize := regsize(src1);
+        if (opsize <> S_L) or
+           (regsize(src2) <> S_L) or
+           not (size in [OS_32,OS_S32]) then
+          begin
+            inherited a_op_reg_reg_reg(list,op,size,src1,src2,dst);
+            exit;
+          end;
+        { if we get here, we have to do a 32 bit calculation, guaranteed }
+        Case Op of
+          OP_DIV, OP_IDIV, OP_MUL, OP_AND, OP_OR, OP_XOR, OP_SHL, OP_SHR,
+          OP_SAR,OP_SUB,OP_NOT,OP_NEG:
+            { can't do anything special for these }
+            inherited a_op_reg_reg_reg(list,op,size,src1,src2,dst);
+          OP_IMUL:
+            list.concat(taicpu.op_reg_reg_reg(A_IMUL,S_L,src1,src2,dst));
+          OP_ADD:
+            begin
+              reset_reference(tmpref);
+              tmpref.base := src1;
+              tmpref.index := src2;
+              tmpref.scalefactor := 1;
+              list.concat(taicpu.op_ref_reg(A_LEA,S_L,newreference(tmpref),
+                dst));
+            end
+          else internalerror(200112303);
+        end;
+      end;
+
 {*************** compare instructructions ****************}
 {*************** compare instructructions ****************}
 
 
       procedure tcg386.a_cmp_const_reg_label(list : taasmoutput;size : tcgsize;cmp_op : topcmp;a : aword;reg : tregister;
       procedure tcg386.a_cmp_const_reg_label(list : taasmoutput;size : tcgsize;cmp_op : topcmp;a : aword;reg : tregister;
@@ -596,6 +697,15 @@ unit cgcpu;
          list.concat(ai);
          list.concat(ai);
        end;
        end;
 
 
+     procedure tcg386.a_jmp_flags(list : taasmoutput;const f : TResFlags;l: tasmlabel);
+       var
+         ai : taicpu;
+       begin
+         ai := Taicpu.op_sym(A_Jcc,S_NO,l);
+         ai.SetCondition(flags_to_cond(f));
+         ai.is_jmp := true;
+         list.concat(ai);
+       end;
 
 
      procedure tcg386.g_flags2reg(list: taasmoutput; const f: tresflags; reg: TRegister);
      procedure tcg386.g_flags2reg(list: taasmoutput; const f: tresflags; reg: TRegister);
 
 
@@ -605,7 +715,7 @@ unit cgcpu;
        begin
        begin
           hreg := makereg8(reg);
           hreg := makereg8(reg);
           ai:=Taicpu.Op_reg(A_Setcc,S_B,hreg);
           ai:=Taicpu.Op_reg(A_Setcc,S_B,hreg);
-          ai.SetCondition(flag_2_cond[f]);
+          ai.SetCondition(flags_to_cond(f));
           list.concat(ai);
           list.concat(ai);
           if hreg<>reg then
           if hreg<>reg then
            begin
            begin
@@ -718,6 +828,14 @@ unit cgcpu;
       end;
       end;
 
 
 
 
+    function tcg386.reg_cgsize(const reg: tregister): tcgsize;
+      const
+        regsize_2_cgsize: array[S_B..S_L] of tcgsize = (OS_8,OS_16,OS_32);
+      begin
+        result := regsize_2_cgsize[regsize(reg)];
+      end;
+
+
 {***************** This is private property, keep out! :) *****************}
 {***************** This is private property, keep out! :) *****************}
 
 
     procedure tcg386.sizes2load(s1: tcgsize; s2: topsize; var op: tasmop; var s3: topsize);
     procedure tcg386.sizes2load(s1: tcgsize; s2: topsize; var op: tasmop; var s3: topsize);
@@ -762,7 +880,10 @@ begin
 end.
 end.
 {
 {
   $Log$
   $Log$
-  Revision 1.5  2001-12-29 15:29:59  jonas
+  Revision 1.6  2001-12-30 17:24:46  jonas
+    * range checking is now processor independent (part in cgobj, part in
    cg64f32) and should work correctly again (it needed some changes after
    the changes of the low and high of tordef's to int64)
  * maketojumpbool() is now processor independent (in ncgutil)
  * getregister32 is now called getregisterint
+
+  Revision 1.5  2001/12/29 15:29:59  jonas
     * powerpc/cgcpu.pas compiles :)
     * powerpc/cgcpu.pas compiles :)
     * several powerpc-related fixes
     * several powerpc-related fixes
     * cpuasm unit is now based on common tainst unit
     * cpuasm unit is now based on common tainst unit

+ 12 - 7
compiler/i386/cpubase.pas

@@ -421,12 +421,6 @@ const
 type
 type
   TResFlags = (F_E,F_NE,F_G,F_L,F_GE,F_LE,F_C,F_NC,F_A,F_AE,F_B,F_BE);
   TResFlags = (F_E,F_NE,F_G,F_L,F_GE,F_LE,F_C,F_NC,F_A,F_AE,F_B,F_BE);
 
 
-const
-  { arrays for boolean location conversions }
-  flag_2_cond : array[TResFlags] of TAsmCond =
-     (C_E,C_NE,C_G,C_L,C_GE,C_LE,C_C,C_NC,C_A,C_AE,C_B,C_BE);
-
-
 {*****************************************************************************
 {*****************************************************************************
                                 Reference
                                 Reference
 *****************************************************************************}
 *****************************************************************************}
@@ -707,6 +701,7 @@ const
     procedure swap_location(var destloc,sourceloc : tlocation);
     procedure swap_location(var destloc,sourceloc : tlocation);
 
 
     procedure inverse_flags(var f: TResFlags);
     procedure inverse_flags(var f: TResFlags);
+    function flags_to_cond(const f: TResFlags) : TAsmCond;
 
 
 implementation
 implementation
 
 
@@ -943,6 +938,13 @@ end;
         f := flagsinvers[f];
         f := flagsinvers[f];
       end;
       end;
 
 
+    function flags_to_cond(const f: TResFlags) : TAsmCond;
+      const
+        flags_2_cond : array[TResFlags] of TAsmCond =
+          (C_E,C_NE,C_G,C_L,C_GE,C_LE,C_C,C_NC,C_A,C_AE,C_B,C_BE);
+      begin
+        result := flags_2_cond[f];
+      end;
 
 
 procedure InitCpu;
 procedure InitCpu;
 begin
 begin
@@ -955,7 +957,10 @@ end;
 end.
 end.
 {
 {
   $Log$
   $Log$
-  Revision 1.8  2001-12-29 15:29:59  jonas
+  Revision 1.9  2001-12-30 17:24:46  jonas
+    * range checking is now processor independent (part in cgobj, part in
    cg64f32) and should work correctly again (it needed some changes after
    the changes of the low and high of tordef's to int64)
  * maketojumpbool() is now processor independent (in ncgutil)
  * getregister32 is now called getregisterint
+
+  Revision 1.8  2001/12/29 15:29:59  jonas
     * powerpc/cgcpu.pas compiles :)
     * powerpc/cgcpu.pas compiles :)
     * several powerpc-related fixes
     * several powerpc-related fixes
     * cpuasm unit is now based on common tainst unit
     * cpuasm unit is now based on common tainst unit

+ 29 - 26
compiler/i386/n386add.pas

@@ -49,7 +49,7 @@ interface
       cgbase,temp_gen,pass_2,regvars,
       cgbase,temp_gen,pass_2,regvars,
       cpuasm,
       cpuasm,
       ncon,nset,
       ncon,nset,
-      tainst,cga,n386util,tgcpu;
+      tainst,cga,ncgutil,n386util,tgcpu;
 
 
     function ti386addnode.getresflags(unsigned : boolean) : tresflags;
     function ti386addnode.getresflags(unsigned : boolean) : tresflags;
 
 
@@ -305,10 +305,10 @@ interface
            case nodetype of
            case nodetype of
               ltn,gtn:
               ltn,gtn:
                 begin
                 begin
-                   emitjmp(flag_2_cond[getresflags(unsigned)],truelabel);
+                   emitjmp(flags_to_cond(getresflags(unsigned)),truelabel);
                    { cheat a little bit for the negative test }
                    { cheat a little bit for the negative test }
                    toggleflag(nf_swaped);
                    toggleflag(nf_swaped);
-                   emitjmp(flag_2_cond[getresflags(unsigned)],falselabel);
+                   emitjmp(flags_to_cond(getresflags(unsigned)),falselabel);
                    toggleflag(nf_swaped);
                    toggleflag(nf_swaped);
                 end;
                 end;
               lten,gten:
               lten,gten:
@@ -318,13 +318,13 @@ interface
                      nodetype:=ltn
                      nodetype:=ltn
                    else
                    else
                      nodetype:=gtn;
                      nodetype:=gtn;
-                   emitjmp(flag_2_cond[getresflags(unsigned)],truelabel);
+                   emitjmp(flags_to_cond(getresflags(unsigned)),truelabel);
                    { cheat for the negative test }
                    { cheat for the negative test }
                    if nodetype=ltn then
                    if nodetype=ltn then
                      nodetype:=gtn
                      nodetype:=gtn
                    else
                    else
                      nodetype:=ltn;
                      nodetype:=ltn;
-                   emitjmp(flag_2_cond[getresflags(unsigned)],falselabel);
+                   emitjmp(flags_to_cond(getresflags(unsigned)),falselabel);
                    nodetype:=oldnodetype;
                    nodetype:=oldnodetype;
                 end;
                 end;
               equaln:
               equaln:
@@ -343,7 +343,7 @@ interface
                 begin
                 begin
                    { the comparisaion of the low dword have to be }
                    { the comparisaion of the low dword have to be }
                    {  always unsigned!                            }
                    {  always unsigned!                            }
-                   emitjmp(flag_2_cond[getresflags(true)],truelabel);
+                   emitjmp(flags_to_cond(getresflags(true)),truelabel);
                    emitjmp(C_None,falselabel);
                    emitjmp(C_None,falselabel);
                 end;
                 end;
               equaln:
               equaln:
@@ -573,7 +573,7 @@ interface
                                         ungetiftemp(left.location.reference);
                                         ungetiftemp(left.location.reference);
                                         del_location(left.location);
                                         del_location(left.location);
 {!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!}
 {!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!}
-                                        hregister:=getregister32;
+                                        hregister:=getregisterint;
                                         emit_ref_reg(A_MOV,opsize,
                                         emit_ref_reg(A_MOV,opsize,
                                           newreference(left.location.reference),hregister);
                                           newreference(left.location.reference),hregister);
                                         clear_location(left.location);
                                         clear_location(left.location);
@@ -585,7 +585,7 @@ interface
                                       begin
                                       begin
                                         ungetiftemp(right.location.reference);
                                         ungetiftemp(right.location.reference);
                                         del_location(right.location);
                                         del_location(right.location);
-                                        hregister:=getregister32;
+                                        hregister:=getregisterint;
                                         emit_ref_reg(A_MOV,opsize,
                                         emit_ref_reg(A_MOV,opsize,
                                           newreference(right.location.reference),hregister);
                                           newreference(right.location.reference),hregister);
                                         clear_location(right.location);
                                         clear_location(right.location);
@@ -667,7 +667,7 @@ interface
                                         begin
                                         begin
                                          ungetiftemp(left.location.reference);
                                          ungetiftemp(left.location.reference);
                                          del_reference(left.location.reference);
                                          del_reference(left.location.reference);
-                                         hregister:=getregister32;
+                                         hregister:=getregisterint;
                                          emit_ref_reg(A_MOV,opsize,
                                          emit_ref_reg(A_MOV,opsize,
                                            newreference(left.location.reference),hregister);
                                            newreference(left.location.reference),hregister);
                                          clear_location(left.location);
                                          clear_location(left.location);
@@ -680,7 +680,7 @@ interface
                                         {save the register var in a temp register, because
                                         {save the register var in a temp register, because
                                           its value is going to be modified}
                                           its value is going to be modified}
                                           begin
                                           begin
-                                            hregister := getregister32;
+                                            hregister := getregisterint;
                                             emit_reg_reg(A_MOV,opsize,
                                             emit_reg_reg(A_MOV,opsize,
                                               left.location.register,hregister);
                                               left.location.register,hregister);
                                              clear_location(left.location);
                                              clear_location(left.location);
@@ -738,7 +738,7 @@ interface
                            { release left.location, since it's a   }
                            { release left.location, since it's a   }
                            { constant (JM)                             }
                            { constant (JM)                             }
                            release_loc(right.location);
                            release_loc(right.location);
-                           location.register := getregister32;
+                           location.register := getregisterint;
                            emitloadord2reg(right.location,torddef(u32bittype.def),location.register,false);
                            emitloadord2reg(right.location,torddef(u32bittype.def),location.register,false);
                            emit_const_reg(A_SHL,S_L,power,location.register)
                            emit_const_reg(A_SHL,S_L,power,location.register)
                          End
                          End
@@ -786,7 +786,7 @@ interface
                            exprasmList.concat(Tairegalloc.DeAlloc(R_EDX));
                            exprasmList.concat(Tairegalloc.DeAlloc(R_EDX));
                          if R_EAX in unused then
                          if R_EAX in unused then
                            exprasmList.concat(Tairegalloc.DeAlloc(R_EAX));
                            exprasmList.concat(Tairegalloc.DeAlloc(R_EAX));
-                         location.register := getregister32;
+                         location.register := getregisterint;
                          emit_reg_reg(A_MOV,S_L,R_EAX,location.register);
                          emit_reg_reg(A_MOV,S_L,R_EAX,location.register);
                          if popedx then
                          if popedx then
                           emit_reg(A_POP,S_L,R_EDX);
                           emit_reg(A_POP,S_L,R_EDX);
@@ -829,8 +829,8 @@ interface
                              else
                              else
                                begin
                                begin
                                   case opsize of
                                   case opsize of
-                                     S_L : hregister:=getregister32;
-                                     S_B : hregister:=reg32toreg8(getregister32);
+                                     S_L : hregister:=getregisterint;
+                                     S_B : hregister:=reg32toreg8(getregisterint);
                                   end;
                                   end;
                                   emit_reg_reg(A_MOV,opsize,left.location.register,
                                   emit_reg_reg(A_MOV,opsize,left.location.register,
                                     hregister);
                                     hregister);
@@ -850,9 +850,9 @@ interface
                                begin
                                begin
                                   { first give free, then demand new register }
                                   { first give free, then demand new register }
                                   case opsize of
                                   case opsize of
-                                     S_L : hregister:=getregister32;
-                                     S_W : hregister:=reg32toreg16(getregister32);
-                                     S_B : hregister:=reg32toreg8(getregister32);
+                                     S_L : hregister:=getregisterint;
+                                     S_W : hregister:=reg32toreg16(getregisterint);
+                                     S_B : hregister:=reg32toreg8(getregisterint);
                                   end;
                                   end;
                                   emit_ref_reg(A_MOV,opsize,
                                   emit_ref_reg(A_MOV,opsize,
                                     newreference(left.location.reference),hregister);
                                     newreference(left.location.reference),hregister);
@@ -1059,7 +1059,7 @@ interface
                                hregister:=location.register
                                hregister:=location.register
                              else
                              else
                                begin
                                begin
-                                  hregister:=reg32toreg8(getregister32);
+                                  hregister:=reg32toreg8(getregisterint);
                                   emit_reg_reg(A_MOV,S_B,location.register,
                                   emit_reg_reg(A_MOV,S_B,location.register,
                                     hregister);
                                     hregister);
                                end;
                                end;
@@ -1069,7 +1069,7 @@ interface
                              del_reference(location.reference);
                              del_reference(location.reference);
 
 
                              { first give free then demand new register }
                              { first give free then demand new register }
-                             hregister:=reg32toreg8(getregister32);
+                             hregister:=reg32toreg8(getregisterint);
                              emit_ref_reg(A_MOV,S_B,newreference(location.reference),
                              emit_ref_reg(A_MOV,S_B,newreference(location.reference),
                                hregister);
                                hregister);
                           end;
                           end;
@@ -1134,7 +1134,7 @@ interface
                                hregister:=location.register
                                hregister:=location.register
                              else
                              else
                                begin
                                begin
-                                  hregister:=reg32toreg16(getregister32);
+                                  hregister:=reg32toreg16(getregisterint);
                                   emit_reg_reg(A_MOV,S_W,location.register,
                                   emit_reg_reg(A_MOV,S_W,location.register,
                                     hregister);
                                     hregister);
                                end;
                                end;
@@ -1144,7 +1144,7 @@ interface
                              del_reference(location.reference);
                              del_reference(location.reference);
 
 
                              { first give free then demand new register }
                              { first give free then demand new register }
-                             hregister:=reg32toreg16(getregister32);
+                             hregister:=reg32toreg16(getregisterint);
                              emit_ref_reg(A_MOV,S_W,newreference(location.reference),
                              emit_ref_reg(A_MOV,S_W,newreference(location.reference),
                                hregister);
                                hregister);
                           end;
                           end;
@@ -1274,8 +1274,8 @@ interface
                                     end
                                     end
                                   else
                                   else
                                     begin
                                     begin
-                                       hregister:=getregister32;
-                                       hregister2:=getregister32;
+                                       hregister:=getregisterint;
+                                       hregister2:=getregisterint;
                                        emit_reg_reg(A_MOV,S_L,left.location.registerlow,
                                        emit_reg_reg(A_MOV,S_L,left.location.registerlow,
                                          hregister);
                                          hregister);
                                        emit_reg_reg(A_MOV,S_L,left.location.registerhigh,
                                        emit_reg_reg(A_MOV,S_L,left.location.registerhigh,
@@ -1294,8 +1294,8 @@ interface
                                     end
                                     end
                                   else
                                   else
                                     begin
                                     begin
-                                       hregister:=getregister32;
-                                       hregister2:=getregister32;
+                                       hregister:=getregisterint;
+                                       hregister2:=getregisterint;
                                        emit_mov_ref_reg64(left.location.reference,hregister,hregister2);
                                        emit_mov_ref_reg64(left.location.reference,hregister,hregister2);
                                     end;
                                     end;
                                end;
                                end;
@@ -1863,7 +1863,10 @@ begin
 end.
 end.
 {
 {
   $Log$
   $Log$
-  Revision 1.27  2001-12-29 15:29:58  jonas
+  Revision 1.28  2001-12-30 17:24:46  jonas
+    * range checking is now processor independent (part in cgobj, part in
    cg64f32) and should work correctly again (it needed some changes after
    the changes of the low and high of tordef's to int64)
  * maketojumpbool() is now processor independent (in ncgutil)
  * getregister32 is now called getregisterint
+
+  Revision 1.27  2001/12/29 15:29:58  jonas
     * powerpc/cgcpu.pas compiles :)
     * powerpc/cgcpu.pas compiles :)
     * several powerpc-related fixes
     * several powerpc-related fixes
     * cpuasm unit is now based on common tainst unit
     * cpuasm unit is now based on common tainst unit

+ 10 - 7
compiler/i386/n386cnv.pas

@@ -63,7 +63,7 @@ implementation
       cgbase,temp_gen,pass_2,
       cgbase,temp_gen,pass_2,
       ncon,ncal,
       ncon,ncal,
       cpubase,
       cpubase,
-      cga,tgcpu,n386util;
+      cgobj,cga,tgcpu,n386util;
 
 
 
 
 {*****************************************************************************
 {*****************************************************************************
@@ -80,7 +80,7 @@ implementation
       begin
       begin
         { insert range check if not explicit conversion }
         { insert range check if not explicit conversion }
         if not(nf_explizit in flags) then
         if not(nf_explizit in flags) then
-          emitrangecheck(left,resulttype.def);
+          cg.g_rangecheck(exprasmlist,left,resulttype.def);
 
 
         { is the result size smaller ? }
         { is the result size smaller ? }
         if resulttype.def.size<left.resulttype.def.size then
         if resulttype.def.size<left.resulttype.def.size then
@@ -133,7 +133,7 @@ implementation
              end;
              end;
             { load the register we need }
             { load the register we need }
             if left.location.loc<>LOC_REGISTER then
             if left.location.loc<>LOC_REGISTER then
-              hregister:=getregister32
+              hregister:=getregisterint
             else
             else
               hregister:=left.location.register;
               hregister:=left.location.register;
 
 
@@ -144,7 +144,7 @@ implementation
             { do we need a second register for a 64 bit type ? }
             { do we need a second register for a 64 bit type ? }
             if is_64bitint(resulttype.def) then
             if is_64bitint(resulttype.def) then
               begin
               begin
-                 hregister2:=getregister32;
+                 hregister2:=getregisterint;
                  location.registerhigh:=hregister2;
                  location.registerhigh:=hregister2;
               end;
               end;
             case resulttype.def.size of
             case resulttype.def.size of
@@ -331,7 +331,7 @@ implementation
               begin
               begin
                 if is_64bitint(left.resulttype.def) then
                 if is_64bitint(left.resulttype.def) then
                  begin
                  begin
-                   hregister:=getregister32;
+                   hregister:=getregisterint;
                    emit_ref_reg(A_MOV,opsize,
                    emit_ref_reg(A_MOV,opsize,
                      newreference(left.location.reference),hregister);
                      newreference(left.location.reference),hregister);
                    pref:=newreference(left.location.reference);
                    pref:=newreference(left.location.reference);
@@ -350,7 +350,7 @@ implementation
               end;
               end;
             LOC_FLAGS :
             LOC_FLAGS :
               begin
               begin
-                hregister:=getregister32;
+                hregister:=getregisterint;
                 resflags:=left.location.resflags;
                 resflags:=left.location.resflags;
               end;
               end;
             LOC_REGISTER,LOC_CREGISTER :
             LOC_REGISTER,LOC_CREGISTER :
@@ -492,7 +492,10 @@ begin
 end.
 end.
 {
 {
   $Log$
   $Log$
-  Revision 1.28  2001-12-11 08:14:17  jonas
+  Revision 1.29  2001-12-30 17:24:46  jonas
+    * range checking is now processor independent (part in cgobj, part in
    cg64f32) and should work correctly again (it needed some changes after
    the changes of the low and high of tordef's to int64)
  * maketojumpbool() is now processor independent (in ncgutil)
  * getregister32 is now called getregisterint
+
+  Revision 1.28  2001/12/11 08:14:17  jonas
     * part of my fix for dynarray -> open array conversion, forgot to
     * part of my fix for dynarray -> open array conversion, forgot to
       commit yesterday :(
       commit yesterday :(
 
 

+ 17 - 14
compiler/i386/n386inl.pas

@@ -43,7 +43,7 @@ implementation
       cgbase,temp_gen,pass_1,pass_2,
       cgbase,temp_gen,pass_1,pass_2,
       cpubase,
       cpubase,
       nbas,ncon,ncal,ncnv,nld,
       nbas,ncon,ncal,ncnv,nld,
-      cga,tgcpu,n386util;
+      cgobj,cga,tgcpu,n386util,ncgutil;
 
 
 
 
 {*****************************************************************************
 {*****************************************************************************
@@ -126,7 +126,7 @@ implementation
                  { for both cases load vmt }
                  { for both cases load vmt }
                  if left.nodetype=typen then
                  if left.nodetype=typen then
                    begin
                    begin
-                      location.register:=getregister32;
+                      location.register:=getregisterint;
                       emit_sym_ofs_reg(A_MOV,
                       emit_sym_ofs_reg(A_MOV,
                         S_L,newasmsymbol(tobjectdef(left.resulttype.def).vmt_mangledname),0,
                         S_L,newasmsymbol(tobjectdef(left.resulttype.def).vmt_mangledname),0,
                         location.register);
                         location.register);
@@ -136,7 +136,7 @@ implementation
                       secondpass(left);
                       secondpass(left);
                       del_reference(left.location.reference);
                       del_reference(left.location.reference);
                       location.loc:=LOC_REGISTER;
                       location.loc:=LOC_REGISTER;
-                      location.register:=getregister32;
+                      location.register:=getregisterint;
                       { load VMT pointer }
                       { load VMT pointer }
                       inc(left.location.reference.offset,
                       inc(left.location.reference.offset,
                         tobjectdef(left.resulttype.def).vmt_offset);
                         tobjectdef(left.resulttype.def).vmt_offset);
@@ -165,7 +165,7 @@ implementation
                     if left.location.loc<>LOC_REGISTER then
                     if left.location.loc<>LOC_REGISTER then
                      begin
                      begin
                        del_location(left.location);
                        del_location(left.location);
-                       hregister:=getregister32;
+                       hregister:=getregisterint;
                        emit_mov_loc_reg(left.location,hregister);
                        emit_mov_loc_reg(left.location,hregister);
                      end
                      end
                     else
                     else
@@ -211,8 +211,8 @@ implementation
                         begin
                         begin
                            if left.location.loc=LOC_CREGISTER then
                            if left.location.loc=LOC_CREGISTER then
                              begin
                              begin
-                                location.registerlow:=getregister32;
-                                location.registerhigh:=getregister32;
+                                location.registerlow:=getregisterint;
+                                location.registerhigh:=getregisterint;
                                 emit_reg_reg(A_MOV,opsize,left.location.registerlow,
                                 emit_reg_reg(A_MOV,opsize,left.location.registerlow,
                                   location.registerlow);
                                   location.registerlow);
                                 emit_reg_reg(A_MOV,opsize,left.location.registerhigh,
                                 emit_reg_reg(A_MOV,opsize,left.location.registerhigh,
@@ -221,8 +221,8 @@ implementation
                            else
                            else
                              begin
                              begin
                                 del_reference(left.location.reference);
                                 del_reference(left.location.reference);
-                                location.registerlow:=getregister32;
-                                location.registerhigh:=getregister32;
+                                location.registerlow:=getregisterint;
+                                location.registerhigh:=getregisterint;
                                 emit_ref_reg(A_MOV,opsize,newreference(left.location.reference),
                                 emit_ref_reg(A_MOV,opsize,newreference(left.location.reference),
                                   location.registerlow);
                                   location.registerlow);
                                 r:=newreference(left.location.reference);
                                 r:=newreference(left.location.reference);
@@ -259,7 +259,7 @@ implementation
                            if left.location.loc in [LOC_MEM,LOC_REFERENCE] then
                            if left.location.loc in [LOC_MEM,LOC_REFERENCE] then
                              del_reference(left.location.reference);
                              del_reference(left.location.reference);
 
 
-                           location.register:=getregister32;
+                           location.register:=getregisterint;
                            if (resulttype.def.size=2) then
                            if (resulttype.def.size=2) then
                              location.register:=reg32toreg16(location.register);
                              location.register:=reg32toreg16(location.register);
                            if (resulttype.def.size=1) then
                            if (resulttype.def.size=1) then
@@ -283,7 +283,7 @@ implementation
                         location.register);
                         location.register);
                    end;
                    end;
                  emitoverflowcheck(self);
                  emitoverflowcheck(self);
-                 emitrangecheck(self,resulttype.def);
+                 cg.g_rangecheck(exprasmlist,self,resulttype.def);
               end;
               end;
             in_dec_x,
             in_dec_x,
             in_inc_x :
             in_inc_x :
@@ -332,7 +332,7 @@ implementation
                         LOC_MEM,
                         LOC_MEM,
                   LOC_REFERENCE : begin
                   LOC_REFERENCE : begin
                                     del_reference(tcallparanode(tcallparanode(left).right).left.location.reference);
                                     del_reference(tcallparanode(tcallparanode(left).right).left.location.reference);
-                                    hregister:=getregister32;
+                                    hregister:=getregisterint;
                                     emit_ref_reg(A_MOV,S_L,
                                     emit_ref_reg(A_MOV,S_L,
                                       newreference(tcallparanode(tcallparanode(left).right).left.location.reference),hregister);
                                       newreference(tcallparanode(tcallparanode(left).right).left.location.reference),hregister);
                                   end;
                                   end;
@@ -393,12 +393,12 @@ implementation
                    ungetregister32(hregister);
                    ungetregister32(hregister);
                  end;
                  end;
                 emitoverflowcheck(tcallparanode(left).left);
                 emitoverflowcheck(tcallparanode(left).left);
-                emitrangecheck(tcallparanode(left).left,tcallparanode(left).left.resulttype.def);
+                cg.g_rangecheck(exprasmlist,tcallparanode(left).left,tcallparanode(left).left.resulttype.def);
               end;
               end;
 
 
             in_typeinfo_x:
             in_typeinfo_x:
                begin
                begin
-                  location.register:=getregister32;
+                  location.register:=getregisterint;
                   new(r);
                   new(r);
                   reset_reference(r^);
                   reset_reference(r^);
                   r^.symbol:=tstoreddef(ttypenode(tcallparanode(left).left).resulttype.def).get_rtti_label(fullrtti);
                   r^.symbol:=tstoreddef(ttypenode(tcallparanode(left).left).resulttype.def).get_rtti_label(fullrtti);
@@ -729,7 +729,10 @@ begin
 end.
 end.
 {
 {
   $Log$
   $Log$
-  Revision 1.30  2001-12-10 14:34:04  jonas
+  Revision 1.31  2001-12-30 17:24:46  jonas
+    * range checking is now processor independent (part in cgobj, part in
    cg64f32) and should work correctly again (it needed some changes after
    the changes of the low and high of tordef's to int64)
  * maketojumpbool() is now processor independent (in ncgutil)
  * getregister32 is now called getregisterint
+
+  Revision 1.30  2001/12/10 14:34:04  jonas
     * fixed type conversions from dynamic arrays to open arrays
     * fixed type conversions from dynamic arrays to open arrays
 
 
   Revision 1.29  2001/12/04 15:59:03  jonas
   Revision 1.29  2001/12/04 15:59:03  jonas

+ 12 - 9
compiler/i386/n386ld.pas

@@ -111,7 +111,7 @@ implementation
                     { DLL variable }
                     { DLL variable }
                     else if (vo_is_dll_var in tvarsym(symtableentry).varoptions) then
                     else if (vo_is_dll_var in tvarsym(symtableentry).varoptions) then
                       begin
                       begin
-                         hregister:=getregister32;
+                         hregister:=getregisterint;
                          location.reference.symbol:=newasmsymbol(tvarsym(symtableentry).mangledname);
                          location.reference.symbol:=newasmsymbol(tvarsym(symtableentry).mangledname);
                          emit_ref_reg(A_MOV,S_L,newreference(location.reference),hregister);
                          emit_ref_reg(A_MOV,S_L,newreference(location.reference),hregister);
                          location.reference.symbol:=nil;
                          location.reference.symbol:=nil;
@@ -135,7 +135,7 @@ implementation
                          emitcall('FPC_RELOCATE_THREADVAR');
                          emitcall('FPC_RELOCATE_THREADVAR');
 
 
                          reset_reference(location.reference);
                          reset_reference(location.reference);
-                         location.reference.base:=getregister32;
+                         location.reference.base:=getregisterint;
                          emit_reg_reg(A_MOV,S_L,R_EAX,location.reference.base);
                          emit_reg_reg(A_MOV,S_L,R_EAX,location.reference.base);
                          if popeax then
                          if popeax then
                            emit_reg(A_POP,S_L,R_EAX);
                            emit_reg(A_POP,S_L,R_EAX);
@@ -194,7 +194,7 @@ implementation
                                      end;
                                      end;
                                    if (lexlevel>(symtable.symtablelevel)) then
                                    if (lexlevel>(symtable.symtablelevel)) then
                                      begin
                                      begin
-                                        hregister:=getregister32;
+                                        hregister:=getregisterint;
 
 
                                         { make a reference }
                                         { make a reference }
                                         hp:=new_reference(procinfo^.framepointer,
                                         hp:=new_reference(procinfo^.framepointer,
@@ -256,7 +256,7 @@ implementation
                                          end
                                          end
                                         else
                                         else
                                          begin
                                          begin
-                                           hregister:=getregister32;
+                                           hregister:=getregisterint;
                                            location.reference.base:=hregister;
                                            location.reference.base:=hregister;
                                            emit_ref_reg(A_MOV,S_L,
                                            emit_ref_reg(A_MOV,S_L,
                                              newreference(twithnode(twithsymtable(symtable).withnode).withreference^),
                                              newreference(twithnode(twithsymtable(symtable).withnode).withreference^),
@@ -276,7 +276,7 @@ implementation
                            begin
                            begin
                               simple_loadn:=false;
                               simple_loadn:=false;
                               if hregister=R_NO then
                               if hregister=R_NO then
-                                hregister:=getregister32;
+                                hregister:=getregisterint;
                               if location.loc=LOC_CREGISTER then
                               if location.loc=LOC_CREGISTER then
                                 begin
                                 begin
                                    emit_reg_reg(A_MOV,S_L,
                                    emit_reg_reg(A_MOV,S_L,
@@ -812,7 +812,7 @@ implementation
                               else
                               else
                                 begin
                                 begin
                                   ai:=Taicpu.Op_ref(A_Setcc,S_B,newreference(left.location.reference));
                                   ai:=Taicpu.Op_ref(A_Setcc,S_B,newreference(left.location.reference));
-                                  ai.SetCondition(flag_2_cond[right.location.resflags]);
+                                  ai.SetCondition(flags_to_cond(right.location.resflags));
                                   exprasmList.concat(ai);
                                   exprasmList.concat(ai);
                                 end;
                                 end;
 {$IfDef regallocfix}
 {$IfDef regallocfix}
@@ -842,7 +842,7 @@ implementation
          if (not inlining_procedure) and
          if (not inlining_procedure) and
             (lexlevel<>funcretsym.owner.symtablelevel) then
             (lexlevel<>funcretsym.owner.symtablelevel) then
            begin
            begin
-              hr:=getregister32;
+              hr:=getregisterint;
               hr_valid:=true;
               hr_valid:=true;
               hp:=new_reference(procinfo^.framepointer,procinfo^.framepointer_offset);
               hp:=new_reference(procinfo^.framepointer,procinfo^.framepointer_offset);
               emit_ref_reg(A_MOV,S_L,hp,hr);
               emit_ref_reg(A_MOV,S_L,hp,hr);
@@ -868,7 +868,7 @@ implementation
          if ret_in_param(resulttype.def) then
          if ret_in_param(resulttype.def) then
            begin
            begin
               if not hr_valid then
               if not hr_valid then
-                hr:=getregister32;
+                hr:=getregisterint;
               emit_ref_reg(A_MOV,S_L,newreference(location.reference),hr);
               emit_ref_reg(A_MOV,S_L,newreference(location.reference),hr);
               location.reference.base:=hr;
               location.reference.base:=hr;
               location.reference.offset:=0;
               location.reference.offset:=0;
@@ -1091,7 +1091,10 @@ begin
 end.
 end.
 {
 {
   $Log$
   $Log$
-  Revision 1.27  2001-12-17 23:16:05  florian
+  Revision 1.28  2001-12-30 17:24:46  jonas
+    * range checking is now processor independent (part in cgobj, part in
    cg64f32) and should work correctly again (it needed some changes after
    the changes of the low and high of tordef's to int64)
  * maketojumpbool() is now processor independent (in ncgutil)
  * getregister32 is now called getregisterint
+
+  Revision 1.27  2001/12/17 23:16:05  florian
     * array of const can now take widestring parameters as well
     * array of const can now take widestring parameters as well
 
 
   Revision 1.26  2001/11/02 22:58:11  peter
   Revision 1.26  2001/11/02 22:58:11  peter

+ 23 - 20
compiler/i386/n386mat.pas

@@ -56,7 +56,7 @@ implementation
       cgbase,temp_gen,pass_1,pass_2,
       cgbase,temp_gen,pass_1,pass_2,
       ncon,
       ncon,
       cpubase,
       cpubase,
-      cga,tgcpu,n386util;
+      cga,tgcpu,n386util,ncgutil;
 
 
 {*****************************************************************************
 {*****************************************************************************
                              TI386MODDIVNODE
                              TI386MODDIVNODE
@@ -97,13 +97,13 @@ implementation
                 begin
                 begin
                    if left.location.loc=LOC_CREGISTER then
                    if left.location.loc=LOC_CREGISTER then
                      begin
                      begin
-                       hreg1:=getregister32;
+                       hreg1:=getregisterint;
                        emit_reg_reg(A_MOV,S_L,left.location.register,hreg1);
                        emit_reg_reg(A_MOV,S_L,left.location.register,hreg1);
                      end
                      end
                    else
                    else
                      begin
                      begin
                        del_reference(left.location.reference);
                        del_reference(left.location.reference);
-                       hreg1:=getregister32;
+                       hreg1:=getregisterint;
                        emit_ref_reg(A_MOV,S_L,newreference(left.location.reference),
                        emit_ref_reg(A_MOV,S_L,newreference(left.location.reference),
                          hreg1);
                          hreg1);
                      end;
                      end;
@@ -329,8 +329,8 @@ implementation
                 begin
                 begin
                    if left.location.loc=LOC_CREGISTER then
                    if left.location.loc=LOC_CREGISTER then
                      begin
                      begin
-                        hregisterlow:=getregister32;
-                        hregisterhigh:=getregister32;
+                        hregisterlow:=getregisterint;
+                        hregisterhigh:=getregisterint;
                         emit_reg_reg(A_MOV,S_L,left.location.registerlow,
                         emit_reg_reg(A_MOV,S_L,left.location.registerlow,
                           hregisterlow);
                           hregisterlow);
                         emit_reg_reg(A_MOV,S_L,left.location.registerhigh,
                         emit_reg_reg(A_MOV,S_L,left.location.registerhigh,
@@ -339,8 +339,8 @@ implementation
                    else
                    else
                      begin
                      begin
                         del_reference(left.location.reference);
                         del_reference(left.location.reference);
-                        hregisterlow:=getregister32;
-                        hregisterhigh:=getregister32;
+                        hregisterlow:=getregisterint;
+                        hregisterhigh:=getregisterint;
                         emit_mov_ref_reg64(left.location.reference,
                         emit_mov_ref_reg64(left.location.reference,
                           hregisterlow,
                           hregisterlow,
                           hregisterhigh);
                           hregisterhigh);
@@ -529,14 +529,14 @@ implementation
                 begin
                 begin
                    if left.location.loc=LOC_CREGISTER then
                    if left.location.loc=LOC_CREGISTER then
                      begin
                      begin
-                        hregister1:=getregister32;
+                        hregister1:=getregisterint;
                         emit_reg_reg(A_MOV,S_L,left.location.register,
                         emit_reg_reg(A_MOV,S_L,left.location.register,
                           hregister1);
                           hregister1);
                      end
                      end
                    else
                    else
                      begin
                      begin
                         del_reference(left.location.reference);
                         del_reference(left.location.reference);
-                        hregister1:=getregister32;
+                        hregister1:=getregisterint;
                         emit_ref_reg(A_MOV,S_L,newreference(left.location.reference),
                         emit_ref_reg(A_MOV,S_L,newreference(left.location.reference),
                           hregister1);
                           hregister1);
                      end;
                      end;
@@ -715,16 +715,16 @@ implementation
                   end;
                   end;
                 LOC_CREGISTER :
                 LOC_CREGISTER :
                   begin
                   begin
-                     location.registerlow:=getregister32;
-                     location.registerhigh:=getregister32;
+                     location.registerlow:=getregisterint;
+                     location.registerhigh:=getregisterint;
                      emit_reg_reg(A_MOV,S_L,left.location.registerlow,location.registerlow);
                      emit_reg_reg(A_MOV,S_L,left.location.registerlow,location.registerlow);
                      emit_reg_reg(A_MOV,S_L,left.location.registerhigh,location.registerhigh);
                      emit_reg_reg(A_MOV,S_L,left.location.registerhigh,location.registerhigh);
                   end;
                   end;
                 LOC_REFERENCE,LOC_MEM :
                 LOC_REFERENCE,LOC_MEM :
                   begin
                   begin
                      del_reference(left.location.reference);
                      del_reference(left.location.reference);
-                     location.registerlow:=getregister32;
-                     location.registerhigh:=getregister32;
+                     location.registerlow:=getregisterint;
+                     location.registerhigh:=getregisterint;
                      emit_mov_ref_reg64(left.location.reference,
                      emit_mov_ref_reg64(left.location.reference,
                        location.registerlow,
                        location.registerlow,
                        location.registerhigh);
                        location.registerhigh);
@@ -751,7 +751,7 @@ implementation
                    end;
                    end;
                  LOC_CREGISTER:
                  LOC_CREGISTER:
                    begin
                    begin
-                      location.register:=getregister32;
+                      location.register:=getregisterint;
                       emit_reg_reg(A_MOV,S_L,location.register,
                       emit_reg_reg(A_MOV,S_L,location.register,
                         location.register);
                         location.register);
                       emit_reg(A_NEG,S_L,location.register);
                       emit_reg(A_NEG,S_L,location.register);
@@ -795,7 +795,7 @@ implementation
 {$endif SUPPORT_MMX}
 {$endif SUPPORT_MMX}
                                    else
                                    else
                                      begin
                                      begin
-                                        location.register:=getregister32;
+                                        location.register:=getregisterint;
                                         emit_ref_reg(A_MOV,S_L,
                                         emit_ref_reg(A_MOV,S_L,
                                           newreference(left.location.reference),
                                           newreference(left.location.reference),
                                           location.register);
                                           location.register);
@@ -940,8 +940,8 @@ implementation
                   end;
                   end;
                 LOC_CREGISTER :
                 LOC_CREGISTER :
                   begin
                   begin
-                     location.registerlow:=getregister32;
-                     location.registerhigh:=getregister32;
+                     location.registerlow:=getregisterint;
+                     location.registerhigh:=getregisterint;
                      emit_reg_reg(A_MOV,S_L,left.location.registerlow,location.registerlow);
                      emit_reg_reg(A_MOV,S_L,left.location.registerlow,location.registerlow);
                      emit_reg_reg(A_MOV,S_L,left.location.registerhigh,location.registerhigh);
                      emit_reg_reg(A_MOV,S_L,left.location.registerhigh,location.registerhigh);
                      emit_reg(A_NOT,S_L,location.registerlow);
                      emit_reg(A_NOT,S_L,location.registerlow);
@@ -950,8 +950,8 @@ implementation
                 LOC_REFERENCE,LOC_MEM :
                 LOC_REFERENCE,LOC_MEM :
                   begin
                   begin
                      del_reference(left.location.reference);
                      del_reference(left.location.reference);
-                     location.registerlow:=getregister32;
-                     location.registerhigh:=getregister32;
+                     location.registerlow:=getregisterint;
+                     location.registerhigh:=getregisterint;
                      emit_mov_ref_reg64(left.location.reference,
                      emit_mov_ref_reg64(left.location.reference,
                        location.registerlow,
                        location.registerlow,
                        location.registerhigh);
                        location.registerhigh);
@@ -999,7 +999,10 @@ begin
 end.
 end.
 {
 {
   $Log$
   $Log$
-  Revision 1.21  2001-12-29 15:27:24  jonas
+  Revision 1.22  2001-12-30 17:24:47  jonas
+    * range checking is now processor independent (part in cgobj, part in
    cg64f32) and should work correctly again (it needed some changes after
    the changes of the low and high of tordef's to int64)
  * maketojumpbool() is now processor independent (in ncgutil)
  * getregister32 is now called getregisterint
+
+  Revision 1.21  2001/12/29 15:27:24  jonas
     * made 'mod powerof2' -> 'and' optimization processor independent
     * made 'mod powerof2' -> 'and' optimization processor independent
 
 
   Revision 1.20  2001/12/27 15:33:58  jonas
   Revision 1.20  2001/12/27 15:33:58  jonas

+ 12 - 9
compiler/i386/n386mem.pas

@@ -62,7 +62,7 @@ implementation
       cgbase,temp_gen,pass_2,
       cgbase,temp_gen,pass_2,
       pass_1,nld,ncon,nadd,
       pass_1,nld,ncon,nadd,
       cpubase,cpuasm,
       cpubase,cpuasm,
-      cga,tgcpu,n386util;
+      cgobj,cga,tgcpu,n386util;
 
 
 {*****************************************************************************
 {*****************************************************************************
                             TI386NEWNODE
                             TI386NEWNODE
@@ -293,7 +293,7 @@ implementation
               else
               else
                 begin
                 begin
                    del_reference(left.location.reference);
                    del_reference(left.location.reference);
-                   location.reference.base:=getregister32;
+                   location.reference.base:=getregisterint;
                    emit_ref_reg(A_MOV,S_L,
                    emit_ref_reg(A_MOV,S_L,
                      newreference(left.location.reference),
                      newreference(left.location.reference),
                      location.reference.base);
                      location.reference.base);
@@ -338,7 +338,7 @@ implementation
               else
               else
                 begin
                 begin
                    del_reference(left.location.reference);
                    del_reference(left.location.reference);
-                   location.reference.base:=getregister32;
+                   location.reference.base:=getregisterint;
                    emit_ref_reg(A_MOV,S_L,
                    emit_ref_reg(A_MOV,S_L,
                      newreference(left.location.reference),
                      newreference(left.location.reference),
                      location.reference.base);
                      location.reference.base);
@@ -544,7 +544,7 @@ implementation
                         hightree.free;
                         hightree.free;
                         hightree:=nil;
                         hightree:=nil;
                       end;
                       end;
-                     emitrangecheck(right,left.resulttype.def);
+                     cg.g_rangecheck(exprasmlist,right,left.resulttype.def);
                    end;
                    end;
                end;
                end;
 
 
@@ -569,7 +569,7 @@ implementation
                    end;
                    end;
                  LOC_CREGISTER:
                  LOC_CREGISTER:
                    begin
                    begin
-                      ind:=getregister32;
+                      ind:=getregisterint;
                       case right.resulttype.def.size of
                       case right.resulttype.def.size of
                          1:
                          1:
                            emit_reg_reg(A_MOVZX,S_BL,right.location.register,ind);
                            emit_reg_reg(A_MOVZX,S_BL,right.location.register,ind);
@@ -581,13 +581,13 @@ implementation
                    end;
                    end;
                  LOC_FLAGS:
                  LOC_FLAGS:
                    begin
                    begin
-                      ind:=getregister32;
+                      ind:=getregisterint;
                       emit_flag2reg(right.location.resflags,reg32toreg8(ind));
                       emit_flag2reg(right.location.resflags,reg32toreg8(ind));
                       emit_reg_reg(A_MOVZX,S_BL,reg32toreg8(ind),ind);
                       emit_reg_reg(A_MOVZX,S_BL,reg32toreg8(ind),ind);
                    end;
                    end;
                  LOC_JUMP :
                  LOC_JUMP :
                    begin
                    begin
-                     ind:=getregister32;
+                     ind:=getregisterint;
                      emitlab(truelabel);
                      emitlab(truelabel);
                      truelabel:=otl;
                      truelabel:=otl;
                      emit_const_reg(A_MOV,S_L,1,ind);
                      emit_const_reg(A_MOV,S_L,1,ind);
@@ -601,7 +601,7 @@ implementation
                  LOC_REFERENCE,LOC_MEM :
                  LOC_REFERENCE,LOC_MEM :
                    begin
                    begin
                       del_reference(right.location.reference);
                       del_reference(right.location.reference);
-                      ind:=getregister32;
+                      ind:=getregisterint;
                       { Booleans are stored in an 8 bit memory location, so
                       { Booleans are stored in an 8 bit memory location, so
                         the use of MOVL is not correct }
                         the use of MOVL is not correct }
                       case right.resulttype.def.size of
                       case right.resulttype.def.size of
@@ -701,7 +701,10 @@ begin
 end.
 end.
 {
 {
   $Log$
   $Log$
-  Revision 1.18  2001-12-03 21:48:43  peter
+  Revision 1.19  2001-12-30 17:24:47  jonas
+    * range checking is now processor independent (part in cgobj, part in
    cg64f32) and should work correctly again (it needed some changes after
    the changes of the low and high of tordef's to int64)
  * maketojumpbool() is now processor independent (in ncgutil)
  * getregister32 is now called getregisterint
+
+  Revision 1.18  2001/12/03 21:48:43  peter
     * freemem change to value parameter
     * freemem change to value parameter
     * torddef low/high range changed to int64
     * torddef low/high range changed to int64
 
 

+ 8 - 350
compiler/i386/n386util.pas

@@ -29,9 +29,6 @@ interface
     uses
     uses
       symtype,node;
       symtype,node;
 
 
-    type
-      tloadregvars = (lr_dont_load_regvars, lr_load_regvars);
-
     function maybe_push(needed : byte;p : tnode;isint64 : boolean) : boolean;
     function maybe_push(needed : byte;p : tnode;isint64 : boolean) : boolean;
     function maybe_pushfpu(needed : byte;p : tnode) : boolean;
     function maybe_pushfpu(needed : byte;p : tnode) : boolean;
 {$ifdef TEMPS_NOT_PUSH}
 {$ifdef TEMPS_NOT_PUSH}
@@ -50,9 +47,7 @@ interface
     procedure loadwide2short(source,dest : tnode);
     procedure loadwide2short(source,dest : tnode);
     procedure loadinterfacecom(p: tbinarynode);
     procedure loadinterfacecom(p: tbinarynode);
 
 
-    procedure maketojumpbool(p : tnode; loadregvars: tloadregvars);
     procedure emitoverflowcheck(p:tnode);
     procedure emitoverflowcheck(p:tnode);
-    procedure emitrangecheck(p:tnode;todef:tdef);
     procedure firstcomplex(p : tbinarynode);
     procedure firstcomplex(p : tbinarynode);
 
 
 implementation
 implementation
@@ -229,7 +224,7 @@ implementation
              load_regvar_reg(exprasmlist,p.location.register);
              load_regvar_reg(exprasmlist,p.location.register);
              exit;
              exit;
            end;
            end;
-         hregister:=getregister32;
+         hregister:=getregisterint;
 {$ifdef TEMPS_NOT_PUSH}
 {$ifdef TEMPS_NOT_PUSH}
          reset_reference(href);
          reset_reference(href);
          href.base:=procinfo^.frame_pointer;
          href.base:=procinfo^.frame_pointer;
@@ -243,7 +238,7 @@ implementation
               p.location.register:=hregister;
               p.location.register:=hregister;
               if isint64 then
               if isint64 then
                 begin
                 begin
-                   p.location.registerhigh:=getregister32;
+                   p.location.registerhigh:=getregisterint;
 {$ifdef TEMPS_NOT_PUSH}
 {$ifdef TEMPS_NOT_PUSH}
                    href.offset:=p.temp_offset+4;
                    href.offset:=p.temp_offset+4;
                    emit_ref_reg(A_MOV,S_L,p.location.registerhigh);
                    emit_ref_reg(A_MOV,S_L,p.location.registerhigh);
@@ -277,7 +272,7 @@ implementation
          href : treference;
          href : treference;
 
 
       begin
       begin
-         hregister:=getregister32;
+         hregister:=getregisterint;
          reset_reference(href);
          reset_reference(href);
          href.base:=procinfo^.frame_pointer;
          href.base:=procinfo^.frame_pointer;
          href.offset:=p.temp_offset;
          href.offset:=p.temp_offset;
@@ -287,7 +282,7 @@ implementation
               p.location.register:=hregister;
               p.location.register:=hregister;
               if isint64 then
               if isint64 then
                 begin
                 begin
-                   p.location.registerhigh:=getregister32;
+                   p.location.registerhigh:=getregisterint;
                    href.offset:=p.temp_offset+4;
                    href.offset:=p.temp_offset+4;
                    emit_ref_reg(A_MOV,S_L,p.location.registerhigh);
                    emit_ref_reg(A_MOV,S_L,p.location.registerhigh);
                    { set correctly for release ! }
                    { set correctly for release ! }
@@ -872,67 +867,6 @@ implementation
                            Emit Functions
                            Emit Functions
 *****************************************************************************}
 *****************************************************************************}
 
 
-    procedure maketojumpbool(p : tnode; loadregvars: tloadregvars);
-    {
-      produces jumps to true respectively false labels using boolean expressions
-
-      depending on whether the loading of regvars is currently being
-      synchronized manually (such as in an if-node) or automatically (most of
-      the other cases where this procedure is called), loadregvars can be
-      "lr_load_regvars" or "lr_dont_load_regvars"
-    }
-      var
-        opsize : topsize;
-        storepos : tfileposinfo;
-      begin
-         if nf_error in p.flags then
-           exit;
-         storepos:=aktfilepos;
-         aktfilepos:=p.fileinfo;
-         if is_boolean(p.resulttype.def) then
-           begin
-              if loadregvars = lr_load_regvars then
-                load_all_regvars(exprasmlist);
-              if is_constboolnode(p) then
-                begin
-                   if tordconstnode(p).value<>0 then
-                     emitjmp(C_None,truelabel)
-                   else
-                     emitjmp(C_None,falselabel);
-                end
-              else
-                begin
-                   opsize:=def_opsize(p.resulttype.def);
-                   case p.location.loc of
-                      LOC_CREGISTER,LOC_REGISTER : begin
-                                        if (p.location.loc = LOC_CREGISTER) then
-                                          load_regvar_reg(exprasmlist,p.location.register);
-                                        emit_reg_reg(A_OR,opsize,p.location.register,
-                                          p.location.register);
-                                        ungetregister(p.location.register);
-                                        emitjmp(C_NZ,truelabel);
-                                        emitjmp(C_None,falselabel);
-                                     end;
-                      LOC_MEM,LOC_REFERENCE : begin
-                                        emit_const_ref(
-                                          A_CMP,opsize,0,newreference(p.location.reference));
-                                        del_reference(p.location.reference);
-                                        emitjmp(C_NZ,truelabel);
-                                        emitjmp(C_None,falselabel);
-                                     end;
-                      LOC_FLAGS : begin
-                                     emitjmp(flag_2_cond[p.location.resflags],truelabel);
-                                     emitjmp(C_None,falselabel);
-                                  end;
-                   end;
-                end;
-           end
-         else
-           CGMessage(type_e_mismatch);
-         aktfilepos:=storepos;
-      end;
-
-
     { produces if necessary overflowcode }
     { produces if necessary overflowcode }
     procedure emitoverflowcheck(p:tnode);
     procedure emitoverflowcheck(p:tnode);
       var
       var
@@ -952,285 +886,6 @@ implementation
          emitlab(hl);
          emitlab(hl);
       end;
       end;
 
 
-    { produces range check code, while one of the operands is a 64 bit
-      integer }
-    procedure emitrangecheck64(p : tnode;todef : tdef);
-
-      var
-        neglabel,
-        poslabel,
-        endlabel: tasmlabel;
-        href   : preference;
-        hreg   : tregister;
-        hdef   :  torddef;
-        fromdef : tdef;
-        opcode : tasmop;
-        opsize   : topsize;
-        oldregisterdef: boolean;
-        from_signed,to_signed: boolean;
-
-      begin
-         fromdef:=p.resulttype.def;
-         from_signed := is_signed(fromdef);
-         to_signed := is_signed(todef);
-
-         if not is_64bitint(todef) then
-           begin
-             oldregisterdef := registerdef;
-             registerdef := false;
-
-             { get the high dword in a register }
-             if p.location.loc in [LOC_REGISTER,LOC_CREGISTER] then
-               hreg := p.location.registerhigh
-             else
-               begin
-                 hreg := getexplicitregister32(R_EDI);
-                 href := newreference(p.location.reference);
-                 inc(href^.offset,4);
-                 emit_ref_reg(A_MOV,S_L,href,hreg);
-               end;
-             getlabel(poslabel);
-
-             { check high dword, must be 0 (for positive numbers) }
-             emit_reg_reg(A_TEST,S_L,hreg,hreg);
-             emitjmp(C_E,poslabel);
-
-             { It can also be $ffffffff, but only for negative numbers }
-             if from_signed and to_signed then
-               begin
-                 getlabel(neglabel);
-                 emit_const_reg(A_CMP,S_L,longint($ffffffff),hreg);
-                 emitjmp(C_E,neglabel);
-               end;
-             if hreg = R_EDI then
-               ungetregister32(hreg);
-             { For all other values we have a range check error }
-             emitcall('FPC_RANGEERROR');
-
-             { if the high dword = 0, the low dword can be considered a }
-             { simple cardinal                                          }
-             emitlab(poslabel);
-             hdef:=torddef.create(u32bit,0,longint($ffffffff));
-             { the real p.resulttype.def is already saved in fromdef }
-             p.resulttype.def := hdef;
-             emitrangecheck(p,todef);
-             hdef.free;
-             { restore original resulttype.def }
-             p.resulttype.def := todef;
-
-             if from_signed and to_signed then
-               begin
-                 getlabel(endlabel);
-                 emitjmp(C_None,endlabel);
-                 { if the high dword = $ffffffff, then the low dword (when }
-                 { considered as a longint) must be < 0                    }
-                 emitlab(neglabel);
-                 if p.location.loc in [LOC_REGISTER,LOC_CREGISTER] then
-                   hreg := p.location.registerlow
-                 else
-                   begin
-                     hreg := getexplicitregister32(R_EDI);
-                     emit_ref_reg(A_MOV,S_L,
-                       newreference(p.location.reference),hreg);
-                   end;
-                 { get a new neglabel (JM) }
-                 getlabel(neglabel);
-                 emit_reg_reg(A_TEST,S_L,hreg,hreg);
-                 if hreg = R_EDI then
-                   ungetregister32(hreg);
-                 emitjmp(C_L,neglabel);
-
-                 emitcall('FPC_RANGEERROR');
-
-                 { if we get here, the 64bit value lies between }
-                 { longint($80000000) and -1 (JM)               }
-                 emitlab(neglabel);
-                 hdef:=torddef.create(s32bit,longint($80000000),-1);
-                 p.resulttype.def := hdef;
-                 emitrangecheck(p,todef);
-                 hdef.free;
-                 emitlab(endlabel);
-               end;
-             registerdef := oldregisterdef;
-             p.resulttype.def := fromdef;
-             { restore p's resulttype.def }
-           end
-         else
-           { todef = 64bit int }
-           { no 64bit subranges supported, so only a small check is necessary }
-
-           { if both are signed or both are unsigned, no problem! }
-           if (from_signed xor to_signed) and
-              { also not if the fromdef is unsigned and < 64bit, since that will }
-              { always fit in a 64bit int (todef is 64bit)                       }
-              (from_signed or
-               (torddef(fromdef).typ = u64bit)) then
-             begin
-               { in all cases, there is only a problem if the higest bit is set }
-               if p.location.loc in [LOC_REGISTER,LOC_CREGISTER] then
-                 if is_64bitint(fromdef) then
-                   hreg := p.location.registerhigh
-                 else
-                   hreg := p.location.register
-               else
-                 begin
-                   hreg := getexplicitregister32(R_EDI);
-                   case p.resulttype.def.size of
-                     1: opsize := S_BL;
-                     2: opsize := S_WL;
-                     4,8: opsize := S_L;
-                   end;
-                   if opsize in [S_BL,S_WL] then
-                     if from_signed then
-                       opcode := A_MOVSX
-                     else opcode := A_MOVZX
-                   else
-                     opcode := A_MOV;
-                   href := newreference(p.location.reference);
-                   if p.resulttype.def.size = 8 then
-                     inc(href^.offset,4);
-                   emit_ref_reg(opcode,opsize,href,hreg);
-                 end;
-               getlabel(poslabel);
-               emit_reg_reg(A_TEST,regsize(hreg),hreg,hreg);
-               if hreg = R_EDI then
-                 ungetregister32(hreg);
-               emitjmp(C_GE,poslabel);
-               emitcall('FPC_RANGEERROR');
-               emitlab(poslabel);
-             end;
-      end;
-
-     { produces if necessary rangecheckcode }
-     procedure emitrangecheck(p:tnode;todef:tdef);
-     {
-       generate range checking code for the value at location t. The
-       type used is the checked against todefs ranges. fromdef (p.resulttype.def)
-       is the original type used at that location, when both defs are
-       equal the check is also insert (needed for succ,pref,inc,dec)
-     }
-      var
-        neglabel : tasmlabel;
-        opsize : topsize;
-        op     : tasmop;
-        fromdef : tdef;
-        lto,hto,
-        lfrom,hfrom : TConstExprInt;
-        is_reg : boolean;
-      begin
-        { range checking on and range checkable value? }
-        if not(cs_check_range in aktlocalswitches) or
-           not(todef.deftype in [orddef,enumdef,arraydef]) then
-          exit;
-        { only check when assigning to scalar, subranges are different,
-          when todef=fromdef then the check is always generated }
-        fromdef:=p.resulttype.def;
-        { no range check if from and to are equal and are both longint/dword or }
-        { int64/qword, since such operations can at most cause overflows (JM)   }
-        if (fromdef = todef) and
-          { then fromdef and todef can only be orddefs }
-           (((torddef(fromdef).typ = s32bit) and
-             (torddef(fromdef).low = longint($80000000)) and
-             (torddef(fromdef).high = $7fffffff)) or
-            ((torddef(fromdef).typ = u32bit) and
-             (torddef(fromdef).low = 0) and
-             (torddef(fromdef).high = longint($ffffffff))) or
-            is_64bitint(fromdef)) then
-          exit;
-        if is_64bitint(fromdef) or is_64bitint(todef) then
-          begin
-             emitrangecheck64(p,todef);
-             exit;
-          end;
-        {we also need lto and hto when checking if we need to use doublebound!
-        (JM)}
-        getrange(todef,lto,hto);
-        if todef<>fromdef then
-         begin
-           getrange(p.resulttype.def,lfrom,hfrom);
-           { first check for not being u32bit, then if the to is bigger than
-             from }
-           if (lto<hto) and (lfrom<hfrom) and
-              (lto<=lfrom) and (hto>=hfrom) then
-            exit;
-         end;
-        { generate the rangecheck code for the def where we are going to
-          store the result }
-      { get op and opsize }
-        opsize:=def2def_opsize(fromdef,u32bittype.def);
-        if opsize in [S_B,S_W,S_L] then
-         op:=A_MOV
-        else
-         if is_signed(fromdef) then
-          op:=A_MOVSX
-         else
-          op:=A_MOVZX;
-        is_reg:=(p.location.loc in [LOC_REGISTER,LOC_CREGISTER]);
-        { use the trick that                                                 }
-        { a <= x <= b <=> 0 <= x-a <= b-a <=> cardinal(x-a) <= cardinal(b-a) }
-
-        { To be able to do that, we have to make sure however that either    }
-        { fromdef and todef are both signed or unsigned, or that we leave    }
-        { the parts < 0 and > maxlongint out                                 }
-
-        { is_signed now also works for arrays (it checks the rangetype) (JM) }
-        if is_signed(fromdef) xor is_signed(todef) then
-          if is_signed(fromdef) then
-            { from is signed, to is unsigned }
-            begin
-              { if high(from) < 0 -> always range error }
-              if (hfrom < 0) or
-                 { if low(to) > maxlongint (== < 0, since we only have }
-                 { longints here), also range error                    }
-                 (lto < 0) then
-                begin
-                  emitcall('FPC_RANGEERROR');
-                  exit
-                end;
-              { to is unsigned -> hto < 0 == hto > maxlongint              }
-              { since from is signed, values > maxlongint are < 0 and must }
-              { be rejected                                                }
-              if hto < 0 then
-                hto := maxlongint;
-            end
-          else
-            { from is unsigned, to is signed }
-            begin
-              if (lfrom < 0) or
-                 (hto < 0) then
-                begin
-                  emitcall('FPC_RANGEERROR');
-                  exit
-                end;
-              { since from is unsigned, values > maxlongint are < 0 and must }
-              { be rejected                                                  }
-              if lto < 0 then
-                lto := 0;
-            end;
-
-        getexplicitregister32(R_EDI);
-        if is_reg and
-           (opsize = S_L) then
-          emit_ref_reg(A_LEA,opsize,new_reference(p.location.register,-lto),
-            R_EDI)
-        else
-          begin
-            if is_reg then
-              emit_reg_reg(op,opsize,p.location.register,R_EDI)
-            else
-              emit_ref_reg(op,opsize,newreference(p.location.reference),R_EDI);
-            if lto <> 0 then
-              emit_const_reg(A_SUB,S_L,lto,R_EDI);
-          end;
-        emit_const_reg(A_CMP,S_L,hto-lto,R_EDI);
-        ungetregister32(R_EDI);
-        getlabel(neglabel);
-        emitjmp(C_BE,neglabel);
-        emitcall('FPC_RANGEERROR');
-        emitlab(neglabel);
-      end;
-
-
    { DO NOT RELY on the fact that the tnode is not yet swaped
    { DO NOT RELY on the fact that the tnode is not yet swaped
      because of inlining code PM }
      because of inlining code PM }
     procedure firstcomplex(p : tbinarynode);
     procedure firstcomplex(p : tbinarynode);
@@ -1544,7 +1199,10 @@ implementation
 end.
 end.
 {
 {
   $Log$
   $Log$
-  Revision 1.24  2001-12-03 21:48:43  peter
+  Revision 1.25  2001-12-30 17:24:47  jonas
+    * range checking is now processor independent (part in cgobj, part in
    cg64f32) and should work correctly again (it needed some changes after
    the changes of the low and high of tordef's to int64)
  * maketojumpbool() is now processor independent (in ncgutil)
  * getregister32 is now called getregisterint
+
+  Revision 1.24  2001/12/03 21:48:43  peter
     * freemem change to value parameter
     * freemem change to value parameter
     * torddef low/high range changed to int64
     * torddef low/high range changed to int64
 
 

+ 5 - 4
compiler/ncgflw.pas

@@ -72,9 +72,7 @@ implementation
       cpubase,cpuasm,cpuinfo,
       cpubase,cpuasm,cpuinfo,
       nld,ncon,
       nld,ncon,
       cga,tgcpu,
       cga,tgcpu,
-{$ifdef i386}
-      n386util,
-{$endif}
+      ncgutil,
       tainst,regvars,cgobj,cgcpu;
       tainst,regvars,cgobj,cgcpu;
 
 
 {*****************************************************************************
 {*****************************************************************************
@@ -651,7 +649,10 @@ begin
 end.
 end.
 {
 {
   $Log$
   $Log$
-  Revision 1.6  2001-12-29 15:28:57  jonas
+  Revision 1.7  2001-12-30 17:24:48  jonas
+    * range checking is now processor independent (part in cgobj, part in
    cg64f32) and should work correctly again (it needed some changes after
    the changes of the low and high of tordef's to int64)
  * maketojumpbool() is now processor independent (in ncgutil)
  * getregister32 is now called getregisterint
+
+  Revision 1.6  2001/12/29 15:28:57  jonas
     * powerpc/cgcpu.pas compiles :)
     * powerpc/cgcpu.pas compiles :)
     * several powerpc-related fixes
     * several powerpc-related fixes
     * cpuasm unit is now based on common tainst unit
     * cpuasm unit is now based on common tainst unit

+ 220 - 0
compiler/ncgutil.pas

@@ -0,0 +1,220 @@
+{
+    $Id$
+    Copyright (c) 1998-2000 by Florian Klaempfl
+
+    Helper routines for all code generators
+
+    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 ncgutil;
+
+{$i defines.inc}
+
+interface
+
+    uses
+      node;
+
+    type
+      tloadregvars = (lr_dont_load_regvars, lr_load_regvars);
+
+{$ifdef TEMPS_NOT_PUSH}
+    function maybe_savetotemp(needed : byte;p : tnode;isint64 : boolean) : boolean;
+    procedure restorefromtemp(p : tnode;isint64 : boolean);
+{$endif TEMPS_NOT_PUSH}
+
+    procedure maketojumpbool(p : tnode; loadregvars: tloadregvars);
+
+implementation
+
+  uses
+    globals,globtype,systems,verbose,
+    types,
+    aasm,cgbase,regvars,
+    temp_gen,ncon,
+    cpubase,cpuinfo,tgcpu,cgobj,cgcpu,cg64f32;
+
+
+{$ifdef TEMPS_NOT_PUSH}
+    function maybe_savetotemp(needed : byte;p : tnode;isint64 : boolean) : boolean;
+      var
+        href : treference;
+        scratchreg : tregister;
+        saved : boolean;
+      begin
+         if needed>usablereg32 then
+           begin
+              if (p.location.loc=LOC_REGISTER) then
+                begin
+                   if isint64 then
+                     begin
+                       gettempofsizereference(8,href);
+                       p.temp_offset:=href.offset;
+                       { do we have a 64bit processor? }
+                       if sizeof(aword) < 8 then
+                         begin
+                           tcg64f32(cg).a_load64_reg_ref(exprasmlist,
+                             p.location.registerlow,p.location.registerhigh,
+                             href);
+                           ungetregister(p.location.registerhigh);
+                           ungetregister(p.location.registerlow);
+                         end
+                       else
+                         begin
+                           cg.a_load_reg_ref(exprasmlist,OS_64,
+                             p.location.register,href);
+                           ungetregister(p.location.register);
+                         end;
+                     end
+                   else
+                     begin
+                        gettempofsizereference(4,href);
+                        p.temp_offset:=href.offset;
+                        cg.a_load_reg_ref(exprasmlist,OS_32,
+                          p.location.register,href);
+                        ungetregister(p.location.register);
+                     end;
+                   saved:=true;
+                end
+              else if (p.location.loc in [LOC_MEM,LOC_REFERENCE]) and
+                      ((p.location.reference.base<>R_NO) or
+                       (p.location.reference.index<>R_NO)
+                      ) then
+                  begin
+                     scratchreg := cg.get_scratch_reg(exprasmlist);
+                     cg.a_loadaddress_ref_reg(exprasmlist,
+                       p.location.reference,scratchreg);
+                     del_reference(p.location.reference);
+                     gettempofsizereference(target_info.size_of_pointer,href);
+                     cg.a_load_reg_ref(exprasmlist,OS_ADDR,scratchreg,href);
+                     cg.free_scratch_reg(exprasmlist,scratchreg);
+                     p.temp_offset:=href.offset;
+                     saved:=true;
+                  end
+              else saved:=false;
+           end
+         else saved:=false;
+         maybe_savetotemp:=saved;
+      end;
+
+
+    procedure restorefromtemp(p : tnode;isint64 : boolean);
+      var
+         hregister :  tregister;
+         href : treference;
+
+      begin
+         hregister:=getregisterint;
+         reset_reference(href);
+         href.base:=procinfo^.framepointer;
+         href.offset:=p.temp_offset;
+         if (p.location.loc in [LOC_REGISTER,LOC_CREGISTER]) then
+           begin
+              p.location.registerlow:=hregister;
+              if isint64 then
+                begin
+                  if sizeof(aword) < 8 then
+                    begin
+                      p.location.registerhigh:=getregisterint;
+                      tcg64f32(cg).a_load64_ref_reg(exprasmlist,
+                        href,p.location.registerlow,p.location.registerhigh);
+                    end
+                  else
+                    cg.a_load_ref_reg(exprasmlist,OS_64,href,
+                      p.location.register);
+                end
+              else
+                cg.a_load_ref_reg(exprasmlist,OS_32,href,p.location.register);
+           end
+         else
+           begin
+              reset_reference(p.location.reference);
+              p.location.reference.base:=hregister;
+              { Why is this done? We can never be sure about p^.left
+                because otherwise secondload fails PM
+              set_location(p^.left^.location,p^.location);}
+           end;
+         ungetiftemp(href);
+      end;
+{$endif TEMPS_NOT_PUSH}
+
+
+    procedure maketojumpbool(p : tnode; loadregvars: tloadregvars);
+    {
+      produces jumps to true respectively false labels using boolean expressions
+
+      depending on whether the loading of regvars is currently being
+      synchronized manually (such as in an if-node) or automatically (most of
+      the other cases where this procedure is called), loadregvars can be
+      "lr_load_regvars" or "lr_dont_load_regvars"
+    }
+      var
+        opsize : tcgsize;
+        storepos : tfileposinfo;
+      begin
+         if nf_error in p.flags then
+           exit;
+         storepos:=aktfilepos;
+         aktfilepos:=p.fileinfo;
+         if is_boolean(p.resulttype.def) then
+           begin
+              if loadregvars = lr_load_regvars then
+                load_all_regvars(exprasmlist);
+              if is_constboolnode(p) then
+                begin
+                   if tordconstnode(p).value<>0 then
+                     cg.a_jmp_cond(exprasmlist,OC_NONE,truelabel)
+                   else
+                     cg.a_jmp_cond(exprasmlist,OC_NONE,falselabel)
+                end
+              else
+                begin
+                   opsize:=def_cgsize(p.resulttype.def);
+                   case p.location.loc of
+                     LOC_CREGISTER,LOC_REGISTER,LOC_MEM,LOC_REFERENCE :
+                       begin
+                         if (p.location.loc = LOC_CREGISTER) then
+                           load_regvar_reg(exprasmlist,p.location.register);
+                         cg.a_cmp_const_loc_label(exprasmlist,opsize,OC_NE,
+                           0,p.location,truelabel);
+                         { !!! should happen right after cmp (JM) }
+                         del_location(p.location);
+                         cg.a_jmp_cond(exprasmlist,OC_NONE,falselabel);
+                       end;
+                     LOC_FLAGS :
+                       begin
+                         cg.a_jmp_flags(exprasmlist,p.location.resflags,
+                           truelabel);
+                         cg.a_jmp_cond(exprasmlist,OC_None,falselabel);
+                       end;
+                   end;
+                end;
+           end
+         else
+           internalerror(200112305);
+         aktfilepos:=storepos;
+      end;
+
+end.
+
+{
+  $Log$
+  Revision 1.1  2001-12-30 17:24:48  jonas
+    * range checking is now processor independent (part in cgobj, part in
    cg64f32) and should work correctly again (it needed some changes after
    the changes of the low and high of tordef's to int64)
  * maketojumpbool() is now processor independent (in ncgutil)
  * getregister32 is now called getregisterint
+
+
+}

+ 156 - 136
compiler/powerpc/cgcpu.pas

@@ -48,6 +48,11 @@ unit cgcpu;
         procedure a_op_const_reg(list : taasmoutput; Op: TOpCG; a: AWord; reg: TRegister); override;
         procedure a_op_const_reg(list : taasmoutput; Op: TOpCG; a: AWord; reg: TRegister); override;
         procedure a_op_reg_reg(list : taasmoutput; Op: TOpCG; size: TCGSize; src, dst: TRegister); override;
         procedure a_op_reg_reg(list : taasmoutput; Op: TOpCG; size: TCGSize; src, dst: TRegister); override;
 
 
+        procedure a_op_const_reg_reg(list: taasmoutput; op: TOpCg;
+          size: tcgsize; a: aword; src, dst: tregister); override;
+        procedure a_op_reg_reg_reg(list: taasmoutput; op: TOpCg;
+          size: tcgsize; src1, src2, dst: tregister); override;
+
         { move instructions }
         { move instructions }
         procedure a_load_const_reg(list : taasmoutput; size: tcgsize; a : aword;reg : tregister);override;
         procedure a_load_const_reg(list : taasmoutput; size: tcgsize; a : aword;reg : tregister);override;
         procedure a_load_reg_ref(list : taasmoutput; size: tcgsize; reg : tregister;const ref : treference);override;
         procedure a_load_reg_ref(list : taasmoutput; size: tcgsize; reg : tregister;const ref : treference);override;
@@ -61,6 +66,8 @@ unit cgcpu;
         procedure a_cmp_reg_reg_label(list : taasmoutput;size : tcgsize;cmp_op : topcmp;reg1,reg2 : tregister;l : tasmlabel); override;
         procedure a_cmp_reg_reg_label(list : taasmoutput;size : tcgsize;cmp_op : topcmp;reg1,reg2 : tregister;l : tasmlabel); override;
 
 
         procedure a_jmp_cond(list : taasmoutput;cond : TOpCmp;l: tasmlabel); override;
         procedure a_jmp_cond(list : taasmoutput;cond : TOpCmp;l: tasmlabel); override;
+        procedure a_jmp_flags(list : taasmoutput;const f : TResFlags;l: tasmlabel); override;
+
         procedure g_flags2reg(list: taasmoutput; const f: TResFlags; reg: TRegister); override;
         procedure g_flags2reg(list: taasmoutput; const f: TResFlags; reg: TRegister); override;
 
 
 
 
@@ -78,12 +85,6 @@ unit cgcpu;
         { that's the case, we can use rlwinm to do an AND operation        }
         { that's the case, we can use rlwinm to do an AND operation        }
         function get_rlwi_const(a: longint; var l1, l2: longint): boolean;
         function get_rlwi_const(a: longint; var l1, l2: longint): boolean;
 
 
-        procedure a_op_const_reg_reg(list: taasmoutput; op: TOpCg;
-          a: aword; src, dst: tregister);
-
-        procedure a_op_reg_reg_reg(list: taasmoutput; op: TOpCg; src1, src2,
-          dst: tregister);
-
         private
         private
 
 
         procedure g_return_from_proc_sysv(list : taasmoutput;parasize : aword);
         procedure g_return_from_proc_sysv(list : taasmoutput;parasize : aword);
@@ -101,7 +102,7 @@ unit cgcpu;
         { creates the correct branch instruction for a given combination }
         { creates the correct branch instruction for a given combination }
         { of asmcondflags and destination addressing mode                }
         { of asmcondflags and destination addressing mode                }
         procedure a_jmp(list: taasmoutput; op: tasmop;
         procedure a_jmp(list: taasmoutput; op: tasmop;
-                        c: tasmcondflag; l: tasmlabel);
+                        c: tasmcondflag; crval: longint; l: tasmlabel);
 
 
      end;
      end;
 
 
@@ -332,30 +333,19 @@ const
          scratch_register: TRegister;
          scratch_register: TRegister;
 
 
        begin
        begin
-         Case Op of
-           OP_DIV, OP_IDIV, OP_IMUL, OP_MUL:
-             If (Op = OP_IMUL) And (longint(a) >= -32768) And
-                (longint(a) <= 32767) Then
-               list.concat(taicpu.op_reg_reg_const(A_MULLI,reg,reg,a))
-             Else
-               Begin
-                 scratch_register := get_scratch_reg(list);
-                 a_load_const_reg(list,OS_32,a,scratch_register);
-                 list.concat(taicpu.op_reg_reg_reg(TOpCG2AsmOpConstLo[Op],
-                   reg,scratch_register,reg));
-                 free_scratch_reg(list,scratch_register);
-               End;
-           OP_ADD, OP_AND, OP_OR, OP_SUB,OP_XOR:
-             a_op_const_reg_reg(list,op,a,reg,reg);
+         case op of
+           OP_DIV, OP_IDIV, OP_IMUL, OP_MUL, OP_ADD, OP_AND, OP_OR, OP_SUB,
+           OP_XOR:
+             a_op_const_reg_reg(list,op,OS_32,a,reg,reg);
            OP_SHL,OP_SHR,OP_SAR:
            OP_SHL,OP_SHR,OP_SAR:
-             Begin
-               if (a and 31) <> 0 Then
+             begin
+               if (a and 31) <> 0 then
                  list.concat(taicpu.op_reg_reg_const(
                  list.concat(taicpu.op_reg_reg_const(
-                   TOpCG2AsmOpConstLo[Op],reg,reg,a and 31));
-               If (a shr 5) <> 0 Then
-                 InternalError(68991);
-             End
-           Else InternalError(68992);
+                   TOpCG2AsmOpConstLo[op],reg,reg,a and 31));
+               if (a shr 5) <> 0 then
+                 internalError(68991);
+             end
+           else internalError(68992);
          end;
          end;
        end;
        end;
 
 
@@ -363,9 +353,123 @@ const
       procedure tcgppc.a_op_reg_reg(list : taasmoutput; Op: TOpCG; size: TCGSize; src, dst: TRegister);
       procedure tcgppc.a_op_reg_reg(list : taasmoutput; Op: TOpCG; size: TCGSize; src, dst: TRegister);
 
 
          begin
          begin
-           a_op_reg_reg_reg(list,op,src,dst,dst);
+           a_op_reg_reg_reg(list,op,OS_32,src,dst,dst);
          end;
          end;
 
 
+
+    procedure tcgppc.a_op_const_reg_reg(list: taasmoutput; op: TOpCg;
+                       size: tcgsize; a: aword; src, dst: tregister);
+      var
+        l1,l2: longint;
+
+      var
+        oplo, ophi: tasmop;
+        scratchreg: tregister;
+        useReg: boolean;
+
+      begin
+        ophi := TOpCG2AsmOpConstHi[op];
+        oplo := TOpCG2AsmOpConstLo[op];
+        { constants in a PPC instruction are always interpreted as signed }
+        { 16bit values, so if the value is between low(smallint) and      }
+        { high(smallint), it's easy                                       }
+        if (op in [OP_ADD,OP_SUB,OP_AND,OP_OR,OP_XOR]) then
+          begin
+            if (longint(a) >= low(smallint)) and
+               (longint(a) <= high(smallint)) then
+              begin
+                list.concat(taicpu.op_reg_reg_const(oplo,dst,src,a));
+                exit;
+              end;
+            { all basic constant instructions also have a shifted form that }
+            { works only on the highest 16bits, so if low(a) is 0, we can   }
+            { use that one                                                  }
+            if (lo(a) = 0) then
+              begin
+                list.concat(taicpu.op_reg_reg_const(ophi,dst,src,hi(a)));
+                exit;
+              end;
+          end;
+        { otherwise, the instructions we can generate depend on the }
+        { operation                                                 }
+        useReg := false;
+        case op of
+           OP_DIV, OP_IDIV, OP_IMUL, OP_MUL:
+             if (Op = OP_IMUL) and (longint(a) >= -32768) and
+                (longint(a) <= 32767) then
+               list.concat(taicpu.op_reg_reg_const(A_MULLI,dst,src,a))
+             else
+               usereg := true;
+          OP_ADD,OP_SUB:
+            begin
+              list.concat(taicpu.op_reg_reg_const(oplo,dst,src,low(a)));
+              list.concat(taicpu.op_reg_reg_const(ophi,dst,dst,
+                high(a) + ord(smallint(a) < 0)));
+            end;
+          OP_OR:
+            { try to use rlwimi }
+            if get_rlwi_const(a,l1,l2) then
+              begin
+                if src <> dst then
+                  list.concat(taicpu.op_reg_reg(A_MR,dst,src));
+                scratchreg := get_scratch_reg(list);
+                list.concat(taicpu.op_reg_const(A_LI,scratchreg,-1));
+                list.concat(taicpu.op_reg_reg_const_const_const(A_RLWIMI,dst,
+                  scratchreg,0,l1,l2));
+                free_scratch_reg(list,scratchreg);
+              end
+            else
+              useReg := true;
+          OP_AND:
+            { try to use rlwinm }
+            if get_rlwi_const(a,l1,l2) then
+              list.concat(taicpu.op_reg_reg_const_const_const(A_RLWINM,dst,
+                src,0,l1,l2))
+            else
+              useReg := true;
+          OP_XOR:
+            useReg := true;
+          OP_SHL,OP_SHR,OP_SAR:
+            begin
+              if (a and 31) <> 0 Then
+                list.concat(taicpu.op_reg_reg_const(
+                  TOpCG2AsmOpConstLo[Op],dst,src,a and 31));
+              if (a shr 5) <> 0 then
+                internalError(68991);
+            end
+          else
+            internalerror(200109091);
+        end;
+        { if all else failed, load the constant in a register and then }
+        { perform the operation                                        }
+        if useReg then
+          begin
+            scratchreg := get_scratch_reg(list);
+            a_load_const_reg(list,OS_32,a,scratchreg);
+            a_op_reg_reg_reg(list,op,OS_32,scratchreg,src,dst);
+            free_scratch_reg(list,scratchreg);
+          end;
+      end;
+
+
+    procedure tcgppc.a_op_reg_reg_reg(list: taasmoutput; op: TOpCg;
+      size: tcgsize; src1, src2, dst: tregister);
+
+      const
+        op_reg_reg_opcg2asmop: array[TOpCG] of tasmop =
+          (A_ADD,A_AND,A_DIVWU,A_DIVW,A_MULLW,A_MULLW,A_NEG,A_NOT,A_OR,
+           A_SRAW,A_SLW,A_SRW,A_SUB,A_XOR);
+
+       begin
+         case op of
+           OP_NEG,OP_NOT:
+             list.concat(taicpu.op_reg_reg(op_reg_reg_opcg2asmop[op],dst,dst));
+           else
+             list.concat(taicpu.op_reg_reg_reg(op_reg_reg_opcg2asmop[op],dst,src2,src1));
+         end;
+       end;
+
+
 {*************** compare instructructions ****************}
 {*************** compare instructructions ****************}
 
 
       procedure tcgppc.a_cmp_const_reg_label(list : taasmoutput;size : tcgsize;cmp_op : topcmp;a : aword;reg : tregister;
       procedure tcgppc.a_cmp_const_reg_label(list : taasmoutput;size : tcgsize;cmp_op : topcmp;a : aword;reg : tregister;
@@ -398,7 +502,7 @@ const
                 list.concat(taicpu.op_reg_reg_reg(A_CMPL,R_CR0,reg,scratch_register));
                 list.concat(taicpu.op_reg_reg_reg(A_CMPL,R_CR0,reg,scratch_register));
                 free_scratch_reg(list,scratch_register);
                 free_scratch_reg(list,scratch_register);
               end;
               end;
-          a_jmp(list,A_BC,TOpCmp2AsmCond[cmp_op],l);
+          a_jmp(list,A_BC,TOpCmp2AsmCond[cmp_op],0,l);
         end;
         end;
 
 
 
 
@@ -414,16 +518,24 @@ const
             op := A_CMP
             op := A_CMP
           else op := A_CMPL;
           else op := A_CMPL;
           list.concat(taicpu.op_reg_reg_reg(op,R_CR0,reg1,reg2));
           list.concat(taicpu.op_reg_reg_reg(op,R_CR0,reg1,reg2));
-          a_jmp(list,A_BC,TOpCmp2AsmCond[cmp_op],l);
+          a_jmp(list,A_BC,TOpCmp2AsmCond[cmp_op],0,l);
         end;
         end;
 
 
 
 
      procedure tcgppc.a_jmp_cond(list : taasmoutput;cond : TOpCmp;l: tasmlabel);
      procedure tcgppc.a_jmp_cond(list : taasmoutput;cond : TOpCmp;l: tasmlabel);
 
 
        begin
        begin
-         a_jmp(list,A_BC,TOpCmp2AsmCond[cond],l);
+         a_jmp(list,A_BC,TOpCmp2AsmCond[cond],0,l);
        end;
        end;
 
 
+     procedure tcgppc.a_jmp_flags(list : taasmoutput;const f : TResFlags;l: tasmlabel);
+
+       var
+         c: tasmcond;
+       begin
+         c := flags_to_cond(f);
+         a_jmp(list,A_BC,c.cond,longint(c.cr),l);
+       end;
 
 
      procedure tcgppc.g_flags2reg(list: taasmoutput; const f: TResFlags; reg: TRegister);
      procedure tcgppc.g_flags2reg(list: taasmoutput; const f: TResFlags; reg: TRegister);
 
 
@@ -434,7 +546,7 @@ const
        begin
        begin
          { get the bit to extract from the conditional register + its }
          { get the bit to extract from the conditional register + its }
          { requested value (0 or 1)                                   }
          { requested value (0 or 1)                                   }
-         testbit := (f.cr * 4);
+         testbit := (longint(f.cr) * 4);
          case f.flag of
          case f.flag of
            F_EQ,F_NE:
            F_EQ,F_NE:
              bitvalue := f.flag = F_EQ;
              bitvalue := f.flag = F_EQ;
@@ -465,7 +577,7 @@ const
        end;
        end;
 
 
 (*
 (*
-     procedure tcgppc.g_flags2reg(list: taasmoutput; const f: TAsmCond; reg: TRegister);
+     procedure tcgppc.g_cond2reg(list: taasmoutput; const f: TAsmCond; reg: TRegister);
 
 
        var
        var
          testbit: byte;
          testbit: byte;
@@ -696,7 +808,7 @@ const
            end;
            end;
          if ref.offset <> 0 Then
          if ref.offset <> 0 Then
            if ref.base <> R_NO then
            if ref.base <> R_NO then
-             a_op_const_reg_reg(list,OP_ADD,ref.offset,ref.base,r)
+             a_op_const_reg_reg(list,OP_ADD,OS_32,ref.offset,ref.base,r)
   { FixRef makes sure that "(ref.index <> R_NO) and (ref.offset <> 0)" never}
   { FixRef makes sure that "(ref.index <> R_NO) and (ref.offset <> 0)" never}
   { occurs, so now only ref.offset has to be loaded                         }
   { occurs, so now only ref.offset has to be loaded                         }
            else a_load_const_reg(list, OS_32, ref.offset, r)
            else a_load_const_reg(list, OS_32, ref.offset, r)
@@ -764,7 +876,7 @@ const
             list.concat(taicpu.op_reg_reg_const(A_CMPI,R_CR0,countreg,0));
             list.concat(taicpu.op_reg_reg_const(A_CMPI,R_CR0,countreg,0));
             list.concat(taicpu.op_reg_ref(A_STWU,tempreg,newreference(dst)));
             list.concat(taicpu.op_reg_ref(A_STWU,tempreg,newreference(dst)));
             list.concat(taicpu.op_reg_reg_const(A_SUBI,countreg,countreg,1));
             list.concat(taicpu.op_reg_reg_const(A_SUBI,countreg,countreg,1));
-            a_jmp(list,A_BC,C_NE,lab);
+            a_jmp(list,A_BC,C_NE,0,lab);
             free_scratch_reg(list,countreg);
             free_scratch_reg(list,countreg);
           end
           end
         else
         else
@@ -939,102 +1051,6 @@ const
         get_rlwi_const := true;
         get_rlwi_const := true;
       end;
       end;
 
 
-    procedure tcgppc.a_op_const_reg_reg(list: taasmoutput; op: TOpCg;
-                       a: aword; src, dst: tregister);
-      var
-        l1,l2: longint;
-
-      var
-        oplo, ophi: tasmop;
-        scratchreg: tregister;
-        useReg: boolean;
-
-      begin
-        ophi := TOpCG2AsmOpConstHi[op];
-        oplo := TOpCG2AsmOpConstLo[op];
-        { constants in a PPC instruction are always interpreted as signed }
-        { 16bit values, so if the value is between low(smallint) and      }
-        { high(smallint), it's easy                                       }
-        if (longint(a) >= low(smallint)) and
-           (longint(a) <= high(smallint)) then
-          begin
-            list.concat(taicpu.op_reg_reg_const(oplo,dst,src,a));
-            exit;
-          end;
-        { all basic constant instructions also have a shifted form that }
-        { works only on the highest 16bits, so if low(a) is 0, we can   }
-        { use that one                                                  }
-        if (lo(a) = 0) then
-          begin
-            list.concat(taicpu.op_reg_reg_const(ophi,dst,src,hi(a)));
-            exit;
-          end;
-        { otherwise, the instructions we can generate depend on the }
-        { operation                                                 }
-        useReg := false;
-        case op of
-          OP_ADD,OP_SUB:
-            begin
-              list.concat(taicpu.op_reg_reg_const(oplo,dst,src,low(a)));
-              list.concat(taicpu.op_reg_reg_const(ophi,dst,dst,
-                high(a) + ord(smallint(a) < 0)));
-            end;
-          OP_OR:
-            { try to use rlwimi }
-            if get_rlwi_const(a,l1,l2) then
-              begin
-                if src <> dst then
-                  list.concat(taicpu.op_reg_reg(A_MR,dst,src));
-                scratchreg := get_scratch_reg(list);
-                list.concat(taicpu.op_reg_const(A_LI,scratchreg,-1));
-                list.concat(taicpu.op_reg_reg_const_const_const(A_RLWIMI,dst,
-                  scratchreg,0,l1,l2));
-                free_scratch_reg(list,scratchreg);
-              end
-            else
-              useReg := true;
-          OP_AND:
-            { try to use rlwinm }
-            if get_rlwi_const(a,l1,l2) then
-              list.concat(taicpu.op_reg_reg_const_const_const(A_RLWINM,dst,
-                src,0,l1,l2))
-            else
-              useReg := true;
-          OP_XOR:
-            useReg := true;
-          else
-            internalerror(200109091);
-        end;
-        { if all else failed, load the constant in a register and then }
-        { perform the operation                                        }
-        if useReg then
-          begin
-            scratchreg := get_scratch_reg(list);
-            a_load_const_reg(list,OS_32,a,scratchreg);
-            a_op_reg_reg_reg(list,op,scratchreg,src,dst);
-            free_scratch_reg(list,scratchreg);
-          end;
-      end;
-
-
-    procedure tcgppc.a_op_reg_reg_reg(list: taasmoutput; op: TOpCg;
-      src1, src2, dst: tregister);
-
-      const
-        op_reg_reg_opcg2asmop: array[TOpCG] of tasmop =
-          (A_ADD,A_AND,A_DIVWU,A_DIVW,A_MULLW,A_MULLW,A_NEG,A_NOT,A_OR,
-           A_SRAW,A_SLW,A_SRW,A_SUB,A_XOR);
-
-       begin
-         case op of
-           OP_NEG,OP_NOT:
-             list.concat(taicpu.op_reg_reg(op_reg_reg_opcg2asmop[op],dst,dst));
-           else
-             list.concat(taicpu.op_reg_reg_reg(op_reg_reg_opcg2asmop[op],dst,src2,src1));
-         end;
-       end;
-
-
     procedure tcgppc.a_load_store(list:taasmoutput;op: tasmop;reg:tregister;
     procedure tcgppc.a_load_store(list:taasmoutput;op: tasmop;reg:tregister;
        ref: treference);
        ref: treference);
 
 
@@ -1066,13 +1082,14 @@ const
 
 
 
 
     procedure tcgppc.a_jmp(list: taasmoutput; op: tasmop; c: tasmcondflag;
     procedure tcgppc.a_jmp(list: taasmoutput; op: tasmop; c: tasmcondflag;
-                l: tasmlabel);
+                crval: longint; l: tasmlabel);
       var
       var
         p: taicpu;
         p: taicpu;
 
 
       begin
       begin
         p := taicpu.op_sym(op,newasmsymbol(l.name));
         p := taicpu.op_sym(op,newasmsymbol(l.name));
-        create_cond_norm(c,0,p.condition);
+        create_cond_norm(c,crval,p.condition);
+        p.is_jmp := true;
         list.concat(p)
         list.concat(p)
       end;
       end;
 
 
@@ -1081,7 +1098,10 @@ begin
 end.
 end.
 {
 {
   $Log$
   $Log$
-  Revision 1.9  2001-12-29 15:28:58  jonas
+  Revision 1.10  2001-12-30 17:24:48  jonas
+    * range checking is now processor independent (part in cgobj, part in
    cg64f32) and should work correctly again (it needed some changes after
    the changes of the low and high of tordef's to int64)
  * maketojumpbool() is now processor independent (in ncgutil)
  * getregister32 is now called getregisterint
+
+  Revision 1.9  2001/12/29 15:28:58  jonas
     * powerpc/cgcpu.pas compiles :)
     * powerpc/cgcpu.pas compiles :)
     * several powerpc-related fixes
     * several powerpc-related fixes
     * cpuasm unit is now based on common tainst unit
     * cpuasm unit is now based on common tainst unit

+ 26 - 6
compiler/powerpc/cpubase.pas

@@ -209,8 +209,10 @@ type
 {$ifndef tp}
 {$ifndef tp}
 {$minenumsize 1}
 {$minenumsize 1}
 {$endif tp}
 {$endif tp}
-  TAsmCondFlag = (C_None { unconditional junps },
+  TAsmCondFlag = (C_None { unconditional jumps },
     { conditions when not using ctr decrement etc }
     { conditions when not using ctr decrement etc }
+    { TO DO: OV and CA. They're somewhere in bits 0:3 of XER, but can be }
+    { brought to CRx with the mcrxr instruction                          }
     C_LT,C_LE,C_EQ,C_GE,C_GT,C_NL,C_NE,C_NG,C_SO,C_NS,C_UN,C_NU,
     C_LT,C_LE,C_EQ,C_GE,C_GT,C_NL,C_NE,C_NG,C_SO,C_NS,C_UN,C_NU,
     { conditions when using ctr decrement etc }
     { conditions when using ctr decrement etc }
     C_T,C_F,C_DNZ,C_DNZT,C_DNZF,C_DZ,C_DZT,C_DZF);
     C_T,C_F,C_DNZ,C_DNZT,C_DNZF,C_DZ,C_DZT,C_DZF);
@@ -262,7 +264,7 @@ const
 type
 type
   TResFlagsEnum = (F_EQ,F_NE,F_LT,F_LE,F_GT,F_GE,F_SO,F_FX,F_FEX,F_VX,F_OX);
   TResFlagsEnum = (F_EQ,F_NE,F_LT,F_LE,F_GT,F_GE,F_SO,F_FX,F_FEX,F_VX,F_OX);
   TResFlags = record
   TResFlags = record
-    cr: byte;
+    cr: R_CR0..R_CR7;
     flag: TResFlagsEnum;
     flag: TResFlagsEnum;
   end;
   end;
 
 
@@ -462,6 +464,7 @@ const
 
 
     procedure inverse_flags(var f: TResFlags);
     procedure inverse_flags(var f: TResFlags);
     procedure inverse_cond(c: TAsmCond;var r : TAsmCond);
     procedure inverse_cond(c: TAsmCond;var r : TAsmCond);
+    function flags_to_cond(const f: TResFlags) : TAsmCond;
     procedure create_cond_imm(BO,BI:byte;var r : TAsmCond);
     procedure create_cond_imm(BO,BI:byte;var r : TAsmCond);
     procedure create_cond_norm(cond: TAsmCondFlag; cr: byte;var r : TasmCond);
     procedure create_cond_norm(cond: TAsmCondFlag; cr: byte;var r : TasmCond);
 
 
@@ -479,11 +482,12 @@ const
 
 
 implementation
 implementation
 
 
-{$ifdef heaptrc}
   uses
   uses
-      ppheap;
+      verbose
+{$ifdef heaptrc}
+      ,ppheap
 {$endif heaptrc}
 {$endif heaptrc}
-
+      ;
 {*****************************************************************************
 {*****************************************************************************
                                   Helpers
                                   Helpers
 *****************************************************************************}
 *****************************************************************************}
@@ -543,6 +547,7 @@ implementation
         f.flag := flagsinvers[f.flag];
         f.flag := flagsinvers[f.flag];
       end;
       end;
 
 
+
     procedure inverse_cond(c: TAsmCond;var r : TAsmCond);
     procedure inverse_cond(c: TAsmCond;var r : TAsmCond);
     const
     const
       inv_condflags:array[TAsmCondFlag] of TAsmCondFlag=(C_None,
       inv_condflags:array[TAsmCondFlag] of TAsmCondFlag=(C_None,
@@ -553,6 +558,18 @@ implementation
       r := c;
       r := c;
     end;
     end;
 
 
+    function flags_to_cond(const f: TResFlags) : TAsmCond;
+      const
+        flag_2_cond: array[F_EQ..F_SO] of TAsmCondFlag =
+          (C_EQ,C_NE,C_LT,C_LE,C_GT,C_GE,C_SO);
+      begin
+        if f.flag > high(flag_2_cond) then
+          internalerror(200112301);
+        result.simple := true;
+        result.cr := f.cr;
+        result.cond := flag_2_cond[f.flag];
+      end;
+
     procedure create_cond_imm(BO,BI:byte;var r : TAsmCond);
     procedure create_cond_imm(BO,BI:byte;var r : TAsmCond);
     begin
     begin
       r.simple := false;
       r.simple := false;
@@ -612,7 +629,10 @@ implementation
 end.
 end.
 {
 {
   $Log$
   $Log$
-  Revision 1.5  2001-12-29 15:28:58  jonas
+  Revision 1.6  2001-12-30 17:24:48  jonas
+    * range checking is now processor independent (part in cgobj, part in
    cg64f32) and should work correctly again (it needed some changes after
    the changes of the low and high of tordef's to int64)
  * maketojumpbool() is now processor independent (in ncgutil)
  * getregister32 is now called getregisterint
+
+  Revision 1.5  2001/12/29 15:28:58  jonas
     * powerpc/cgcpu.pas compiles :)
     * powerpc/cgcpu.pas compiles :)
     * several powerpc-related fixes
     * several powerpc-related fixes
     * cpuasm unit is now based on common tainst unit
     * cpuasm unit is now based on common tainst unit